blob: 52339a2705d8e8265ff618e6ed37e8638a423621 (
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
58
59
60
61
|
open StdLabels
module P = Parser
module Parser = P.Make(Sounds)
module I = Parser.MenhirInterpreter
let sound_to_string
: Sounds.t list -> string
= fun t ->
let buff = Buffer.create 16 in
List.iter t
~f:(fun f -> Buffer.add_string buff (Sounds.repr f));
Buffer.contents buff
let succeed (res : Sounds.t list) =
Ok (sound_to_string res)
let fail (_ : 'a I.checkpoint) =
Error ("Syntax Error")
let rec loop get_element (checkpoint : Sounds.t list I.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 get_element checkpoint
| I.Shifting _
| I.AboutToReduce _ ->
let checkpoint = I.resume checkpoint in
loop get_element checkpoint
| I.HandlingError _env ->
fail checkpoint
| I.Accepted v ->
(* The parser has succeeded and produced a semantic value. Print it. *)
succeed v
| I.Rejected ->
(* The parser rejects this input. This cannot happen, here, because
we stop as soon as the parser reports [HandlingError]. *)
assert false
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 (line : string) =
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
|
