From df92da631e9a10a099a72ba846f90adf99d180df Mon Sep 17 00:00:00 2001
From: Sébastien Dailly <sebastien@chimrod.com>
Date: Tue, 24 Aug 2021 15:04:25 +0200
Subject: Added pre-processing

---
 src/lib/reader.ml | 53 ++++++++++++++++++++++++++++++++++++++++++-----------
 1 file changed, 42 insertions(+), 11 deletions(-)

(limited to 'src/lib/reader.ml')

diff --git a/src/lib/reader.ml b/src/lib/reader.ml
index 4b123d5..20dc9cc 100644
--- a/src/lib/reader.ml
+++ b/src/lib/reader.ml
@@ -15,23 +15,54 @@ let sound_to_string
 let succeed (res : Sounds.t list) =
   Ok (sound_to_string res)
 
-let fail lexbuf (_ : 'a I.checkpoint) =
-  Error (
-    Printf.sprintf
-      "At offset %d: syntax error."
-      (Lexing.lexeme_start lexbuf)
-  )
+let fail (_ : 'a I.checkpoint) =
+  Error ("Syntax Error")
 
-(* The parser has suspended itself because of a syntax error. Stop. *)
+let get_element lexbuf checkpoint =
+  let token = Lexer.letter lexbuf in
+  let startp = lexbuf.lex_start_p
+  and endp = lexbuf.lex_curr_p in
+  I.offer checkpoint (token, startp, endp)
 
-let loop lexbuf result =
-  let supplier = I.lexer_lexbuf_to_supplier Lexer.letter lexbuf in
-  I.loop_handle succeed (fail lexbuf) supplier result
+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
+    |> List.rev
+    |> build_processor in
   try
-    loop lexbuf (Parser.Incremental.main lexbuf.lex_curr_p)
+    loop content (Parser.Incremental.main lexbuf.lex_curr_p)
   with
   | Lexer.Error msg -> Error msg
 
-- 
cgit v1.2.3