calc.ml 3.2 KB
Newer Older
1 2
open Lexing

3
(* A short name for the incremental parser API. *)
4 5 6 7

module I =
  Parser.MenhirInterpreter

8
(* -------------------------------------------------------------------------- *)
9

10 11 12
(* The loop which drives the parser. At each iteration, we analyze a
   checkpoint produced by the parser, and act in an appropriate manner.
   [lexbuf] is the lexing buffer. [checkpoint] is the last checkpoint produced
13
   by the parser. *)
14

15 16
let rec loop lexbuf (checkpoint : int I.checkpoint) =
  match checkpoint with
17 18 19
  | I.InputNeeded env ->
      (* The parser needs a token. Request one from the lexer,
         and offer it to the parser, which will produce a new
20
         checkpoint. Then, repeat. *)
21
      let token = Lexer.token lexbuf in
Frédéric Bour's avatar
Frédéric Bour committed
22 23 24
      let startp = lexbuf.lex_start_pos
      and endp = lexbuf.lex_curr_pos in
      let checkpoint = I.offer checkpoint (token, (startp, endp)) in
25
      loop lexbuf checkpoint
26 27
  | I.Shifting _
  | I.AboutToReduce _ ->
28 29
      let checkpoint = I.resume checkpoint in
      loop lexbuf checkpoint
30 31 32 33
  | I.HandlingError env ->
      (* The parser has suspended itself because of a syntax error. Stop. *)
      Printf.fprintf stderr
        "At offset %d: syntax error.\n%!"
34
        (lexeme_start lexbuf)
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

43 44 45 46 47 48 49 50 51 52 53 54 55 56
(* -------------------------------------------------------------------------- *)

(* The above loop is shown for explanatory purposes, but can in fact be
   replaced with the following code, which exploits the functions
   [lexer_lexbuf_to_supplier] and [loop_handle] offered by Menhir. *)

let succeed (v : int) =
  (* The parser has succeeded and produced a semantic value. Print it. *)
  Printf.printf "%d\n%!" v

let fail lexbuf (_ : int I.checkpoint) =
  (* The parser has suspended itself because of a syntax error. Stop. *)
  Printf.fprintf stderr
    "At offset %d: syntax error.\n%!"
57
    (lexeme_start lexbuf)
58 59

let loop lexbuf result =
Frédéric Bour's avatar
Frédéric Bour committed
60 61
  let get_location l = (l.Lexing.lex_start_pos, l.Lexing.lex_curr_pos) in
  let supplier = I.lexer_lexbuf_to_supplier Lexer.token get_location lexbuf in
62 63 64 65
  I.loop_handle succeed (fail lexbuf) supplier result

(* -------------------------------------------------------------------------- *)

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

let process (line : string) =
69
  let lexbuf = from_string line in
Frédéric Bour's avatar
Frédéric Bour committed
70
  let loc = (lexbuf.lex_start_pos, lexbuf.lex_curr_pos) in
71
  try
Frédéric Bour's avatar
Frédéric Bour committed
72
    loop lexbuf (Parser.Incremental.main loc)
73 74 75 76
  with
  | Lexer.Error msg ->
      Printf.fprintf stderr "%s%!" msg

77 78
(* -------------------------------------------------------------------------- *)

79 80 81 82 83 84 85 86 87 88 89 90 91 92 93
(* 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
Frédéric Bour's avatar
Frédéric Bour committed
94

95
let () =
96
  repeat (from_channel stdin)
97