Commit ded66261 authored by POTTIER Francois's avatar POTTIER Francois

In the table back-end, the semantic action is no longer responsible

for updating [env.stack]. Instead, it returns the new stack.
This corresponds to Frédéric's "Isolate side-effects from table-backend generated code".
parent e78d5ac8
...@@ -181,6 +181,9 @@ module Make (T : TABLE) = struct ...@@ -181,6 +181,9 @@ module Make (T : TABLE) = struct
contains a new semantic value, and raising [Accept] or [Error] if contains a new semantic value, and raising [Accept] or [Error] if
appropriate. *) appropriate. *)
(* If the semantic action terminates normally, it returns a new stack,
which we write into [env.stack]. *)
(* If the semantic action raises [Error], we catch it immediately and (* If the semantic action raises [Error], we catch it immediately and
initiate error handling. *) initiate error handling. *)
...@@ -189,7 +192,7 @@ module Make (T : TABLE) = struct ...@@ -189,7 +192,7 @@ module Make (T : TABLE) = struct
if ( if (
try try
T.semantic_action prod env; env.stack <- T.semantic_action prod env;
true true
with Error -> with Error ->
false false
......
...@@ -200,14 +200,16 @@ module type TABLE = sig ...@@ -200,14 +200,16 @@ module type TABLE = sig
1. fetching whatever semantic values and positions it needs off the stack; 1. fetching whatever semantic values and positions it needs off the stack;
2. popping an appropriate number of cells off the stack, as dictated 2. popping an appropriate number of cells off the stack, as dictated
by the length of the right-hand side of the production; this involves by the length of the right-hand side of the production;
updating [env.stack];
3. computing a new semantic value, as well as new start and end positions; 3. computing a new semantic value, as well as new start and end positions;
4. pushing a new stack cell, which contains the three values 4. pushing a new stack cell, which contains the three values
computed in step 3; this again involves updating [env.stack] computed in step 3;
(only one update is necessary).
5. returning the new stack computed in steps 2 and 4. The environment
is not affected: the caller of the semantic action is responsible
for writing the new stack into [env.stack].
Point 1 is essentially forced upon us: if semantic values were fetched Point 1 is essentially forced upon us: if semantic values were fetched
off the stack by this interpreter, then the calling convention for off the stack by this interpreter, then the calling convention for
...@@ -226,7 +228,7 @@ module type TABLE = sig ...@@ -226,7 +228,7 @@ module type TABLE = sig
exception Error exception Error
type semantic_action = type semantic_action =
(state, semantic_value, token) env -> unit (state, semantic_value, token) env -> (state, semantic_value) stack
val semantic_action: production -> semantic_action val semantic_action: production -> semantic_action
......
...@@ -82,8 +82,11 @@ module T = struct ...@@ -82,8 +82,11 @@ module T = struct
exception Accept of semantic_value exception Accept of semantic_value
exception Error exception Error
(* By convention, a semantic action returns a new stack. It does not
affect [env]. *)
type semantic_action = type semantic_action =
(state, semantic_value, token) env -> unit (state, semantic_value, token) env -> (state, semantic_value) stack
let semantic_action (prod : production) : semantic_action = let semantic_action (prod : production) : semantic_action =
fun env -> fun env ->
...@@ -156,7 +159,7 @@ module T = struct ...@@ -156,7 +159,7 @@ module T = struct
(* Construct and push a new stack cell. The associated semantic (* Construct and push a new stack cell. The associated semantic
value is a new concrete syntax tree. *) value is a new concrete syntax tree. *)
env.stack <- { {
state = env.current; state = env.current;
semv = CstNonTerminal (prod, values); semv = CstNonTerminal (prod, values);
startp = !startp; startp = !startp;
......
...@@ -202,16 +202,15 @@ let reducebody prod = ...@@ -202,16 +202,15 @@ let reducebody prod =
extrabindings action @ (* add bindings for the weird keywords *) extrabindings action @ (* add bindings for the weird keywords *)
[ PVar semv, act ], (* run the user's code and bind [semv] *) [ PVar semv, act ], (* run the user's code and bind [semv] *)
ERecordWrite ( (* Return a new stack, onto which we have pushed a new stack cell. *)
EVar env, fstack, (* update the stack with ... *)
ERecord [ (* ... a new stack cell *) ERecord [ (* the new stack cell *)
fstate, EVar state; (* the current state after popping; it will be updated by [goto] *) fstate, EVar state; (* the current state after popping; it will be updated by [goto] *)
fsemv, ERepr (EVar semv); (* the newly computed semantic value *) fsemv, ERepr (EVar semv); (* the newly computed semantic value *)
fstartp, EVar startp; (* the newly computed start and end positions *) fstartp, EVar startp; (* the newly computed start and end positions *)
fendp, EVar endp; fendp, EVar endp;
fnext, EVar stack; (* this is the stack after popping *) fnext, EVar stack; (* this is the stack after popping *)
] ]
)
) )
) )
......
...@@ -98,7 +98,8 @@ module type TABLES = sig ...@@ -98,7 +98,8 @@ module type TABLES = sig
actions. The calling convention for semantic actions is described in actions. The calling convention for semantic actions is described in
[EngineTypes]. *) [EngineTypes]. *)
val semantic_action: ((int, Obj.t, token) EngineTypes.env -> unit) array val semantic_action: ((int, Obj.t, token) EngineTypes.env ->
(int, Obj.t) EngineTypes.stack) array
(* The parser defines its own [Error] exception. This exception can be (* The parser defines its own [Error] exception. This exception can be
raised by semantic actions and caught by the engine, and raised by the raised by semantic actions and caught by the engine, and raised by the
......
...@@ -96,7 +96,8 @@ module Make (T : TableFormat.TABLES) ...@@ -96,7 +96,8 @@ module Make (T : TableFormat.TABLES)
T.Error T.Error
type semantic_action = type semantic_action =
(state, semantic_value, token) EngineTypes.env -> unit (state, semantic_value, token) EngineTypes.env ->
(state, semantic_value) EngineTypes.stack
let semantic_action prod = let semantic_action prod =
T.semantic_action.(prod) T.semantic_action.(prod)
......
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