Commit 0ef26d5d authored by POTTIER Francois's avatar POTTIER Francois

Updated the table back-end to properly initialize the position in the sentinel…

Updated the table back-end to properly initialize the position in the sentinel cell at the bottom of the stack. This requires changing the function [start] in the incremental API to take a position. Updated the doc and demos.
parent ed0ce7a6
2015/11/04:
Incompatible change of the incremental API: instead of a unit argument, the
entry points (which are named after the start symbol) now require an initial
position, which typically should be [lexbuf.lex_curr_p].
2015/11/03:
Fix-fix-and-re-fix the Makefile in an attempt to allow installation under
opam/Windows. Thanks to Daniel Weil for patient explanations and testing.
......
* Ongoing work on positions.
Remove the function [positions] in the incremental API? or update its doc.
* Develop an alternate src/Makefile that does not require ocamlbuild?
Could use OCamlMakefile instead, for instance.
......
open Lexing
(* A short name for the incremental parser API. *)
module I =
......@@ -17,8 +19,8 @@ let rec loop lexbuf (checkpoint : int I.checkpoint) =
and offer it to the parser, which will produce a new
checkpoint. Then, repeat. *)
let token = Lexer.token lexbuf in
let startp = lexbuf.Lexing.lex_start_p
and endp = lexbuf.Lexing.lex_curr_p in
let startp = lexbuf.lex_start_p
and endp = lexbuf.lex_curr_p in
let checkpoint = I.offer checkpoint (token, startp, endp) in
loop lexbuf checkpoint
| I.Shifting _
......@@ -29,7 +31,7 @@ let rec loop lexbuf (checkpoint : 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)
(lexeme_start lexbuf)
| I.Accepted v ->
(* The parser has succeeded and produced a semantic value. Print it. *)
Printf.printf "%d\n%!" v
......@@ -52,7 +54,7 @@ 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)
(lexeme_start lexbuf)
let loop lexbuf result =
let supplier = I.lexer_lexbuf_to_supplier Lexer.token lexbuf in
......@@ -63,9 +65,9 @@ let loop lexbuf result =
(* Initialize the lexer, and catch any exception raised by the lexer. *)
let process (line : string) =
let lexbuf = Lexing.from_string line in
let lexbuf = from_string line in
try
loop lexbuf (Parser.Incremental.main())
loop lexbuf (Parser.Incremental.main lexbuf.lex_curr_p)
with
| Lexer.Error msg ->
Printf.fprintf stderr "%s%!" msg
......@@ -89,5 +91,5 @@ let rec repeat channel =
repeat channel
let () =
repeat (Lexing.from_channel stdin)
repeat (from_channel stdin)
open Lexing
open MenhirLib.General
open Parser.MenhirInterpreter
......@@ -28,17 +29,17 @@ let print_explanation explanation =
let print_explanations startp explanations =
Printf.fprintf stderr
"At line %d, column %d: syntax error.\n"
startp.Lexing.pos_lnum
startp.Lexing.pos_cnum;
startp.pos_lnum
startp.pos_cnum;
List.iter print_explanation explanations;
flush stderr
(* The rest of the code is as in the [calc] demo. *)
let process (line : string) =
let lexbuf = Lexing.from_string line in
let lexbuf = from_string line in
try
let v = E.entry (Parser.Incremental.main()) Lexer.token lexbuf in
let v = E.entry (Parser.Incremental.main lexbuf.lex_curr_p) Lexer.token lexbuf in
Printf.printf "%d\n%!" v
with
| Lexer.Error msg ->
......@@ -61,5 +62,5 @@ let rec repeat channel =
repeat channel
let () =
repeat (Lexing.from_channel stdin)
repeat (from_channel stdin)
......@@ -1972,11 +1972,13 @@ the name of the start symbol.) The generated file \texttt{parser.mli} contains
the following declaration:
\begin{verbatim}
module Incremental : sig
val main: unit -> thing MenhirInterpreter.checkpoint
val main: Lexing.position -> thing MenhirInterpreter.checkpoint
end
\end{verbatim}
The argument is the initial position. If the lexer is based on an OCaml
lexing buffer, this argument should be \verb+lexbuf.lex_curr_p+.
We emphasize that the function \verb+Incremental.main+ does not parse
anything. It constructs a parser state which serves as a \emph{starting}
anything. It constructs a checkpoint which serves as a \emph{starting}
point. The functions \verb+offer+ and \verb+resume+, described below, are used
to drive the parser.
......
......@@ -7,16 +7,6 @@ open EngineTypes
- at compile time, if so requested by the user, via the --interpret options;
- at run time, in the table-based back-end. *)
(* A tainted dummy position. In principle, it should never be exposed. *)
let dummy_pos =
let open Lexing in {
pos_fname = "<MenhirLib.Engine>";
pos_lnum = 0;
pos_bol = 0;
pos_cnum = -1;
}
module Make (T : TABLE) = struct
(* This propagates type and exception definitions. *)
......@@ -355,18 +345,19 @@ module Make (T : TABLE) = struct
(* [start s] begins the parsing process. *)
let start (s : state) : semantic_value checkpoint =
let start (s : state) (initial : Lexing.position) : semantic_value checkpoint =
(* Build an empty stack. This is a dummy cell, which is its own
successor. Its fields other than [next] contain dummy values.
Its [next] field WILL be accessed by [error_fail] if an error
occurs and is propagated all the way until the stack is empty. *)
(* Build an empty stack. This is a dummy cell, which is its own successor.
Its [next] field WILL be accessed by [error_fail] if an error occurs and
is propagated all the way until the stack is empty. Its [endp] field WILL
be accessed (by a semantic action) if an epsilon production is reduced
when the stack is empty. *)
let rec empty = {
state = s; (* dummy *)
semv = T.error_value; (* dummy *)
startp = dummy_pos; (* dummy *)
endp = dummy_pos; (* dummy *)
startp = initial; (* dummy *)
endp = initial;
next = empty;
} in
......@@ -382,7 +373,7 @@ module Make (T : TABLE) = struct
let dummy_token = Obj.magic () in
let env = {
error = false;
triple = (dummy_token, dummy_pos, dummy_pos); (* dummy *)
triple = (dummy_token, initial, initial); (* dummy *)
stack = empty;
current = s;
} in
......@@ -504,7 +495,8 @@ module Make (T : TABLE) = struct
raise Error
let entry (s : state) lexer lexbuf : semantic_value =
loop (lexer_lexbuf_to_supplier lexer lexbuf) (start s)
let initial = lexbuf.Lexing.lex_curr_p in
loop (lexer_lexbuf_to_supplier lexer lexbuf) (start s initial)
(* --------------------------------------------------------------------------- *)
......@@ -703,12 +695,8 @@ module Make (T : TABLE) = struct
(* Access to the position of the lookahead token. *)
let positions { triple = (_, startp, endp); _ } =
(* In principle, as soon as the lexer has been called at least once,
[startp] cannot be a dummy position. Our dummy position risks
exposure only if we are in the very initial state, as produced
by [start s] above. We declare this situation illegal. *)
assert (startp != dummy_pos && endp != dummy_pos);
startp, endp
(* TEMPORARY remove this function? *)
(* --------------------------------------------------------------------------- *)
......
......@@ -314,15 +314,17 @@ end
module type INCREMENTAL_ENGINE_START = sig
(* [start] is an entry point. It requires just a start state, and begins the
parsing process. It produces a checkpoint, which usually will be an
[InputNeeded] checkpoint. (It could be [Accepted] if this starting state
accepts only the empty word. It could be [Rejected] if this starting
state accepts no word at all.) It does not raise any exception. *)
(* [start s] should really produce a checkpoint of type ['a checkpoint], for
a fixed ['a] that depends on the state [s]. We cannot express this, so we
use [semantic_value checkpoint], which is safe. The table back-end uses
(* [start] is an entry point. It requires a start state and a start position
and begins the parsing process. If the lexer is based on an OCaml lexing
buffer, the start position should be [lexbuf.lex_curr_p]. [start] produces
a checkpoint, which usually will be an [InputNeeded] checkpoint. (It could
be [Accepted] if this starting state accepts only the empty word. It could
be [Rejected] if this starting state accepts no word at all.) It does not
raise any exception. *)
(* [start s pos] should really produce a checkpoint of type ['a checkpoint],
for a fixed ['a] that depends on the state [s]. We cannot express this, so
we use [semantic_value checkpoint], which is safe. The table back-end uses
[Obj.magic] to produce safe specialized versions of [start]. *)
type state
......@@ -331,6 +333,7 @@ module type INCREMENTAL_ENGINE_START = sig
val start:
state ->
Lexing.position ->
semantic_value checkpoint
end
......
......@@ -51,7 +51,7 @@ let incremental =
let entrytypescheme_incremental grammar symbol =
let t = TypTextual (ocamltype_of_start_symbol grammar symbol) in
type2scheme (marrow [ tunit ] (checkpoint t))
type2scheme (marrow [ tposition ] (checkpoint t))
(* -------------------------------------------------------------------------- *)
......
......@@ -320,8 +320,7 @@ let check_error_path log nt input =
| None ->
OInputReadPastEnd
| Some t ->
let dummy = Lexing.dummy_pos in
loop (E.offer checkpoint (t, dummy, dummy)) spurious
loop (E.offer checkpoint (t, Lexing.dummy_pos, Lexing.dummy_pos)) spurious
end
| E.Shifting _ ->
loop (E.resume checkpoint) spurious
......@@ -356,5 +355,5 @@ let check_error_path log nt input =
assert false
in
loop (E.start entry) []
loop (E.start entry Lexing.dummy_pos) []
......@@ -713,19 +713,21 @@ let monolithic_api : IL.valdef list =
(* An entry point to the incremental API. *)
let incremental_entry_point state nt t =
let initial = "initial_position" in
define (
Nonterminal.print true nt,
(* In principle the abstraction [fun () -> ...] should not be
necessary, since [start] is a pure function. However, when
[--trace] is enabled, [start] will log messages to the
standard error channel. *)
(* In principle the eta-expansion [fun initial_position -> start s
initial_position] should not be necessary, since [start] is a pure
function. However, when [--trace] is enabled, [start] will log messages
to the standard error channel. *)
EFun (
[ PUnit ],
[ PVar initial ],
EAnnot (
EMagic (
EApp (
EVar start, [
EIntConst (Lr1.number state);
EVar initial;
]
)
),
......
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