Commit 4ff8a6bd authored by Yann Régis-Gianas's avatar Yann Régis-Gianas

- ParserAux.producer_names: New. Is the n-th producer anonymous or not?

  (Now uses the Str module.)

- Lexer.check_producers_indices: New. Are $i keywords correctly used?

- yacc-parser/fancy-parser: Turn the type of actions' semantic values
  into arrows to delay the checking of $i keywords from lexing to
  parsing.
parent abe44f80
......@@ -11,9 +11,9 @@
<checkOCamlVersion.byte>: use_str
# Build and link with -g.
<**/*.{cmo,cmx}>:debug
<**/*.byte>:debug
<**/*.native>:debug
<**/*.{cmo,cmx}>:debug, use_str
<**/*.byte>:debug, use_str
<**/*.native>:debug, use_str
# Every module that is part of MenhirLib must be tagged as such.
# If you change this list, please also update the files LICENSE
......
......@@ -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,17 @@ 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
})
|> List.map (fun (producers, oprec1, rprec, pos) ->
let producer_names = ParserAux.producer_names producers in
{
pr_producers = producers;
pr_action = action producer_names;
pr_branch_shift_precedence = ParserAux.override pos oprec1 oprec2;
pr_branch_reduce_precedence = rprec;
pr_branch_position = pos
})
}
| 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 () ->
......@@ -113,3 +113,17 @@ let rules () =
rules := [];
result
(* Only unamed producers can be referred 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 using [x], not
[$(idx + 1)]. *)
let producer_names producers =
let is_index identifier =
Str.(string_match (regexp "_[0-9]+") identifier 0)
in
List.(
producers
|> map (fun ({ value = id }, _) -> if is_index id then None else Some id)
|> Array.of_list
)
......@@ -29,3 +29,8 @@ 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.producer 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,20 @@ 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
List.map (fun (producers, oprec1, rprec, pos) ->
let producer_names = ParserAux.producer_names producers in
{
pr_producers = producers;
pr_action = action producer_names;
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