Moved the printer to toplevel

1 files changed, 40 insertions, 42 deletions

diff --git a/src/lib/reader.ml b/src/lib/reader.ml
index dfb05ce..b816d6d 100644
--- a/src/lib/reader.ml
+++ b/src/lib/reader.ml
@@ -1,43 +1,41 @@
 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 (module Repr.Default) f));
-    Buffer.contents buff
-    *)
-    Sounds.repr (module Repr.Default) t
-
-let succeed (res : Sounds.t list) =
-  Ok (sound_to_string res)
+  : (module Sounds.Sig.REPR) -> Sounds.t list -> string
+  = fun m t ->
+    Sounds.repr m t
 
 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
+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
@@ -48,13 +46,13 @@ let build_processor ll =
       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
+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