Added [$symbolstartpos].

src/infer.ml

@@ -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
 

src/invariant.ml

@@ -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 ->

src/keyword.ml

@@ -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 ->

src/keyword.mli

@@ -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

src/keywordExpansion.ml

@@ -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 }

src/lexer.mll

@@ -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)) ')')?
 

src/nonTerminalDefinitionInlining.ml

@@ -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)