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".

src/engine.ml

@@ -181,6 +181,9 @@ module Make (T : TABLE) = struct
        contains a new semantic value, and raising [Accept] or [Error] if
        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
        initiate error handling. *)
 
@@ -189,7 +192,7 @@ module Make (T : TABLE) = struct
 
     if (
       try
-	T.semantic_action prod env;
+	env.stack <- T.semantic_action prod env;
 	true
       with Error ->
 	false

src/engineTypes.ml

@@ -200,14 +200,16 @@ module type TABLE = sig
      1. fetching whatever semantic values and positions it needs off the stack;
 
      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
-     updating [env.stack];
+        by the length of the right-hand side of the production;
 
      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
-     computed in step 3; this again involves updating [env.stack]
-     (only one update is necessary).
+        computed in step 3;
+
+     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
      off the stack by this interpreter, then the calling convention for
@@ -226,7 +228,7 @@ module type TABLE = sig
   exception Error
 
   type semantic_action =
-      (state, semantic_value, token) env -> unit
+      (state, semantic_value, token) env -> (state, semantic_value) stack
 
   val semantic_action: production -> semantic_action
 

src/referenceInterpreter.ml

@@ -82,8 +82,11 @@ module T = struct
   exception Accept of semantic_value
   exception Error
 
+  (* By convention, a semantic action returns a new stack. It does not
+     affect [env]. *)
+
   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 =
     fun env ->
@@ -156,7 +159,7 @@ module T = struct
 	  (* Construct and push a new stack cell. The associated semantic
 	     value is a new concrete syntax tree. *)
 
-	  env.stack <- {
+	  {
 	    state = env.current;
 	    semv = CstNonTerminal (prod, values);
 	    startp = !startp;

src/tableBackend.ml

@@ -202,16 +202,15 @@ let reducebody prod =
 	  extrabindings action @                (* add bindings for the weird keywords *)
 	  [ PVar semv, act ],                   (* run the user's code and bind [semv] *)
 
-	  ERecordWrite (
-	    EVar env, fstack,                   (* update the stack with ... *)
-	    ERecord [                           (* ... a new stack cell *)
-	      fstate, EVar state;               (* the current state after popping; it will be updated by [goto] *)
-	      fsemv, ERepr (EVar semv);         (* the newly computed semantic value *)
-	      fstartp, EVar startp;             (* the newly computed start and end positions *)
-	      fendp, EVar endp;
-	      fnext, EVar stack;                (* this is the stack after popping *)
-	    ]
-	  )
+          (* Return a new stack, onto which we have pushed a new stack cell. *)
+
+          ERecord [                             (* the new stack cell *)
+            fstate, EVar state;                 (* the current state after popping; it will be updated by [goto] *)
+            fsemv, ERepr (EVar semv);           (* the newly computed semantic value *)
+            fstartp, EVar startp;               (* the newly computed start and end positions *)
+            fendp, EVar endp;
+            fnext, EVar stack;                  (* this is the stack after popping *)
+          ]
 
 	)
       )

src/tableFormat.ml

@@ -98,7 +98,8 @@ module type TABLES = sig
      actions. The calling convention for semantic actions is described in
      [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
      raised by semantic actions and caught by the engine, and raised by the

src/tableInterpreter.ml

@@ -96,7 +96,8 @@ module Make (T : TableFormat.TABLES)
 	T.Error
 
   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 =
     T.semantic_action.(prod)