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