Commit 4a073863 authored by POTTIER Francois's avatar POTTIER Francois

Parameterize the type [env] with ['a] again, so [input_needed] is safe.

parent afed59db
......@@ -27,7 +27,7 @@ module Make (T : TABLE) = struct
include T
type env =
type 'a env =
(state, semantic_value, token) EngineTypes.env
(* --------------------------------------------------------------------------- *)
......@@ -40,11 +40,16 @@ module Make (T : TABLE) = struct
(i.e., continuations) that do not make sense. (Such continuations could
potentially violate the LR invariant and lead to crashes.) *)
(* 2017/03/29 Although [checkpoint] is a private type, we now expose a
constructor function, [input_needed]. This function allows manufacturing
a checkpoint out of an environment. For this reason, the type [env] must
also be parameterized with ['a]. *)
type 'a checkpoint =
| InputNeeded of env
| Shifting of env * env * bool
| AboutToReduce of env * production
| HandlingError of env
| InputNeeded of 'a env
| Shifting of 'a env * 'a env * bool
| AboutToReduce of 'a env * production
| HandlingError of 'a env
| Accepted of 'a
| Rejected
......@@ -736,7 +741,7 @@ module Make (T : TABLE) = struct
(* TEMPORARY comment *)
(* TEMPORARY add calls to new [Log] functions? : log [pop], [feed], [force] *)
let pop (env : env) : env option =
let pop (env : 'a env) : 'a env option =
let cell = env.stack in
let next = cell.next in
if next == cell then
......@@ -754,7 +759,7 @@ module Make (T : TABLE) = struct
by calling [run env] or [initiate env]. Instead, it returns [env] to the
user, or raises [Error]. *)
let force_reduction prod (env : env) : env =
let force_reduction prod (env : 'a env) : 'a env =
(* Check if this reduction is permitted. This check is REALLY important.
The stack must have the correct shape: that is, it must be sufficiently
high, and must contain semantic values of appropriate types, otherwise
......@@ -784,7 +789,7 @@ module Make (T : TABLE) = struct
(not really problematic? but worth noting)
- for type safety, should correlate 'a env with 'a checkpoint
*)
let input_needed (env : env) : 'a checkpoint =
let input_needed (env : 'a env) : 'a checkpoint =
InputNeeded env
end
......@@ -21,7 +21,7 @@ module Make (T : TABLE)
and type token = T.token
and type semantic_value = T.semantic_value
and type production = T.production
and type env = (T.state, T.semantic_value, T.token) EngineTypes.env
and type 'a env = (T.state, T.semantic_value, T.token) EngineTypes.env
(* We would prefer not to expose the definition of the type [env].
However, it must be exposed because some of the code in the
......
......@@ -47,15 +47,27 @@ module type INCREMENTAL_ENGINE = sig
(* [HandlingError] is an intermediate checkpoint. It means that the parser has
detected an error and is currently handling it, in several steps. *)
type env
(* A value of type ['a env] represents a configuration of the automaton:
current state, stack, lookahead token, etc. The parameter ['a] is the
type of the semantic value that will eventually be produced if the parser
succeeds. *)
(* In normal operation, the parser works with checkpoints: see the functions
[offer] and [resume]. However, it is also possible to work directly with
environments (see the functions [pop], [force_reduction], and [feed]) and
to reconstruct a checkpoint out of an environment (see [input_needed]).
This is considered advanced functionality; its purpose is to allow error
recovery strategies to be programmed by the user. *)
type 'a env
type production
type 'a checkpoint = private
| InputNeeded of env
| Shifting of env * env * bool
| AboutToReduce of env * production
| HandlingError of env
| InputNeeded of 'a env
| Shifting of 'a env * 'a env * bool
| AboutToReduce of 'a env * production
| HandlingError of 'a env
| Accepted of 'a
| Rejected
......@@ -150,7 +162,7 @@ module type INCREMENTAL_ENGINE = sig
their side-effects be harmless (replayable). *)
val loop_test:
(env -> 'accu -> 'accu) ->
('a env -> 'accu -> 'accu) ->
'a checkpoint -> 'accu -> 'accu
(* The function [loop_test] can be used, after an error has been detected, to
......@@ -175,7 +187,7 @@ module type INCREMENTAL_ENGINE = sig
amounts to pretending that the (terminal or nonterminal) symbol that
corresponds to this stack cell has not been read. *)
val pop: env -> env option
val pop: 'a env -> 'a env option
(* [force_reduction prod env] should be called only if in the current state
(as determined by [env]) the parser is capable of reducing the production
......@@ -184,7 +196,7 @@ module type INCREMENTAL_ENGINE = sig
effects!) and the automaton makes a goto (nonterminal) transition. If
this condition is not satisfied, [Invalid_argument _] is raised. *)
val force_reduction: production -> env -> env
val force_reduction: production -> 'a env -> 'a env
(* [input_needed env] returns [InputNeeded env]. That is, out of an [env]
that might have been obtained via a series of calls to the functions
......@@ -200,7 +212,7 @@ module type INCREMENTAL_ENGINE = sig
Menhir's new error reporting facility, this could cause the parser to
reach an error state for which no error message has been prepared. *)
val input_needed: env -> 'a checkpoint
val input_needed: 'a env -> 'a checkpoint
(* 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
......@@ -237,20 +249,20 @@ module type INCREMENTAL_ENGINE = sig
automaton's current state is the one found in the top element of the
stack. *)
val stack: env -> stack
val stack: 'a env -> stack
(* These are the start and end positions of the current lookahead token. If
invoked in an initial state, this function returns a pair of twice the
initial position. *)
val positions: env -> Lexing.position * Lexing.position
val positions: 'a env -> Lexing.position * Lexing.position
(* This tells whether the parser is about to perform a default reduction.
In particular, when applied to an environment taken from a result of
the form [AboutToReduce (env, prod)], this tells whether the reduction
that is about to take place is a default reduction. *)
val has_default_reduction: env -> bool
val has_default_reduction: 'a env -> bool
end
......@@ -369,7 +381,7 @@ module type INSPECTION = sig
(* The type [env] is meant to be the same as in [INCREMENTAL_ENGINE]. *)
type env
type 'a env
(* [feed symbol startp semv endp env] forces the parser to consume the
(terminal or nonterminal) symbol [symbol], accompanied with the semantic
......@@ -379,7 +391,7 @@ module type INSPECTION = sig
determined by [env]) has an outgoing transition labeled with [symbol].
Otherwise, [Invalid_argument _] is raised. *)
val feed: 'a symbol -> Lexing.position -> 'a -> Lexing.position -> env -> env
val feed: 'a symbol -> Lexing.position -> 'a -> Lexing.position -> 'b env -> 'b env
end
......@@ -392,6 +404,6 @@ module type EVERYTHING = sig
include INSPECTION
with type 'a lr1state := 'a lr1state
with type production := production
with type env := env
with type 'a env := 'a env
end
......@@ -48,7 +48,7 @@ module Make
with type terminal = int
and type nonterminal = int
and type semantic_value = Obj.t)
(E : sig type env = (ET.state, ET.semantic_value, ET.token) EngineTypes.env end)
(E : sig type 'a env = (ET.state, ET.semantic_value, ET.token) EngineTypes.env end)
= struct
(* Including [IT] is an easy way of inheriting the definitions of the types
......@@ -234,7 +234,7 @@ module Make
let feed_failure () =
invalid_arg "feed: outgoing transition does not exist"
let feed_nonterminal nt startp semv endp (env : E.env) =
let feed_nonterminal nt startp semv endp (env : _ E.env) =
let source : state = env.current in
match ET.maybe_goto_nt source nt with
| None ->
......
......@@ -38,11 +38,11 @@ module Make
with type terminal = int
and type nonterminal = int
and type semantic_value = Obj.t)
(E : sig type env = (ET.state, ET.semantic_value, ET.token) EngineTypes.env end)
(E : sig type 'a env = (ET.state, ET.semantic_value, ET.token) EngineTypes.env end)
: IncrementalEngine.INSPECTION
with type 'a terminal := 'a IT.terminal
and type 'a nonterminal := 'a IT.nonterminal
and type 'a lr1state := 'a IT.lr1state
and type production := int
and type env := E.env
and type 'a env := 'a E.env
......@@ -66,12 +66,11 @@ module Make
as a number; then the list of its LR(0) items is printed. (Ending with
a newline.) *)
val print_current_state: env -> unit
val print_current_state: 'a env -> unit
(* Printing a summary of the stack and current state. This function just
calls [print_stack] and [print_current_state] in succession. *)
val print_env: env -> unit
val print_env: 'a env -> unit
end
......@@ -118,7 +118,7 @@ let inspection_api grammar () =
[], "production", TypApp ("production", []);
[ a ], TokenType.tctokengadt, TokenType.ttokengadt (TypVar a);
[ a ], NonterminalType.tcnonterminalgadt, NonterminalType.tnonterminalgadt (TypVar a);
[], "env", TypApp ("env", []);
[ a ], "env", TypApp ("env", [ TypVar a ]);
]
) ::
......
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