Commit 843faef0 authored by POTTIER Francois's avatar POTTIER Francois

Cleanup and comments in [InspectionTableInterpreter].

Also, remove a logging call in [feed_terminal].
parent d717dc51
...@@ -233,25 +233,34 @@ module Make ...@@ -233,25 +233,34 @@ module Make
semantic value of type ['a]. The type ['a symbol] is not available in semantic value of type ['a]. The type ['a symbol] is not available in
[Engine]. It is available here. *) [Engine]. It is available here. *)
open ET
open EngineTypes open EngineTypes
open ET
open E
(* TEMPORARY potential danger: (* [feed] fails if the current state does not have an outgoing transition
- attempting to take a transition that does not exist labeled with the desired symbol. This check is carried out at runtime. *)
(checked at runtime; raises Invalid_argument)
- supplying a semantic value of incorrect type (statically checked
by correlating 'a nonterminal with 'a) *)
let feed_failure () = let feed_failure () =
invalid_arg "feed: outgoing transition does not exist" invalid_arg "feed: outgoing transition does not exist"
let feed_nonterminal nt startp semv endp (env : _ E.env) = (* Feeding a nonterminal symbol [nt]. Here, [nt] has type [nonterminal],
let source : state = env.current in which is a synonym for [int], and [semv] has type [semantic_value],
which is a synonym for [Obj.t]. This type is unsafe, because pushing
a semantic value of arbitrary type into the stack can later cause a
semantic action to crash and burn. The function [feed] is given a safe
type below. *)
let feed_nonterminal
(nt : nonterminal) startp (semv : semantic_value) endp (env : 'b env)
: 'b env
=
(* Check if the source state has an outgoing transition labeled [nt].
This is done by consulting the [goto] table. *)
let source = env.current in
match ET.maybe_goto_nt source nt with match ET.maybe_goto_nt source nt with
| None -> | None ->
feed_failure() feed_failure()
| Some (target : state) -> | Some target ->
(* Push a new cell onto the stack, containing the identity of the 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] that we are leaving. The semantic value [semv] and positions [startp]
and [endp] contained in the new cell are provided by the caller. *) and [endp] contained in the new cell are provided by the caller. *)
...@@ -259,24 +268,29 @@ module Make ...@@ -259,24 +268,29 @@ module Make
(* Move to the target state. *) (* Move to the target state. *)
{ env with stack; current = target } { env with stack; current = target }
let feed_terminal terminal startp semv endp env = let reduce _env _prod = feed_failure()
ET.action let initiate _env = feed_failure()
env.current
terminal let feed_terminal
semv (terminal : terminal) startp (semv : semantic_value) endp (env : 'b env)
(fun env _please_discard terminal semv s' -> : 'b env
if log then =
Log.shift terminal s'; (* Check if the source state has an outgoing transition labeled [terminal].
let stack = { This is done by consulting the [action] table. *)
state = env.current; semv; startp; endp; next = env.stack; let source = env.current in
} in ET.action source terminal semv
{ env with stack; current = s' } (fun env _please_discard _terminal semv target ->
) (* There is indeed a transition toward the state [target].
(fun _env _prod -> feed_failure()) Push a new cell onto the stack and move to the target state. *)
(fun _env -> feed_failure()) let stack = { state = source; semv; startp; endp; next = env.stack } in
env { env with stack; current = target }
) reduce initiate env
let feed symbol startp semv endp env =
(* The type assigned to [feed] ensures that the type of the semantic value
[semv] is appropriate: it must be the semantic-value type of the symbol
[symbol]. *)
let feed (symbol : 'a symbol) startp (semv : 'a) endp env =
let semv : semantic_value = Obj.repr semv in let semv : semantic_value = Obj.repr semv in
match symbol with match symbol with
| N nt -> | N nt ->
......
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