e0/bin/main.ml

open E0
open E0.Util

module I = Parser.MenhirInterpreter

let get_parse_error env =
    match I.stack env with
    | lazy Nil -> "Invalid syntax"
    | lazy (Cons (I.Element (state, _, _, _), _)) ->
        try (E0.Parser_messages.message (I.number state)) with
        | Not_found -> "invalid syntax (no specific message for this eror)"

let rec parse lexbuf (checkpoint : Ast.program I.checkpoint) =
  match checkpoint with
  | I.InputNeeded _env ->
      let token = Lexer.f lexbuf in
      let startp = lexbuf.lex_start_p
      and endp = lexbuf.lex_curr_p in
      let checkpoint = I.offer checkpoint (token, startp, endp) in
      parse lexbuf checkpoint
  | I.Shifting _
  | I.AboutToReduce _ ->
      let checkpoint = I.resume checkpoint in
      parse lexbuf checkpoint
  | I.HandlingError _env ->
      let line, pos = Util.get_lexing_position lexbuf in
      let err = get_parse_error _env in
      raise (Syntax_error (Some (line, pos), err))
  | I.Accepted v -> v
  | I.Rejected ->
       raise (Syntax_error (None, "invalid syntax (parser rejected the input)"))

let try_parse lexbuf =
  try
    let program = parse lexbuf (Parser.Incremental.program lexbuf.lex_curr_p) in
    Ok program
  with
  | Util.Syntax_error (pos, err) ->
    begin
      match pos with
      | Some (line, pos) ->
        Error (Printf.sprintf "Syntax error on line %d, character %d: %s" line pos err)
      | None -> Error (Printf.sprintf "Syntax error: %s" err)
    end


let () =
  let p = Lexing.from_channel stdin |> try_parse in
  match p with
  | Error msg -> Printf.eprintf "Could not load program: %s" msg
  | Ok p -> Ast.show_program p |> print_endline