Commit 387f748a authored by POTTIER Francois's avatar POTTIER Francois

Added [loop_test].

parent 39dd2d39
......@@ -122,7 +122,7 @@
* Suite des patchs de Frédéric Bour.
API d'inspection complète.
Documenter loop_handle_undo.
Documenter loop_handle_undo, loop_test.
Exposer le nombre d'états (pour la mémoisation).
Idem pour les productions.
Fonctions d'affichage pour les types terminal, nonterminal, etc.?
......
......@@ -99,52 +99,31 @@ module Make
| _ :: _, lazy Nil ->
assert false
(* [investigate t checkpoint] assumes that [checkpoint] has been obtained by
offering the terminal symbol [t] to the parser. It runs the parser,
through an arbitrary number of reductions, until the parser either
accepts this token (i.e., shifts) or rejects it (i.e., signals an
error). If the parser decides to shift, then the shift items found
in the LR(1) state before the shift are used to produce new explanations. *)
(* It is desirable that the semantic actions be side-effect free, or
that their side-effects be harmless (replayable). *)
let rec investigate (t : _ terminal) (checkpoint : _ checkpoint) explanations =
match checkpoint with
| Shifting (env, _, _) ->
(* The parser is about to shift, which means it is willing to
consume the terminal symbol [t]. In the state before the
transition, look at the items that justify shifting [t].
We view these items as explanations: they explain what
we have read and what we expect to read. *)
let stack = stack env in
List.fold_left (fun explanations item ->
if is_shift_item t item then
let prod, index = item in
let rhs = rhs prod in
{
item = item;
past = List.rev (marry (List.rev (take index rhs)) stack)
} :: explanations
else
explanations
) explanations (items_current env)
(* TEMPORARY [env] may be an initial state! violating [item_current]'s precondition *)
| AboutToReduce _ ->
(* The parser wishes to reduce. Just follow. *)
investigate t (resume checkpoint) explanations
| HandlingError _ ->
(* The parser fails, which means the terminal symbol [t] does
not make sense at this point. Thus, no new explanations of
what the parser expects need be produced. *)
(* [accumulate t env explanations] is called if the parser decides to shift
the test token [t]. The parameter [env] describes the parser configuration
before it shifts this token. (Some reductions have taken place.) We use the
shift items found in [env] to produce new explanations. *)
let accumulate (t : _ terminal) env explanations =
(* The parser is about to shift, which means it is willing to
consume the terminal symbol [t]. In the state before the
transition, look at the items that justify shifting [t].
We view these items as explanations: they explain what
we have read and what we expect to read. *)
let stack = stack env in
List.fold_left (fun explanations item ->
if is_shift_item t item then
let prod, index = item in
let rhs = rhs prod in
{
item = item;
past = List.rev (marry (List.rev (take index rhs)) stack)
} :: explanations
else
explanations
| InputNeeded _
| Accepted _
| Rejected ->
(* None of these cases can arise. Indeed, after a token is submitted
to it, the parser must shift, reduce, or signal an error, before
it can request another token or terminate. *)
assert false
) explanations (items_current env)
(* TEMPORARY [env] may be an initial state!
violating [item_current]'s precondition *)
(* [investigate pos checkpoint] assumes that [checkpoint] is of the form
[InputNeeded _]. For every terminal symbol [t], it investigates
......@@ -163,7 +142,8 @@ module Make
(* Build a dummy token for the terminal symbol [t]. *)
let token = (terminal2token t, pos, pos) in
(* Submit it to the parser. Accumulate explanations. *)
investigate t (offer checkpoint token) explanations
let checkpoint = offer checkpoint token in
I.loop_test (accumulate t) checkpoint explanations
) []
)
......
......@@ -125,6 +125,21 @@ module type INCREMENTAL_ENGINE = sig
('a checkpoint -> 'a checkpoint -> 'answer) ->
supplier -> 'a checkpoint -> 'answer
(* [loop_test f checkpoint accu] assumes that [checkpoint] has been obtained
by submitting a token to the parser. It runs the parser from [checkpoint],
through an arbitrary number of reductions, until the parser either accepts
this token (i.e., shifts) or rejects it (i.e., signals an error). If the
parser decides to shift, then the accumulator is updated by applying the
user function [f] to the [env] just before shifting and to the old [accu].
Otherwise, the accumulator is not updated, i.e., [accu] is returned. *)
(* It is desirable that the semantic actions be side-effect free, or that
their side-effects be harmless (replayable). *)
val loop_test:
(env -> 'accu -> 'accu) ->
'a checkpoint -> 'accu -> 'accu
(* 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. *)
......
......@@ -575,6 +575,41 @@ module Make (T : TABLE) = struct
assert (match checkpoint with InputNeeded _ -> true | _ -> false);
loop_handle_undo succeed fail read (checkpoint, checkpoint)
(* ------------------------------------------------------------------------ *)
(* [loop_test f checkpoint accu] assumes that [checkpoint] has been obtained
by submitting a token to the parser. It runs the parser from [checkpoint],
through an arbitrary number of reductions, until the parser either accepts
this token (i.e., shifts) or rejects it (i.e., signals an error). If the
parser decides to shift, then the accumulator is updated by applying the
user function [f] to the [env] just before shifting and to the old [accu].
Otherwise, the accumulator is not updated, i.e., [accu] is returned. *)
(* It is desirable that the semantic actions be side-effect free, or that
their side-effects be harmless (replayable). *)
let rec loop_test f checkpoint accu =
match checkpoint with
| Shifting (env, _, _) ->
(* The parser is about to shift, which means it is willing to
consume the terminal symbol that we have fed it. Update the
accumulator with the state just before this transition. *)
f env accu
| AboutToReduce _ ->
(* The parser wishes to reduce. Just follow. *)
loop_test f (resume checkpoint) accu
| HandlingError _ ->
(* The parser fails, which means it rejects the terminal symbol
that we have fed it. Do not update the accumulator. *)
accu
| InputNeeded _
| Accepted _
| Rejected ->
(* None of these cases can arise. Indeed, after a token is submitted
to it, the parser must shift, reduce, or signal an error, before
it can request another token or terminate. *)
assert false
(* --------------------------------------------------------------------------- *)
(* The type ['a lr1state] describes the (non-initial) states of the LR(1)
......
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