Commit 2e8ede8b authored by POTTIER Francois's avatar POTTIER Francois

Added the keyword [$beforeendpos].

Only in internal form, for now -- does not exist in concrete syntax.
Not yet supported by the back-ends.
parent 97964f71
...@@ -65,8 +65,9 @@ let apply (phi : subst) (s : string) : string = ...@@ -65,8 +65,9 @@ let apply (phi : subst) (s : string) : string =
let apply_subject (phi : subst) (subject : subject) : subject = let apply_subject (phi : subst) (subject : subject) : subject =
match subject with match subject with
| Before
| Left -> | Left ->
Left subject
| RightNamed s -> | RightNamed s ->
RightNamed (apply phi s) RightNamed (apply phi s)
...@@ -152,6 +153,14 @@ let print f action = ...@@ -152,6 +153,14 @@ let print f action =
let has_syntaxerror action = let has_syntaxerror action =
KeywordSet.mem SyntaxError (keywords action) KeywordSet.mem SyntaxError (keywords action)
let has_left action =
KeywordSet.exists (function
| Position (Left, _, _) ->
true
| _ ->
false
) (keywords action)
let has_leftstart action = let has_leftstart action =
KeywordSet.exists (function KeywordSet.exists (function
| Position (Left, WhereStart, _) -> | Position (Left, WhereStart, _) ->
...@@ -168,3 +177,10 @@ let has_leftend action = ...@@ -168,3 +177,10 @@ let has_leftend action =
false false
) (keywords action) ) (keywords action)
let has_beforeend action =
KeywordSet.exists (function
| Position (Before, WhereEnd, _) ->
true
| _ ->
false
) (keywords action)
...@@ -55,3 +55,8 @@ val has_leftstart: t -> bool ...@@ -55,3 +55,8 @@ val has_leftstart: t -> bool
(** Check whether the keyword $end is used in the action. *) (** Check whether the keyword $end is used in the action. *)
val has_leftend: t -> bool 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
...@@ -1481,7 +1481,7 @@ let errorcasedef = ...@@ -1481,7 +1481,7 @@ let errorcasedef =
2015/11/04. If the state [s] can reduce an epsilon production, then the 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 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 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 entrydef s =
let nt = Item.startnt (Lr1.start2item s) in let nt = Item.startnt (Lr1.start2item s) in
...@@ -1489,7 +1489,7 @@ let entrydef s = ...@@ -1489,7 +1489,7 @@ let entrydef s =
and lexbuf = "lexbuf" in and lexbuf = "lexbuf" in
let initial_stack = let initial_stack =
if Lr1.has_epsilon_reduction s then if Lr1.has_beforeend s then
let initial_position = getendp in let initial_position = getendp in
etuple [ EUnit; initial_position ] etuple [ EUnit; initial_position ]
else else
......
...@@ -619,7 +619,9 @@ let rewind node : instruction = ...@@ -619,7 +619,9 @@ let rewind node : instruction =
state whose incoming symbol is [sym] can reduce an epsilon production, then state whose incoming symbol is [sym] can reduce an epsilon production, then
[sym] must keep track of its end position. (Furthermore, if some initial [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 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 open Keyword
...@@ -661,10 +663,15 @@ let () = ...@@ -661,10 +663,15 @@ let () =
let rhs = Production.rhs prod let rhs = Production.rhs prod
and ids = Production.identifiers prod and ids = Production.identifiers prod
and action = Production.action prod in and action = Production.action prod in
KeywordSet.iter (function KeywordSet.iter (function
| SyntaxError -> | 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, _) -> | Position (Left, where, _) ->
require_aux where prod require_aux where prod
| Position (RightNamed id, where, _) -> | Position (RightNamed id, where, _) ->
...@@ -676,7 +683,7 @@ let () = ...@@ -676,7 +683,7 @@ let () =
); );
Lr1.iterx (fun node -> Lr1.iterx (fun node ->
(* 2015/11/04. See above. *) (* 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 let sym = Misc.unSome (Lr1.incoming_symbol node) in
require WhereEnd sym require WhereEnd sym
) )
......
...@@ -29,6 +29,7 @@ type parsed_subject = ...@@ -29,6 +29,7 @@ type parsed_subject =
| PRightNamed of string | PRightNamed of string
and subject = and subject =
| Before
| Left | Left
| RightNamed of string | RightNamed of string
...@@ -55,6 +56,8 @@ let where = function ...@@ -55,6 +56,8 @@ let where = function
"end" "end"
let subject = function let subject = function
| Before ->
"before"
| Left -> | Left ->
"" ""
| RightNamed id -> | RightNamed id ->
......
...@@ -23,13 +23,18 @@ type where = ...@@ -23,13 +23,18 @@ type where =
A positional reference of the form [$i] is a syntactic sugar for the 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] name [_i]. This surface syntax is first parsed as a [parsed_subject]
and desugared as a [subject] during keywords rewriting into actual 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 = type parsed_subject =
| PLeft | PLeft
| PRightDollar of int | PRightDollar of int
| PRightNamed of string | PRightNamed of string
and subject = and subject =
| Before
| Left | Left
| RightNamed of string | RightNamed of string
......
...@@ -837,13 +837,23 @@ let invert reductions : TerminalSet.t ProductionMap.t = ...@@ -837,13 +837,23 @@ let invert reductions : TerminalSet.t ProductionMap.t =
) reductions ProductionMap.empty ) 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 -> TerminalMap.fold (fun _ prods accu ->
accu || accu ||
let prod = Misc.single prods in 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 ) (reductions node) false
(* ------------------------------------------------------------------------ *) (* ------------------------------------------------------------------------ *)
......
...@@ -83,9 +83,12 @@ val forbid_default_reduction: node -> bool ...@@ -83,9 +83,12 @@ val forbid_default_reduction: node -> bool
val invert : ProductionMap.key list TerminalMap.t -> TerminalSet.t ProductionMap.t 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. (* Computing which terminal symbols a state is willing to act upon.
......
...@@ -26,10 +26,11 @@ let index2id producers i = ...@@ -26,10 +26,11 @@ let index2id producers i =
respectively. *) respectively. *)
(* It does not modify [$startpos] or [$endpos], of course, nor [$startpos(y)] (* 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 = let rename_sw_outer (x, startp, endp) (subject, where) : (subject * where) option =
match subject with match subject with
| Before
| Left -> | Left ->
None None
| RightNamed x' -> | RightNamed x' ->
...@@ -41,13 +42,16 @@ let rename_sw_outer (x, startp, endp) (subject, where) : (subject * where) optio ...@@ -41,13 +42,16 @@ let rename_sw_outer (x, startp, endp) (subject, where) : (subject * where) optio
None None
(* [rename_sw_inner] transforms the keywords in the inner production (the callee) (* [rename_sw_inner] transforms the keywords in the inner production (the callee)
during inlining. It looks for [$startpos] and [$endpos] and replaces them with during inlining. It looks for [$beforepos], [$startpos], and [$endpos,] and
[startp] and [endp], respectively. *) replaces them with [beforep], [startp], and [endp], respectively. *)
(* It does not modify any [$startpos(x)], of course. *) (* 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 match subject, where with
| Before, _ ->
assert (where = WhereEnd);
Some beforep
| Left, WhereStart -> | Left, WhereStart ->
Some startp Some startp
| Left, WhereEnd -> | Left, WhereEnd ->
...@@ -186,10 +190,11 @@ let inline grammar = ...@@ -186,10 +190,11 @@ let inline grammar =
RightNamed (index2id (prefix - 1)), WhereEnd RightNamed (index2id (prefix - 1)), WhereEnd
else else
(* If the inner production is epsilon and the prefix is empty, then (* 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 we need to look up the end position stored in the top stack cell.
(for which we do not have a name). *) This is the reason why we need the keyword [$beforeendpos]. It is
(* TEMPORARY missing a new feature *) required in this case to preserve the semantics of $startpos and
Left, WhereStart (* TEMPORARY this is an approximation *) $endpos. *)
Before, WhereEnd
(* Note that, to contrary to intuition perhaps, we do NOT have that (* Note that, to contrary to intuition perhaps, we do NOT have that
if the prefix is empty, then the start position of the inner if the prefix is empty, then the start position of the inner
...@@ -210,11 +215,24 @@ let inline grammar = ...@@ -210,11 +215,24 @@ let inline grammar =
in 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. *) (* Rename the outer and inner semantic action. *)
let outer_action = let outer_action =
Action.rename (rename_sw_outer (c, startp, endp)) [] b.action Action.rename (rename_sw_outer (c, startp, endp)) [] b.action
and 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 in
{ b with { b with
......
...@@ -595,7 +595,7 @@ let check_keywords producers action = ...@@ -595,7 +595,7 @@ let check_keywords producers action =
if not !found then if not !found then
Error.errorp keyword Error.errorp keyword
"%s refers to a nonexistent symbol." id "%s refers to a nonexistent symbol." id
| Position (Left, _, _) | Position ((Before | Left), _, _)
| SyntaxError -> | SyntaxError ->
() ()
) (Action.pkeywords action) ) (Action.pkeywords action)
......
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