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 @@ ...@@ -11,9 +11,9 @@
<checkOCamlVersion.byte>: use_str <checkOCamlVersion.byte>: use_str
# Build and link with -g. # Build and link with -g.
<**/*.{cmo,cmx}>:debug <**/*.{cmo,cmx}>:debug, use_str
<**/*.byte>:debug <**/*.byte>:debug, use_str
<**/*.native>:debug <**/*.native>:debug, use_str
# Every module that is part of MenhirLib must be tagged as such. # Every module that is part of MenhirLib must be tagged as such.
# If you change this list, please also update the files LICENSE # If you change this list, please also update the files LICENSE
......
...@@ -25,7 +25,7 @@ open Positions ...@@ -25,7 +25,7 @@ open Positions
%token <Stretch.t> HEADER %token <Stretch.t> HEADER
%token <Stretch.ocamltype> OCAMLTYPE %token <Stretch.ocamltype> OCAMLTYPE
%token <Stretch.t Lazy.t> PERCENTPERCENT %token <Stretch.t Lazy.t> PERCENTPERCENT
%token <Action.t> ACTION %token <Syntax.identifier option array -> Action.t> ACTION
/* ------------------------------------------------------------------------- */ /* ------------------------------------------------------------------------- */
/* Start symbol. */ /* Start symbol. */
...@@ -268,15 +268,17 @@ production_group: ...@@ -268,15 +268,17 @@ production_group:
productions = separated_nonempty_list(BAR, production) productions = separated_nonempty_list(BAR, production)
action = ACTION action = ACTION
oprec2 = precedence? oprec2 = precedence?
{ {
ParserAux.normalize_production_group productions ParserAux.normalize_production_group productions
|> List.map (fun (producers, oprec1, rprec, pos) -> { |> List.map (fun (producers, oprec1, rprec, pos) ->
pr_producers = producers; let producer_names = ParserAux.producer_names producers in
pr_action = action; {
pr_branch_shift_precedence = ParserAux.override pos oprec1 oprec2; pr_producers = producers;
pr_branch_reduce_precedence = rprec; pr_action = action producer_names;
pr_branch_position = pos pr_branch_shift_precedence = ParserAux.override pos oprec1 oprec2;
}) pr_branch_reduce_precedence = rprec;
pr_branch_position = pos
})
} }
| error ACTION precedence? | error ACTION precedence?
| error EOF | error EOF
......
...@@ -13,7 +13,7 @@ ...@@ -13,7 +13,7 @@
let token = f lexbuf in let token = f lexbuf in
lexbuf.lex_start_p <- startp; lexbuf.lex_start_p <- startp;
token token
(* Updates the line counter, which is used in some error messages. *) (* Updates the line counter, which is used in some error messages. *)
let update_loc lexbuf = let update_loc lexbuf =
...@@ -37,6 +37,26 @@ ...@@ -37,6 +37,26 @@
assert (Bytes.get content offset = c1); assert (Bytes.get content offset = c1);
Bytes.set content offset c2 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 (* In-place transformation of keywords. We turn our keywords into
valid OCaml identifiers by replacing '$', '(', and ')' with '_'. valid OCaml identifiers by replacing '$', '(', and ')' with '_'.
Bloody. *) Bloody. *)
...@@ -344,8 +364,12 @@ rule main = parse ...@@ -344,8 +364,12 @@ rule main = parse
{ savestart lexbuf (fun lexbuf -> { savestart lexbuf (fun lexbuf ->
let openingpos = lexeme_end_p lexbuf in let openingpos = lexeme_end_p lexbuf in
let closingpos, pkeywords = action false openingpos [] lexbuf in let closingpos, pkeywords = action false openingpos [] lexbuf in
let stretch = mk_stretch openingpos closingpos true pkeywords in ACTION (
ACTION (Action.from_stretch stretch) 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
{ EOF } { EOF }
......
...@@ -6,7 +6,7 @@ let current_token_precedence = ...@@ -6,7 +6,7 @@ let current_token_precedence =
fun pos1 pos2 -> fun pos1 pos2 ->
incr c; incr c;
PrecedenceLevel (Error.get_filemark (), !c, pos1, pos2) PrecedenceLevel (Error.get_filemark (), !c, pos1, pos2)
let current_reduce_precedence = let current_reduce_precedence =
let c = ref 0 in let c = ref 0 in
fun () -> fun () ->
...@@ -113,3 +113,17 @@ let rules () = ...@@ -113,3 +113,17 @@ let rules () =
rules := []; rules := [];
result 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 ...@@ -29,3 +29,8 @@ val override: Positions.t -> 'a option -> 'a option -> 'a option
val anonymous: Positions.t -> parameterized_branch list -> string val anonymous: Positions.t -> parameterized_branch list -> string
val rules: unit -> parameterized_rule list 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 ...@@ -19,7 +19,7 @@ open Positions
%token <Stretch.t> HEADER %token <Stretch.t> HEADER
%token <Stretch.ocamltype> OCAMLTYPE %token <Stretch.ocamltype> OCAMLTYPE
%token <Stretch.t Lazy.t> PERCENTPERCENT %token <Stretch.t Lazy.t> PERCENTPERCENT
%token <Syntax.action> ACTION %token <Syntax.identifier option array -> Syntax.action> ACTION
%start grammar %start grammar
%type <ConcreteSyntax.grammar> grammar %type <ConcreteSyntax.grammar> grammar
...@@ -261,18 +261,20 @@ production_groups: ...@@ -261,18 +261,20 @@ production_groups:
production_group: production_group:
productions ACTION /* action is lexically delimited by braces */ optional_precedence productions ACTION /* action is lexically delimited by braces */ optional_precedence
{ {
let productions, action, oprec2 = $1, $2, $3 in let productions, action, oprec2 = $1, $2, $3 in
let productions = ParserAux.normalize_production_group productions in let productions = ParserAux.normalize_production_group productions in
List.map (fun (producers, oprec1, rprec, pos) -> { List.map (fun (producers, oprec1, rprec, pos) ->
pr_producers = producers; let producer_names = ParserAux.producer_names producers in
pr_action = action; {
pr_branch_shift_precedence = ParserAux.override pos oprec1 oprec2; pr_producers = producers;
pr_branch_reduce_precedence = rprec; pr_action = action producer_names;
pr_branch_position = pos pr_branch_shift_precedence = ParserAux.override pos oprec1 oprec2;
}) productions pr_branch_reduce_precedence = rprec;
pr_branch_position = pos
}) productions
} }
optional_precedence: 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