Commit 0ff9cc7f authored by POTTIER Francois's avatar POTTIER Francois
parents 7b2e1b46 00d0d865
......@@ -11,7 +11,7 @@ MENHIR=$(SRC)/_stage2/menhir.native --stdlib $(SRC)
# La convention de nommage des tests multi-grammaires
# est : /nom/-[1-9].mly
TESTS=$(shell ls *.mly | egrep '*([1]|[^2-9]).mly')
TESTS=$(shell ls *.mly | egrep '.*([1]|[^2-9]).mly')
RESULTS=$(TESTS:.mly=.result)
test: clean $(RESULTS)
......
File "positional-identifier-clash.mly", line 4, characters 6-8:
Error: there are multiple producers named _1 in this sequence.
%start<unit> s
%token<unit> A
%%
s : A _1=A {}
......@@ -531,12 +531,13 @@ A semantic action is a piece of \ocaml code that is executed in order to
assign a semantic value to the nonterminal symbol with which this production
group is associated. A semantic action can refer to the (already computed)
semantic values of the terminal or nonterminal symbols that appear in the
production via the semantic value identifiers bound by the production. For
compatibility with \ocamlyacc, semantic actions can also refer to these
semantic values via positional keywords of the form
production via the semantic value identifiers bound by the production.
For compatibility with \ocamlyacc, semantic actions can also refer to
unnamed semantic values via positional keywords of the form
\kw{\$1}, \kw{\$2}, etc.\ This style is discouraged. Furthermore, as
a positional keyword of the form \kw{\$i} is internally rewritten as
\nt{\_i}, such identifiers are forbidden.
\nt{\_i}, the user should not use identifiers of the form \nt{\_i}.
\paragraph{\dprec annotations}
\label{sec:prec}
......
......@@ -25,7 +25,7 @@ open Positions
%token <Stretch.t> HEADER
%token <Stretch.ocamltype> OCAMLTYPE
%token <Stretch.t Lazy.t> PERCENTPERCENT
%token <Action.t> ACTION
%token <Syntax.identifier option array -> Action.t> ACTION
/* ------------------------------------------------------------------------- */
/* Start symbol. */
......@@ -268,15 +268,25 @@ production_group:
productions = separated_nonempty_list(BAR, production)
action = ACTION
oprec2 = precedence?
{
ParserAux.normalize_production_group productions
|> List.map (fun (producers, oprec1, rprec, pos) -> {
pr_producers = producers;
pr_action = action;
pr_branch_shift_precedence = ParserAux.override pos oprec1 oprec2;
pr_branch_reduce_precedence = rprec;
pr_branch_position = pos
})
{
(* If multiple productions share a single semantic action, check
that all of them bind the same names. *)
ParserAux.check_production_group productions;
(* Then, *)
List.map (fun (producers, oprec1, rprec, pos) ->
(* Replace [$i] with [_i]. *)
let pr_producers = ParserAux.normalize_producers producers in
(* Distribute the semantic action. Also, check that every [$i]
is within bounds. *)
let pr_action = action (ParserAux.producer_names producers) in
{
pr_producers;
pr_action;
pr_branch_shift_precedence = ParserAux.override pos oprec1 oprec2;
pr_branch_reduce_precedence = rprec;
pr_branch_position = pos
})
productions
}
| error ACTION precedence?
| error EOF
......
......@@ -13,7 +13,7 @@
let token = f lexbuf in
lexbuf.lex_start_p <- startp;
token
(* Updates the line counter, which is used in some error messages. *)
let update_loc lexbuf =
......@@ -37,6 +37,26 @@
assert (Bytes.get content offset = c1);
Bytes.set content offset c2
(* Check that only allowed indices are used in semantic actions. *)
let check_producers_indices allowed_producers pkeywords =
List.iter (function
| { value = Keyword.PDollar idx; position } ->
if idx - 1 >= Array.length allowed_producers then
Error.error [position] begin
Printf.sprintf "$%d refers to a nonexistent symbol." idx
end
else begin match allowed_producers.(idx - 1) with
| None ->
()
| Some x ->
Error.error [position] begin
Printf.sprintf "please do not say: $%d. Instead, say: %s." idx x
end
end
| _ ->
()
) pkeywords
(* In-place transformation of keywords. We turn our keywords into
valid OCaml identifiers by replacing '$', '(', and ')' with '_'.
Bloody. *)
......@@ -344,8 +364,12 @@ rule main = parse
{ savestart lexbuf (fun lexbuf ->
let openingpos = lexeme_end_p lexbuf in
let closingpos, pkeywords = action false openingpos [] lexbuf in
let stretch = mk_stretch openingpos closingpos true pkeywords in
ACTION (Action.from_stretch stretch)
ACTION (
fun allowed_producers_indices ->
let stretch = mk_stretch openingpos closingpos true pkeywords in
check_producers_indices allowed_producers_indices pkeywords;
Action.from_stretch stretch
)
) }
| eof
{ EOF }
......
......@@ -6,7 +6,7 @@ let current_token_precedence =
fun pos1 pos2 ->
incr c;
PrecedenceLevel (Error.get_filemark (), !c, pos1, pos2)
let current_reduce_precedence =
let c = ref 0 in
fun () ->
......@@ -46,8 +46,7 @@ let check_production_group right_hand_sides =
with Not_found ->
()
) right_hand_sides
end;
right_hand_sides
end
(* [normalize_producer i p] assigns a name of the form [_i]
to the unnamed producer [p]. *)
......@@ -59,13 +58,8 @@ let normalize_producer i (pos, opt_identifier, parameter) =
in
(id, parameter)
let normalize_right_hand_side (producers, a, b, c) =
(List.mapi normalize_producer producers, a, b, c)
let normalize_production_group right_hand_sides =
right_hand_sides
|> check_production_group
|> List.map normalize_right_hand_side
let normalize_producers producers =
List.mapi normalize_producer producers
let override pos o1 o2 =
match o1, o2 with
......@@ -113,3 +107,13 @@ let rules () =
rules := [];
result
(* Only unnamed producers can be referred to using positional identifiers.
Besides, such positions must be taken in the interval [1
.. List.length producers]. The output array [p] is such that
[p.(idx) = Some x] if [idx] must be referred to using [x], not
[$(idx + 1)]. *)
let producer_names producers =
producers
|> List.map (fun (_, oid, _) -> Option.map Positions.value oid)
|> Array.of_list
......@@ -8,12 +8,21 @@ open Syntax
val current_token_precedence: Lexing.position -> Lexing.position -> precedence_level
val current_reduce_precedence: unit -> precedence_level
(* [check_disjunctive_production] accepts production group and checks
that they all productions in the group define the same set of
identifiers. *)
(* [check_production_group] accepts a production group and checks that all
productions in the group define the same set of identifiers. *)
val normalize_production_group:
((Positions.t * identifier Positions.located option * parameter) list * 'a * 'b * 'c) list -> (producer list * 'a * 'b * 'c) list
val check_production_group:
((Positions.t * identifier Positions.located option * parameter) list * 'a * 'b * 'c) list ->
unit
(* [normalize_producers] accepts a list of producers where identifiers are
optional and returns a list of producers where identifiers are mandatory.
A missing identifier in the [i]-th position receives the conventional
name [_i]. *)
val normalize_producers:
(Positions.t * identifier Positions.located option * parameter) list ->
producer list
(* [override pos oprec1 oprec2] decides which of the two optional
%prec declarations [oprec1] and [oprec2] applies to a
......@@ -29,3 +38,10 @@ val override: Positions.t -> 'a option -> 'a option -> 'a option
val anonymous: Positions.t -> parameterized_branch list -> string
val rules: unit -> parameterized_rule list
(* [producer_names producers] returns an array [names] such that
[names.(idx) = None] if the (idx + 1)-th producer is unnamed
and [names.(idx) = Some id] if it is called [id]. *)
val producer_names :
(_ * Syntax.identifier Positions.located option * _) list ->
Syntax.identifier option array
......@@ -19,7 +19,7 @@ open Positions
%token <Stretch.t> HEADER
%token <Stretch.ocamltype> OCAMLTYPE
%token <Stretch.t Lazy.t> PERCENTPERCENT
%token <Syntax.action> ACTION
%token <Syntax.identifier option array -> Syntax.action> ACTION
%start grammar
%type <ConcreteSyntax.grammar> grammar
......@@ -261,18 +261,26 @@ production_groups:
production_group:
productions ACTION /* action is lexically delimited by braces */ optional_precedence
{
{
let productions, action, oprec2 = $1, $2, $3 in
let productions = ParserAux.normalize_production_group productions in
List.map (fun (producers, oprec1, rprec, pos) -> {
pr_producers = producers;
pr_action = action;
pr_branch_shift_precedence = ParserAux.override pos oprec1 oprec2;
pr_branch_reduce_precedence = rprec;
pr_branch_position = pos
}) productions
(* If multiple productions share a single semantic action, check
that all of them bind the same names. *)
ParserAux.check_production_group productions;
(* Then, *)
List.map (fun (producers, oprec1, rprec, pos) ->
(* Replace [$i] with [_i]. *)
let pr_producers = ParserAux.normalize_producers producers in
(* Distribute the semantic action. Also, check that every [$i]
is within bounds. *)
let pr_action = action (ParserAux.producer_names producers) in
{
pr_producers;
pr_action;
pr_branch_shift_precedence = ParserAux.override pos oprec1 oprec2;
pr_branch_reduce_precedence = rprec;
pr_branch_position = pos
})
productions
}
optional_precedence:
......
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