blob: 6621730bb9b5a04891dd21f421e5b8a8d0870339 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
|
module I = Parser.MenhirInterpreter
let sound_to_string
: (module Sounds.Sig.REPR) -> Sounds.t list -> string
= fun m t ->
Sounds.repr m t
let fail (_ : 'a I.checkpoint) =
Error ("Syntax Error")
type source = Sounds.t list I.checkpoint
let loop
: (source -> source) -> source -> (Sounds.t list, string) result
= fun get_element checkpoint ->
let rec loop' checkpoint =
match checkpoint with
| I.InputNeeded _env ->
(* The parser needs a token. Request one from the lexer,
and offer it to the parser, which will produce a new
checkpoint. Then, repeat. *)
let checkpoint = get_element checkpoint in
loop' checkpoint
| I.Shifting _
| I.AboutToReduce _ ->
let checkpoint = I.resume checkpoint in
loop' checkpoint
| I.HandlingError _env ->
fail checkpoint
| I.Accepted v ->
(* The parser has succeeded and produced a semantic value. Print it. *)
Ok v
| I.Rejected ->
(* The parser rejects this input. This cannot happen, here, because
we stop as soon as the parser reports [HandlingError]. *)
assert false
in loop' checkpoint
let build_processor ll =
let l = ref ll in
fun checkpoint ->
match !l with
| [] -> raise (Failure "Empty")
| hd::tl ->
l := tl;
I.offer checkpoint (hd, Lexing.dummy_pos, Lexing.dummy_pos)
let process
: string -> (Sounds.t list, string) result
= fun line ->
let lexbuf = Lexing.from_string line in
let content =
Prononciation.main Lexer.letter lexbuf
|> build_processor in
try loop content (Parser.Incremental.main lexbuf.lex_curr_p)
with Lexer.Error msg -> Error msg
|
