calc.ml 2.04 KB
Newer Older
1
(* A short name for the incremental parser API. *)
2 3 4 5

module I =
  Parser.MenhirInterpreter

6 7
(* The loop which drives the parser. At each iteration, we analyze a
   result produced by the parser, and act in an appropriate manner. *)
8

9 10
(* [lexbuf] is the lexing buffer. [result] is the last result produced
   by the parser. *)
11

12
let rec loop lexbuf (result : int I.result) =
13 14 15 16 17
  match result 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
         result. Then, repeat. *)
18 19 20
      let token = Lexer.token lexbuf in
      let startp = lexbuf.Lexing.lex_start_p
      and endp = lexbuf.Lexing.lex_curr_p in
21
      let result = I.offer result (token, startp, endp) in
22
      loop lexbuf result
23 24
  | I.Shifting _
  | I.AboutToReduce _ ->
25
      let result = I.resume result in
26
      loop lexbuf result
27 28 29 30
  | I.HandlingError env ->
      (* The parser has suspended itself because of a syntax error. Stop. *)
      Printf.fprintf stderr
        "At offset %d: syntax error.\n%!"
31
        (Lexing.lexeme_start lexbuf)
32 33 34 35 36 37 38 39 40 41 42
  | I.Accepted v ->
      (* The parser has succeeded and produced a semantic value. Print it. *)
      Printf.printf "%d\n%!" v
  | I.Rejected ->
      (* The parser rejects this input. This cannot happen, here, because
         we stop as soon as the parser reports [HandlingError]. *)
      assert false

(* Initialize the lexer, and catch any exception raised by the lexer. *)

let process (line : string) =
43
  let lexbuf = Lexing.from_string line in
44
  try
45
    loop lexbuf (Parser.Incremental.main())
46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68
  with
  | Lexer.Error msg ->
      Printf.fprintf stderr "%s%!" msg

(* The rest of the code is as in the [calc] demo. *)

let process (optional_line : string option) =
  match optional_line with
  | None ->
      ()
  | Some line ->
      process line

let rec repeat channel =
  (* Attempt to read one line. *)
  let optional_line, continue = Lexer.line channel in
  process optional_line;
  if continue then
    repeat channel
  
let () =
  repeat (Lexing.from_channel stdin)