Skip to content
GitLab
Menu
Projects
Groups
Snippets
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Menu
Open sidebar
POTTIER Francois
menhir
Commits
ace1333b
Commit
ace1333b
authored
Nov 06, 2015
by
POTTIER Francois
Browse files
Added [$symbolstartpos].
parent
85f142da
Changes
7
Hide whitespace changes
Inline
Side-by-side
src/infer.ml
View file @
ace1333b
...
...
@@ -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
View file @
ace1333b
...
...
@@ -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
View file @
ace1333b
...
...
@@ -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
View file @
ace1333b
...
...
@@ -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
View file @
ace1333b
...
...
@@ -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
View file @
ace1333b
...
...
@@ -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
View file @
ace1333b
...
...
@@ -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 [$end
pos] have been expanded away
earlier; see
[KeywordExpansion]. *)
(* [$startpos]
, [$endpos], and [$symbolstart
pos] have been expanded away
earlier; see
[KeywordExpansion]. *)
assert
false
(* [rename_sw_inner] transforms the keywords in the inner production (the callee)
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment