diff --git a/src/engine.ml b/src/engine.ml index 7f1b29263e9915ca4731e21a2bb783392dd93ef3..77b1e9b14c636e00024d868fbbcc22eabd167536 100644 --- a/src/engine.ml +++ b/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 diff --git a/src/engineTypes.ml b/src/engineTypes.ml index 6f8db5471689023d76ce4dec7876a76306c7359b..eed5d971679f8c6290be971bcac3ec4a0c97a1fe 100644 --- a/src/engineTypes.ml +++ b/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 diff --git a/src/referenceInterpreter.ml b/src/referenceInterpreter.ml index 808ce9fef3799e7f21b50c4ab4945ee04a4b0670..510eb878e8789d35bc9b43a3ac497170e29bdd5f 100644 --- a/src/referenceInterpreter.ml +++ b/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; diff --git a/src/tableBackend.ml b/src/tableBackend.ml index 64973e86c99f39837ce5adc895c132c7a0b7dfd7..9f13132693878f706145087cdafa240ea2464dc0 100644 --- a/src/tableBackend.ml +++ b/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 *) + ] ) ) diff --git a/src/tableFormat.ml b/src/tableFormat.ml index 8e1f0471ad234dcb895e3d3dad52b657e2959ecc..39615e99d7e2d98bd2abd63665fb841d05b8bc8d 100644 --- a/src/tableFormat.ml +++ b/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 diff --git a/src/tableInterpreter.ml b/src/tableInterpreter.ml index bff5562b85400aa0204490cd5b4d7717ddb4a6bd..8a353d3d5a9f2be02fd51a58304346eb284df7f6 100644 --- a/src/tableInterpreter.ml +++ b/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)