Skip to content
GitLab
Menu
Projects
Groups
Snippets
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Menu
Open sidebar
POTTIER Francois
menhir
Commits
387f748a
Commit
387f748a
authored
Oct 19, 2015
by
POTTIER Francois
Browse files
Added [loop_test].
parent
39dd2d39
Changes
4
Hide whitespace changes
Inline
Side-by-side
TODO
View file @
387f748a
...
...
@@ -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.?
...
...
src/ErrorReporting.ml
View file @
387f748a
...
...
@@ -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
)
[]
)
...
...
src/IncrementalEngine.ml
View file @
387f748a
...
...
@@ -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. *)
...
...
src/engine.ml
View file @
387f748a
...
...
@@ -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)
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment