Commit ace1333b authored by POTTIER Francois's avatar POTTIER Francois

Added [$symbolstartpos].

parent 85f142da
......@@ -103,9 +103,11 @@ let actiondef grammar symbol branch =
PAnnot (PVar "_startpos", tposition) ::
PAnnot (PVar "_endpos", tposition) ::
PAnnot (PVar "_endpos__0_", tposition) ::
PAnnot (PVar "_symbolstartpos", tposition) ::
PAnnot (PVar "_startofs", tint) ::
PAnnot (PVar "_endofs", tint) ::
PAnnot (PVar "_endofs__0_", tint) ::
PAnnot (PVar "_symbolstartofs", tint) ::
formals
in
......
......@@ -638,6 +638,8 @@ let rec require where symbol =
startp
| WhereEnd ->
endp
| WhereSymbolStart ->
assert false (* has been expanded away *)
in
if not (SymbolSet.mem symbol !wherep) then begin
wherep := SymbolSet.add symbol !wherep;
......@@ -657,6 +659,8 @@ and require_aux where prod =
require where rhs.(0)
| WhereEnd ->
require where rhs.(length - 1)
| WhereSymbolStart ->
assert false (* has been expanded away *)
let () =
Production.iterx (fun prod ->
......
......@@ -12,12 +12,14 @@ type flavor =
| FlavorOffset
| FlavorPosition
(* The user can request position information about the
start or end of a symbol. *)
(* The user can request position information about the $start or $end
of a symbol. Also, $symbolstart requests the computation of the
start position of the first nonempty element in a production. *)
type where =
| WhereStart
| WhereEnd
| WhereSymbolStart
| WhereStart
| WhereEnd
(* The user can request position information about a production's
left-hand side or about one of the symbols in its right-hand
......@@ -40,6 +42,8 @@ type keyword =
name of the variable that the keyword is replaced with. *)
let where = function
| WhereSymbolStart ->
"symbolstart"
| WhereStart ->
"start"
| WhereEnd ->
......
......@@ -9,12 +9,14 @@ type flavor =
| FlavorOffset
| FlavorPosition
(* The user can request position information about the
start or end of a symbol. *)
(* The user can request position information about the $start or $end
of a symbol. Also, $symbolstart requests the computation of the
start position of the first nonempty element in a production. *)
type where =
| WhereStart
| WhereEnd
| WhereSymbolStart
| WhereStart
| WhereEnd
(* The user can request position information about a production's
left-hand side or about one of the symbols in its right-hand
......
......@@ -12,6 +12,54 @@ let posvar_ = function
| _ ->
assert false (* [posvar_] should be applied to a position keyword *)
(* [symbolstartpos producers i n] constructs an expression which, beginning at
index [i], looks for the first non-empty producer and returns its start
position. If none is found, this expression returns the end position of the
right-hand side. This computation is modeled after the function
[Parsing.symbol_start_pos] in OCaml's standard library. *)
(* This cascade of [if] constructs may be quite big, so in terms of code size,
it is not great. If we knew, at this point, which symbols are nullable and
which symbols generate the singleton language {epsilon}, then we could
optimize this code by computing, ahead of time, the outcome of certain
comparisons. (That is, assuming a token cannot have the same start and end
positions.) Unfortunately, at this point, (before inlining,) we do not have
this information yet. *)
(* Although this code is modeled after [Parsing.symbol_start_pos], we compare
positions using physical equality, whereas they use structural equality. If
for some reason a symbol has start and end positions that are structurally
equal but physically different, then a difference will be observable.
However, this is very unlikely. It would mean that a token has the same start
and end positions (and furthermore, this position has been re-allocated). *)
(* The reason why we expand [$symbolstartpos] away prior to inlining is that we
want its meaning to be preserved by inlining. If we tried to preserve this
keyword through the inlining phase, then (I suppose) we would have to introduce
a family of keywords [$symbolstartpos(i, j)], computing over the interval from
[i] to [j], and the preservation would not be exact -- because a nonempty
symbol, once inlined, can be seen to be a sequence of empty and nonempty
symbols. *)
let rec symbolstartpos producers i n : IL.expr * KeywordSet.t =
if i = n then
(* Return [$endpos]. *)
let keyword = Position (Left, WhereEnd, FlavorPosition) in
EVar (posvar_ keyword), KeywordSet.singleton keyword
else
(* Compare [$startpos($i)] and [$endpos($i)]. If they differ, return
[$startpos($i)]. Otherwise, continue. *)
let _, x = List.nth producers i in
let startp = Position (RightNamed x, WhereStart, FlavorPosition)
and endp = Position (RightNamed x, WhereEnd, FlavorPosition) in
let continue, keywords = symbolstartpos producers (i + 1) n in
EIfThenElse (
EApp (EVar "Pervasives.(!=)", [ EVar (posvar_ startp); EVar (posvar_ endp) ]),
EVar (posvar_ startp),
continue
),
KeywordSet.add startp (KeywordSet.add endp keywords)
(* [define keyword1 f keyword2] macro-expands [keyword1] as [f(keyword2)],
where [f] is a function of expressions to expressions. *)
......@@ -23,52 +71,95 @@ let define keyword1 f keyword2 =
[ PVar (posvar_ keyword1) ]
[ f (EVar (posvar_ keyword2)) ])
(* [expand_action producers action] macro-expands certain keywords away
in the semantic action [action]. The list [producers] tells us how
many elements appear in this production. *)
(* An [ofs] keyword is expanded away. It is defined in terms of the
corresponding [pos] keyword. *)
let expand_ofs keyword action =
match keyword with
| Position (subject, where, FlavorOffset) ->
define keyword
(fun e -> ERecordAccess (e, "Lexing.pos_cnum"))
(Position (subject, where, FlavorPosition))
action
| _ ->
action
(* [$symbolstartpos] is expanded into a cascade of [if] constructs, modeled
after [Parsing.symbol_start_pos]. *)
let expand_symbolstartpos producers n keyword action =
match keyword with
| Position (Left, WhereSymbolStart, FlavorPosition) ->
let expansion, keywords = symbolstartpos producers 0 n in
Action.define keyword keywords
(mlet [ PVar (posvar_ keyword) ] [ expansion ])
action
| Position (RightNamed _, WhereSymbolStart, FlavorPosition) ->
(* [$symbolstartpos(x)] does not exist. *)
assert false
| _ ->
action
(* [$startpos] and [$endpos] are expanded away. *)
let expand_startend producers n keyword action =
match keyword with
| Position (Left, WhereStart, flavor) ->
(* [$startpos] is defined as [$startpos($1)] if this production has
nonzero length and [$endpos($0)] otherwise. *)
define keyword (fun e -> e) (
if n > 0 then
let _, x = List.hd producers in
Position (RightNamed x, WhereStart, flavor)
else
Position (Before, WhereEnd, flavor)
) action
| Position (Left, WhereEnd, flavor) ->
(* [$endpos] is defined as [$endpos($n)] if this production has
nonzero length and [$endpos($0)] otherwise. *)
define keyword (fun e -> e) (
if n > 0 then
let _, x = List.hd (List.rev producers) in
Position (RightNamed x, WhereEnd, flavor)
else
Position (Before, WhereEnd, flavor)
) action
| _ ->
action
(* [expand_round] performs one round of expansion on [action], using [f] as a
rewriting rule. *)
let expand_round f action =
KeywordSet.fold f (Action.keywords action) action
(* [expand_action] performs macro-expansion in [action]. We do this in several
rounds: first, expand the [ofs] keywords away; then, expand [symbolstart]
away; then, expand the rest. We do this in this order because each round
can cause new keywords to appear, which must eliminated by the following
rounds. *)
let expand_action producers action =
let n = List.length producers in
KeywordSet.fold (fun keyword action ->
match keyword with
| Position (subject, where, FlavorOffset) ->
(* The [ofs] keyword family is defined in terms of the [pos] family by
accessing the [pos_cnum] field. *)
define keyword
(fun e -> ERecordAccess (e, "Lexing.pos_cnum"))
(Position (subject, where, FlavorPosition))
action
| Position (Left, WhereStart, flavor) ->
(* [$startpos] is defined as [$startpos($1)] if this production has
nonzero length and [$endpos($0)] otherwise. *)
define keyword (fun e -> e) (
if n > 0 then
let _, x = List.hd producers in
Position (RightNamed x, WhereStart, flavor)
else
Position (Before, WhereEnd, flavor)
) action
| Position (Left, WhereEnd, flavor) ->
(* [$endpos] is defined as [$endpos($n)] if this production has
nonzero length and [$endpos($0)] otherwise. *)
define keyword (fun e -> e) (
if n > 0 then
let _, x = List.hd (List.rev producers) in
Position (RightNamed x, WhereEnd, flavor)
else
Position (Before, WhereEnd, flavor)
) action
| Position (Before, _, _)
| Position (RightNamed _, _, _)
| SyntaxError ->
action
) (Action.keywords action) action
(* The [ofs] keyword family is defined in terms of the [pos] family by
accessing the [pos_cnum] field. Expand these keywords away first. *)
let action = expand_round expand_ofs action in
(* Expand [$symbolstartpos] away. *)
let action = expand_round (expand_symbolstartpos producers n) action in
(* Then, expand away the non-[ofs] keywords. *)
let action = expand_round (expand_startend producers n) action in
action
let expand_branch branch =
{ branch with action = expand_action branch.producers branch.action }
......
......@@ -141,10 +141,20 @@ let position pos
let none _ = () in
let where, ofslpar (* offset of the opening parenthesis, if there is one *) =
match where with
| "start" -> WhereStart, 9
| "end" -> WhereEnd, 7
| "symbolstart" -> WhereSymbolStart, 15
| "start" -> WhereStart, 9
| "end" -> WhereEnd, 7
| _ -> assert false
and flavor =
in
let () =
match where, i, x with
| WhereSymbolStart, Some _, _
| WhereSymbolStart, _, Some _ ->
Error.error [pos] "$symbolstart%s does not take a parameter." flavor
| _, _, _ ->
()
in
let flavor =
match flavor with
| "pos" -> FlavorPosition
| "ofs" -> FlavorOffset
......@@ -325,7 +335,7 @@ let identchar = ['A'-'Z' 'a'-'z' '_' '\192'-'\214' '\216'-'\246' '\248'-'\255' '
let poskeyword =
'$'
(("start" | "end") as where)
(("symbolstart" | "start" | "end") as where)
(("pos" | "ofs") as flavor)
( '(' ( '$' (['0'-'9']+ as i) | ((lowercase identchar*) as x)) ')')?
......
......@@ -33,11 +33,12 @@ let rename_sw_outer (x, startpx, endpx) (subject, where) : (subject * where) opt
match where with
| WhereStart -> Some startpx
| WhereEnd -> Some endpx
| WhereSymbolStart -> assert false (* has been expanded away *)
else
None
| Left, _ ->
(* [$startpos] and [$endpos] have been expanded away earlier; see
[KeywordExpansion]. *)
(* [$startpos], [$endpos], and [$symbolstartpos] have been expanded away
earlier; see [KeywordExpansion]. *)
assert false
(* [rename_sw_inner] transforms the keywords in the inner production (the callee)
......
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