Commit 6a9feb94 authored by POTTIER Francois's avatar POTTIER Francois

Expose [supplier], [lexer_lexbuf_to_supplier], [loop]. Add [loop_handle].

parent e137a86d
......@@ -3,10 +3,11 @@
module I =
Parser.MenhirInterpreter
(* 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
(* 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
by the parser. *)
let rec loop lexbuf (checkpoint : int I.checkpoint) =
......@@ -37,6 +38,28 @@ let rec loop lexbuf (checkpoint : int I.checkpoint) =
we stop as soon as the parser reports [HandlingError]. *)
assert false
(* -------------------------------------------------------------------------- *)
(* 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%!"
(Lexing.lexeme_start lexbuf)
let loop lexbuf result =
let supplier = I.lexer_lexbuf_to_supplier Lexer.token lexbuf in
I.loop_handle succeed (fail lexbuf) supplier result
(* -------------------------------------------------------------------------- *)
(* Initialize the lexer, and catch any exception raised by the lexer. *)
let process (line : string) =
......@@ -47,6 +70,8 @@ let process (line : string) =
| 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) =
......
......@@ -65,6 +65,49 @@ module type INCREMENTAL_ENGINE = sig
'a checkpoint ->
'a checkpoint
(* A token supplier is a function of no arguments which delivers a new token
(together with its start and end positions) every time it is called. *)
type supplier =
unit -> token * Lexing.position * Lexing.position
(* A pair of a lexer and a lexing buffer can be easily turned into a supplier. *)
val lexer_lexbuf_to_supplier:
(Lexing.lexbuf -> token) ->
Lexing.lexbuf ->
supplier
(* The functions [offer] and [resume] are sufficient to write a parser loop.
One can imagine many variations (which is why we expose these functions
in the first place!). Here, we expose a few variations of the main loop,
ready for use. *)
(* [loop supplier checkpoint] begins parsing from [checkpoint], reading
tokens from [supplier]. It continues parsing until it reaches a
checkpoint of the form [Accepted v] or [Rejected]. In the former case, it
returns [v]. In the latter case, it raises [Error]. This is how the
monolithic API is implemented on top of the incremental API. *)
val loop: supplier -> 'a checkpoint -> 'a
(* [loop_handle succeed fail supplier checkpoint] begins parsing from
[checkpoint], reading tokens from [supplier]. It continues parsing until
it reaches a checkpoint of the form [Accepted v] or [HandlingError env]
(or [Rejected], but that should not happen, as [HandlingError _] will be
observed first). In the former case, it returns [v]. In the latter case,
it calls [fail] with this checkpoint. It cannot raise [Error].
This means that Menhir's traditional error-handling procedure (which pops
the stack until a state that can act on the [error] token is found) does
not get a chance to run. Instead, the user can implement her own error
handling code, in the [fail] function. *)
val loop_handle:
('a -> 'answer) ->
('a checkpoint -> 'answer) ->
supplier -> 'a checkpoint -> 'answer
(* The abstract type ['a lr1state] describes the non-initial states of the
LR(1) automaton. The index ['a] represents the type of the semantic value
associated with this state's incoming symbol. *)
......
......@@ -508,6 +508,36 @@ module Make (T : TABLE) = struct
(* --------------------------------------------------------------------------- *)
(* [loop_handle] stops if it encounters an error, and at this point, invokes
its failure continuation, without letting Menhir do its own traditional
error-handling (which involves popping the stack, etc.). *)
let rec loop_handle succeed fail read checkpoint =
match checkpoint with
| InputNeeded _ ->
(* 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 triple = read() in
let checkpoint = offer checkpoint triple in
loop_handle succeed fail read checkpoint
| Shifting _
| AboutToReduce _ ->
(* The parser has suspended itself, but does not need
new input. Just resume the parser. Then, repeat. *)
let checkpoint = resume checkpoint in
loop_handle succeed fail read checkpoint
| HandlingError _
| Rejected ->
(* The parser has detected an error. Invoke the failure continuation. *)
fail checkpoint
| Accepted v ->
(* The parser has succeeded and produced a semantic value.
Return this semantic value to the user. *)
succeed v
(* --------------------------------------------------------------------------- *)
(* The type ['a lr1state] describes the (non-initial) states of the LR(1)
automaton. The index ['a] represents the type of the semantic value
associated with the state's incoming symbol. *)
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment