Commit e8722212 authored by POTTIER Francois's avatar POTTIER Francois

Publish the function [feed] as part of the signature [INSPECTION].

parent 041eb8e1
......@@ -367,6 +367,20 @@ module type INSPECTION = sig
val foreach_terminal: (xsymbol -> 'a -> 'a) -> 'a -> 'a
val foreach_terminal_but_error: (xsymbol -> 'a -> 'a) -> 'a -> 'a
(* The type [env] is meant to be the same as in [INCREMENTAL_ENGINE]. *)
type env
(* [feed symbol startp semv endp env] forces the parser to consume the
(terminal or nonterminal) symbol [symbol], accompanied with the semantic
value [semv] and with the positions [startp] and [endp]. Thus, the
automaton makes a transition, and reaches a new state. The stack grows by
one cell. This operation is permitted only if the current state (as
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
end
(* This signature combines the incremental API and the inspection API. *)
......@@ -378,5 +392,6 @@ module type EVERYTHING = sig
include INSPECTION
with type 'a lr1state := 'a lr1state
with type production := production
with type env := env
end
......@@ -220,20 +220,26 @@ module Make
f (IT.terminal i) accu
) accu
(* ------------------------------------------------------------------------ *)
open ET
open EngineTypes
(* TEMPORARY potential danger:
- attempting to take a transition that does not exist
(checked at runtime; raises Invalid_argument)
- supplying a semantic value of incorrect type (statically checked
by correlating 'a nonterminal with 'a) *)
open EngineTypes
let feed_failure () =
invalid_arg "feed: outgoing transition does not exist"
let _feed_nonterminal nt startp semv endp (env : E.env) =
let source : ET.state = env.current in
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 ->
invalid_arg "feed_nonterminal: outgoing transition does not exist"
| Some (target : ET.state) ->
feed_failure()
| Some (target : state) ->
(* Push a new cell onto the stack, containing the identity of the state
that we are leaving. The semantic value [semv] and positions [startp]
and [endp] contained in the new cell are provided by the caller. *)
......@@ -241,23 +247,29 @@ module Make
(* Move to the target state. *)
{ env with stack; current = target }
let _feed_terminal terminal startp semv endp env =
let feed_terminal terminal startp semv endp env =
ET.action
env.current
terminal
semv
(fun env _please_discard terminal semv s' ->
if ET.log then
ET.Log.shift terminal s';
if log then
Log.shift terminal s';
let stack = {
state = env.current; semv; startp; endp; next = env.stack;
} in
{ env with stack; current = s' }
)
(fun _env _prod ->
invalid_arg "cannot reduce")
(fun _env ->
invalid_arg "cannot reduce")
(fun _env _prod -> feed_failure())
(fun _env -> feed_failure())
env
let feed symbol startp semv endp env =
let semv : semantic_value = Obj.repr semv in
match symbol with
| N nt ->
feed_nonterminal (n2i nt) startp semv endp env
| T terminal ->
feed_terminal (t2i terminal) startp semv endp env
end
......@@ -45,3 +45,4 @@ module Make
and type 'a nonterminal := 'a IT.nonterminal
and type 'a lr1state := 'a IT.lr1state
and type production := int
and type env := E.env
......@@ -117,7 +117,8 @@ let inspection_api grammar () =
[ a ], "lr1state", tlr1state (TypVar a);
[], "production", TypApp ("production", []);
[ a ], TokenType.tctokengadt, TokenType.ttokengadt (TypVar a);
[ a ], NonterminalType.tcnonterminalgadt, NonterminalType.tnonterminalgadt (TypVar a)
[ a ], NonterminalType.tcnonterminalgadt, NonterminalType.tnonterminalgadt (TypVar a);
[], "env", TypApp ("env", []);
]
) ::
......@@ -190,4 +191,3 @@ let write grammar () =
end) in
P.interface (interface grammar);
close_out mli
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