Commit dfd5bffc authored by Nicolás Ojeda Bär's avatar Nicolás Ojeda Bär

Add support for $loc, $sloc keywords

parent 7032e45c
......@@ -76,6 +76,11 @@ let tlexbuf =
let tobj =
TypApp ("Obj.t", [])
(* The type of pairs. *)
let tpair typ1 typ2 =
TypTuple [typ1; typ2]
(* Building a type variable. *)
let tvar x : typ =
......
......@@ -37,6 +37,7 @@ val texn: typ
val tposition: typ
val tlexbuf: typ
val tobj : typ
val tpair: typ -> typ -> typ
(* Building a type variable. *)
......
......@@ -88,6 +88,7 @@ let actiondef grammar symbol branch =
Printf.sprintf "_startofs_%s_" id,
Printf.sprintf "_endofs_%s_" id
in
let loc = Printf.sprintf "_loc_%s_" id in
let t =
try
let props = StringMap.find symbol grammar.tokens in
......@@ -106,6 +107,7 @@ let actiondef grammar symbol branch =
PAnnot (PVar endp, tposition) ::
PAnnot (PVar starto, tint) ::
PAnnot (PVar endo, tint) ::
PAnnot (PVar loc, tpair tposition tposition) ::
formals
) [] branch.producers
in
......@@ -123,6 +125,8 @@ let actiondef grammar symbol branch =
PAnnot (PVar "_endofs", tint) ::
PAnnot (PVar "_endofs__0_", tint) ::
PAnnot (PVar "_symbolstartofs", tint) ::
PAnnot (PVar "_sloc", tpair tposition tposition) ::
PAnnot (PVar "_loc", tpair tposition tposition) ::
formals
in
......
......@@ -674,6 +674,9 @@ let () =
| Position (Left, _, _) ->
(* [$startpos] and [$endpos] have been expanded away. *)
assert false
| Position (_, _, FlavorLocation) ->
(* [$loc] and [$sloc] have been expanded away. *)
assert false
| Position (RightNamed _, WhereSymbolStart, _) ->
(* [$symbolstartpos(x)] does not exist. *)
assert false
......
......@@ -24,6 +24,7 @@
type flavor =
| FlavorOffset
| FlavorPosition
| FlavorLocation
(* The user can request position information about the $start or $end
of a symbol. Also, $symbolstart requests the computation of the
......@@ -75,9 +76,19 @@ let flavor = function
"pos"
| FlavorOffset ->
"ofs"
| FlavorLocation ->
"loc"
let posvar s w f =
Printf.sprintf "_%s%s%s" (where w) (flavor f) (subject s)
match w, f with
| _, (FlavorOffset | FlavorPosition) ->
Printf.sprintf "_%s%s%s" (where w) (flavor f) (subject s)
| WhereSymbolStart, FlavorLocation ->
"_sloc"
| WhereStart, FlavorLocation ->
Printf.sprintf "_loc%s" (subject s)
| _ ->
assert false
(* ------------------------------------------------------------------------- *)
(* Sets of keywords. *)
......
......@@ -21,6 +21,7 @@
type flavor =
| FlavorOffset
| FlavorPosition
| FlavorLocation
(* The user can request position information about the $start or $end
of a symbol. Also, $symbolstart requests the computation of the
......@@ -39,7 +40,11 @@ type where =
We add a new subject, [Before], which corresponds to [$endpos($0)]
in concrete syntax. We adopt the (slightly awkward) convention that
when the subject is [Before], the [where] component must be [WhereEnd]. *)
when the subject is [Before], the [where] component must be [WhereEnd].
If [flavor] is [FlavorLocation], then [where] must be [WhereSymbolStart]
or [WhereStart]. In the former case, [subject] must be [Left]. In the
latter case, [subject] must be [Left] or [RightNamed _]. *)
type subject =
| Before
......
......@@ -102,6 +102,31 @@ let define keyword1 f keyword2 =
[ PVar (posvar_ keyword1) ]
[ f (EVar (posvar_ keyword2)) ])
(* A [loc] keyword is expanded away. *)
let define_tuple keyword keywords =
Action.define
keyword
(List.fold_right KeywordSet.add keywords KeywordSet.empty)
(mlet
[ PVar (posvar_ keyword) ]
[ ETuple (List.map (fun keyword -> EVar (posvar_ keyword)) keywords) ])
let expand_loc keyword action =
match keyword with
| Position (Left, WhereSymbolStart, FlavorLocation) -> (* $sloc *)
define_tuple keyword
[ Position (Left, WhereSymbolStart, FlavorPosition);
Position (Left, WhereEnd, FlavorPosition) ]
action
| Position (subject, WhereStart, FlavorLocation) -> (* $loc, $loc(x) *)
define_tuple keyword
[ Position (subject, WhereStart, FlavorPosition);
Position (subject, WhereEnd, FlavorPosition) ]
action
| _ ->
action
(* An [ofs] keyword is expanded away. It is defined in terms of the
corresponding [pos] keyword. *)
......@@ -169,14 +194,18 @@ 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. *)
rounds: first, expand the [loc] keywords away, then 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 analysis producers action =
let n = List.length producers in
(* Expand [loc] keywords away first. *)
let action = expand_round expand_loc action in
(* The [ofs] keyword family is defined in terms of the [pos] family by
accessing the [pos_cnum] field. Expand these keywords away first. *)
......
......@@ -146,20 +146,22 @@ let position pos
let ofslpar = (* offset of the opening parenthesis, if there is one *)
1 + (* for the initial "$" *)
String.length where +
3 (* for "pos" or "ofs" *)
3 (* for "pos" or "ofs" or "loc" *)
in
let where =
let where' =
match where with
| "symbolstart" -> WhereSymbolStart
| "start" -> WhereStart
| "end" -> WhereEnd
| "s" -> WhereSymbolStart
| "" -> WhereStart
| _ -> assert false
in
let () =
match where, i, x with
match where', i, x with
| WhereSymbolStart, Some _, _
| WhereSymbolStart, _, Some _ ->
Error.error [pos] "$symbolstart%s does not take a parameter." flavor
Error.error [pos] "$%s%s does not take a parameter." where flavor
| _, _, _ ->
()
in
......@@ -167,13 +169,14 @@ let position pos
match flavor with
| "pos" -> FlavorPosition
| "ofs" -> FlavorOffset
| "loc" -> FlavorLocation
| _ -> assert false
in
let subject, check =
match i, x with
| Some i, None ->
let ii = int_of_string i in (* cannot fail *)
if ii = 0 && where = WhereEnd then
if ii = 0 && where' = WhereEnd then
(* [$endpos($0)] *)
Before, none
else
......@@ -205,7 +208,7 @@ let position pos
()
in
let keyword =
Some (Position (subject, where, flavor))
Some (Position (subject, where', flavor))
in
{ pos; check; transform; keyword }
......@@ -344,8 +347,8 @@ let attributechar = identchar | '.'
let poskeyword =
'$'
(("symbolstart" | "start" | "end") as where)
(("pos" | "ofs") as flavor)
(((("symbolstart" | "start" | "end") as where) (("pos" | "ofs") as flavor)) |
((("s" | "") as where) ("loc" as flavor)))
( '(' ( '$' (['0'-'9']+ as i) | ((lowercase identchar*) as x)) ')')?
let previouserror =
......
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