diff --git a/src/action.ml b/src/action.ml index 5641fe6004b4e52dc76ea2ec0c20fc177421527a..b2136137fb76cb0a35ef84b1e238a332a442251f 100644 --- a/src/action.ml +++ b/src/action.ml @@ -65,8 +65,9 @@ let apply (phi : subst) (s : string) : string = let apply_subject (phi : subst) (subject : subject) : subject = match subject with + | Before | Left -> - Left + subject | RightNamed s -> RightNamed (apply phi s) @@ -152,6 +153,14 @@ let print f action = let has_syntaxerror action = KeywordSet.mem SyntaxError (keywords action) +let has_left action = + KeywordSet.exists (function + | Position (Left, _, _) -> + true + | _ -> + false + ) (keywords action) + let has_leftstart action = KeywordSet.exists (function | Position (Left, WhereStart, _) -> @@ -168,3 +177,10 @@ let has_leftend action = false ) (keywords action) +let has_beforeend action = + KeywordSet.exists (function + | Position (Before, WhereEnd, _) -> + true + | _ -> + false + ) (keywords action) diff --git a/src/action.mli b/src/action.mli index 6dc6b7af71121bc054e35e143d020c54d05cd7e6..4106ac80c49f06e3274a6bbab03d4ed54b349f82 100644 --- a/src/action.mli +++ b/src/action.mli @@ -55,3 +55,8 @@ val has_leftstart: t -> bool (** Check whether the keyword $end is used in the action. *) val has_leftend: t -> bool +(** Check whether the keyword $start or $end is used in the action. *) +val has_left: t -> bool + +(** Check whether the keyword $beforeend is used in the action. *) +val has_beforeend: t -> bool diff --git a/src/codeBackend.ml b/src/codeBackend.ml index 51369e952431e2978e84b358bd1902944e26160a..b75dfc10197bdb9c132a3b8733d21cb82ace4432 100644 --- a/src/codeBackend.ml +++ b/src/codeBackend.ml @@ -1481,7 +1481,7 @@ let errorcasedef = 2015/11/04. If the state [s] can reduce an epsilon production, then the initial stack should contain a sentinel cell with a valid [endp] field at offset 1. Otherwise, the initial stack can be the unit value, as it - used to be. *) + used to be. (Note that it would be OK to always have a sentinel.) *) let entrydef s = let nt = Item.startnt (Lr1.start2item s) in @@ -1489,7 +1489,7 @@ let entrydef s = and lexbuf = "lexbuf" in let initial_stack = - if Lr1.has_epsilon_reduction s then + if Lr1.has_beforeend s then let initial_position = getendp in etuple [ EUnit; initial_position ] else diff --git a/src/invariant.ml b/src/invariant.ml index 977d30f261222e5c9c5a6b0b4e3373ae41140efd..84fd1eaf3ecd9bdee24a33956108770fb58be2c4 100644 --- a/src/invariant.ml +++ b/src/invariant.ml @@ -619,7 +619,9 @@ let rewind node : instruction = state whose incoming symbol is [sym] can reduce an epsilon production, then [sym] must keep track of its end position. (Furthermore, if some initial state can reduce an epsilon production, then the sentinel cell at the bottom - of the stack must contain a position. This does not concern us here.) *) + of the stack must contain a position. This does not concern us here.) + Similarly, if some state whose incoming symbol is [sym] uses [$beforeendpos], + then [sym] must keep track of its end position. *) open Keyword @@ -661,10 +663,15 @@ let () = let rhs = Production.rhs prod and ids = Production.identifiers prod and action = Production.action prod in - KeywordSet.iter (function | SyntaxError -> () + | Position (Before, _, _) -> + (* Doing nothing here is OK because the presence of [$beforepos] + in a semantic action is taken account below when we look at + every state and check whether it can reduce a production whose + semantic action contains [$beforepos]. *) + () | Position (Left, where, _) -> require_aux where prod | Position (RightNamed id, where, _) -> @@ -676,7 +683,7 @@ let () = ); Lr1.iterx (fun node -> (* 2015/11/04. See above. *) - if Lr1.has_epsilon_reduction node then + if Lr1.has_beforeend node then let sym = Misc.unSome (Lr1.incoming_symbol node) in require WhereEnd sym ) diff --git a/src/keyword.ml b/src/keyword.ml index cadebf17b22225c8b9a3e0d7bb3876b3c8fee498..d65da19691e5378d7dc11241937ccf33d357d966 100644 --- a/src/keyword.ml +++ b/src/keyword.ml @@ -29,6 +29,7 @@ type parsed_subject = | PRightNamed of string and subject = + | Before | Left | RightNamed of string @@ -55,6 +56,8 @@ let where = function "end" let subject = function + | Before -> + "before" | Left -> "" | RightNamed id -> diff --git a/src/keyword.mli b/src/keyword.mli index 5e3782406ce061e35bd2447448f097ee7f7ebfed..c83185527060f72190a5243ee544cc507ac7a8bf 100644 --- a/src/keyword.mli +++ b/src/keyword.mli @@ -23,13 +23,18 @@ type where = A positional reference of the form [$i] is a syntactic sugar for the name [_i]. This surface syntax is first parsed as a [parsed_subject] and desugared as a [subject] during keywords rewriting into actual - OCaml identifiers. (See {!Lexer.transform_keywords}) *) + OCaml identifiers. (See {!Lexer.transform_keywords}.) + + We add a new subject, [Before], which corresponds to [$beforeendpos] + in concrete syntax. We adopt the (slightly awkward) convention that + when the subject is [Before], the [where] component must be [WhereEnd]. *) type parsed_subject = | PLeft | PRightDollar of int | PRightNamed of string and subject = + | Before | Left | RightNamed of string diff --git a/src/lr1.ml b/src/lr1.ml index ae1228874bba40b70037a58b62ec3e2b6c0911ef..baaff6c3bd409258e2e23bc17e0924b1c4a6079d 100644 --- a/src/lr1.ml +++ b/src/lr1.ml @@ -837,13 +837,23 @@ let invert reductions : TerminalSet.t ProductionMap.t = ) reductions ProductionMap.empty (* ------------------------------------------------------------------------ *) -(* Testing whether a state can reduce some epsilon production. *) +(* [has_beforeend s] tests whether the state [s] can reduce a production + whose semantic action can peek at the before-endpos, that is, the end + position of the cell that is at the top of the stack after popping and + before pushing. *) -let has_epsilon_reduction node = +(* This is the case if [s] can reduce an epsilon production whose semantic + action uses [$startpos] or [$endpos]. This is also the case if [s] can + reduce a production whose semantic action uses [$beforeendpos]. *) + +let has_beforeend node = TerminalMap.fold (fun _ prods accu -> accu || let prod = Misc.single prods in - Production.length prod = 0 + not (Production.is_start prod) && + let action = Production.action prod in + Production.length prod = 0 && Action.has_left action + || Action.has_beforeend action ) (reductions node) false (* ------------------------------------------------------------------------ *) diff --git a/src/lr1.mli b/src/lr1.mli index 21a975ba6b1f2daaba201f65fcf47c1fff583b2e..32439b61f5b07189d3361a0a2dda6c56a845b254 100644 --- a/src/lr1.mli +++ b/src/lr1.mli @@ -83,9 +83,12 @@ val forbid_default_reduction: node -> bool val invert : ProductionMap.key list TerminalMap.t -> TerminalSet.t ProductionMap.t -(* Testing whether a state can reduce some epsilon production. *) +(* [has_beforeend s] tests whether the state [s] can reduce a production + whose semantic action can peek at the before-endpos, that is, the end + position of the cell that is at the top of the stack after popping and + before pushing. *) -val has_epsilon_reduction: node -> bool +val has_beforeend: node -> bool (* Computing which terminal symbols a state is willing to act upon. diff --git a/src/nonTerminalDefinitionInlining.ml b/src/nonTerminalDefinitionInlining.ml index 26028394679d3f6e93906c81b3a3982caadc2d1c..fc078c95c778f5dec59691941f98bdac7cd8c446 100644 --- a/src/nonTerminalDefinitionInlining.ml +++ b/src/nonTerminalDefinitionInlining.ml @@ -26,10 +26,11 @@ let index2id producers i = respectively. *) (* It does not modify [$startpos] or [$endpos], of course, nor [$startpos(y)] - and [$endpos(y)] for some other [y]. *) + and [$endpos(y)] for some other [y]. It does not modify [$beforeendpos]. *) let rename_sw_outer (x, startp, endp) (subject, where) : (subject * where) option = match subject with + | Before | Left -> None | RightNamed x' -> @@ -41,13 +42,16 @@ let rename_sw_outer (x, startp, endp) (subject, where) : (subject * where) optio None (* [rename_sw_inner] transforms the keywords in the inner production (the callee) - during inlining. It looks for [$startpos] and [$endpos] and replaces them with - [startp] and [endp], respectively. *) + during inlining. It looks for [$beforepos], [$startpos], and [$endpos,] and + replaces them with [beforep], [startp], and [endp], respectively. *) (* It does not modify any [$startpos(x)], of course. *) -let rename_sw_inner (startp, endp) (subject, where) : (subject * where) option = +let rename_sw_inner (beforep, startp, endp) (subject, where) : (subject * where) option = match subject, where with + | Before, _ -> + assert (where = WhereEnd); + Some beforep | Left, WhereStart -> Some startp | Left, WhereEnd -> @@ -186,10 +190,11 @@ let inline grammar = RightNamed (index2id (prefix - 1)), WhereEnd else (* If the inner production is epsilon and the prefix is empty, then - we need to look up the end position stored in the top stack cell - (for which we do not have a name). *) - (* TEMPORARY missing a new feature *) - Left, WhereStart (* TEMPORARY this is an approximation *) + we need to look up the end position stored in the top stack cell. + This is the reason why we need the keyword [$beforeendpos]. It is + required in this case to preserve the semantics of $startpos and + $endpos. *) + Before, WhereEnd (* Note that, to contrary to intuition perhaps, we do NOT have that if the prefix is empty, then the start position of the inner @@ -210,11 +215,24 @@ let inline grammar = in + (* We must also transform [$beforeendpos] if it used by the inner + production. It refers to the end position of the stack cell + that comes before the inner production. So, if the prefix is + non-empty, then it translates to the end position of the last + element of the prefix. Otherwise, it translates to [$beforeendpos]. *) + + let beforep = + if prefix > 0 then + RightNamed (index2id (prefix - 1)), WhereEnd + else + Before, WhereEnd + in + (* Rename the outer and inner semantic action. *) let outer_action = Action.rename (rename_sw_outer (c, startp, endp)) [] b.action and action' = - Action.rename (rename_sw_inner (startp, endp)) phi pb.action + Action.rename (rename_sw_inner (beforep, startp, endp)) phi pb.action in { b with diff --git a/src/partialGrammar.ml b/src/partialGrammar.ml index ae65b0cd83c1aea16aa8b8f5b88e9717924bd169..31e873e753ff4ffd2fd733b38553e7e8c513c519 100644 --- a/src/partialGrammar.ml +++ b/src/partialGrammar.ml @@ -595,7 +595,7 @@ let check_keywords producers action = if not !found then Error.errorp keyword "%s refers to a nonexistent symbol." id - | Position (Left, _, _) + | Position ((Before | Left), _, _) | SyntaxError -> () ) (Action.pkeywords action)