partialGrammar.ml 26.6 KB
Newer Older
1 2 3 4 5 6 7 8 9 10 11 12 13
(******************************************************************************)
(*                                                                            *)
(*                                   Menhir                                   *)
(*                                                                            *)
(*                       François Pottier, Inria Paris                        *)
(*              Yann Régis-Gianas, PPS, Université Paris Diderot              *)
(*                                                                            *)
(*  Copyright Inria. All rights reserved. This file is distributed under the  *)
(*  terms of the GNU General Public License version 2, as described in the    *)
(*  file LICENSE.                                                             *)
(*                                                                            *)
(******************************************************************************)

14 15 16 17 18 19 20
open Syntax
open Positions

(* ------------------------------------------------------------------------- *)
(* This adds one declaration [decl], as found in file [filename], to
   the grammar [grammar]. *)

21
let join_declaration filename (grammar : grammar) decl =
22 23 24 25 26 27
  match decl.value with

  (* Preludes are stored in an arbitrary order. The order of
     preludes within a single source file is preserved. Same
     treatment for functor parameters. *)

28
  | DCode code ->
29
      { grammar with p_preludes = grammar.p_preludes @ [ code ] }
30
  | DParameter (Stretch.Declared stretch) ->
31 32 33 34 35 36 37 38
      { grammar with p_parameters = grammar.p_parameters @ [ stretch ] }
  | DParameter (Stretch.Inferred _) ->
      assert false

  (* Token declarations are recorded. Things are made somewhat
     difficult by the fact that %token and %left-%right-%nonassoc
     declarations are independent. *)

39 40 41
  (* Declarations of token aliases are lost at this point. *)

  | DToken (ocamltype, terminal, _alias, attributes) ->
42
      let token_property =
43
        try
44

45
          (* Retrieve any previous definition for this token. *)
46

47 48 49
          let token_property =
            StringMap.find terminal grammar.p_tokens
          in
50

51 52 53
          (* If the previous definition was actually a %token declaration
             (as opposed to a %left, %right, or %nonassoc specification),
             signal an error. *)
54

55 56
          if token_property.tk_is_declared then
            Error.errorp decl
57
              "the token %s has multiple definitions." terminal;
58

59
          (* Otherwise, update the previous definition. *)
60

61 62 63 64 65 66 67
          { token_property with
            tk_is_declared = true;
            tk_ocamltype   = ocamltype;
            tk_filename    = filename;
            tk_position    = decl.position;
            tk_attributes  = attributes;
          }
68

69
        with Not_found ->
70

71
          (* If no previous definition exists, create one. *)
72

73 74
          {
            tk_filename      = filename;
75 76 77 78
            tk_ocamltype     = ocamltype;
            tk_associativity = UndefinedAssoc;
            tk_precedence    = UndefinedPrecedence;
            tk_position      = decl.position;
79
            tk_attributes    = attributes;
80
            tk_is_declared   = true
81
          }
82 83 84

      in
      { grammar with
85
        p_tokens = StringMap.add terminal token_property grammar.p_tokens }
86 87 88 89 90 91 92 93 94 95 96 97 98

  (* Start symbols. *)

  | DStart nonterminal ->
      { grammar with
        p_start_symbols = StringMap.add nonterminal decl.position grammar.p_start_symbols }

  (* Type declarations for nonterminals. *)

  | DType (ocamltype, nonterminal) ->
      { grammar with
          p_types = (nonterminal, with_pos (position decl) ocamltype)::grammar.p_types }

99 100
  (* Reductions on error for nonterminals. *)

101
  | DOnErrorReduce (nonterminal, prec) ->
102
      { grammar with
103
        p_on_error_reduce = (nonterminal, prec) :: grammar.p_on_error_reduce }
104

105 106 107 108 109
  (* Token associativity and precedence. *)

  | DTokenProperties (terminal, assoc, prec) ->

      (* Retrieve the property record for this token, creating one
110 111
         if none existed (but without deeming the token to have been
         declared). *)
112

113 114
      let token_properties, grammar =
        try
115
          StringMap.find terminal grammar.p_tokens, grammar
116 117 118
        with Not_found ->
          let p = {
            tk_filename      = filename;
119 120 121 122
            tk_ocamltype     = None;
            tk_associativity = UndefinedAssoc;
            tk_precedence    = prec;
            tk_is_declared   = false;
123
            tk_attributes    = [];
124 125
            (* Will be updated later. *)
            tk_position      = decl.position;
126 127
          } in
          p, { grammar with
128
               p_tokens = StringMap.add terminal p grammar.p_tokens }
129 130 131 132
      in

      (* Reject duplicate precedence declarations. *)

133
      if token_properties.tk_associativity <> UndefinedAssoc then
134 135 136
        Error.error
          [ decl.position; token_properties.tk_position ]
          "there are multiple precedence declarations for token %s." terminal;
137 138 139

      (* Record the new declaration. *)

140
      token_properties.tk_precedence <- prec;
141 142 143
      token_properties.tk_associativity <- assoc;
      grammar

144 145 146 147 148 149 150 151
  | DGrammarAttribute attr ->
      { grammar with
        p_grammar_attributes = attr :: grammar.p_grammar_attributes }

  | DSymbolAttributes (actuals, attrs) ->
      { grammar with
        p_symbol_attributes = (actuals, attrs) :: grammar.p_symbol_attributes }

152
(* ------------------------------------------------------------------------- *)
153 154
(* This stores an optional postlude into a grammar.
   Postludes are stored in an arbitrary order. *)
155

156 157
let join_postlude postlude grammar =
  match postlude with
158 159
  | None ->
      grammar
160 161
  | Some postlude ->
      { grammar with p_postludes = postlude :: grammar.p_postludes }
162 163 164 165 166 167 168 169

(* ------------------------------------------------------------------------- *)
(* We rewrite definitions when nonterminals are renamed. The
   renaming [phi] is an association list of names to names. *)

type renaming =
   (nonterminal * nonterminal) list

170 171
let identity_renaming =
  []
172 173 174 175

let rewrite_nonterminal (phi : renaming) nonterminal =
  Misc.support_assoc phi nonterminal

176
let rewrite_parameter phi parameter =
177 178
  Parameters.map (Positions.map (Misc.support_assoc phi)) parameter

179 180
let rewrite_producer phi ((ido, parameter, attrs) : producer) =
  ido, rewrite_parameter phi parameter, attrs
181 182

let rewrite_branch phi ({ pr_producers = producers } as branch) =
183
  { branch with pr_producers = List.map (rewrite_producer phi) producers }
184 185 186 187 188 189 190 191

let rewrite_branches phi branches =
  match phi with
  | [] ->
      branches
  | _ ->
      List.map (rewrite_branch phi) branches

192
let fresh_counter = ref 0
193 194 195

let names = ref StringSet.empty

196
let use_name name =
197 198
  names := StringSet.add name !names

199
let used_name name =
200 201
  StringSet.mem name !names

202 203
let rec fresh ?(hint = "v") () =
  let name =
204 205 206 207 208 209 210 211 212
    incr fresh_counter;
    hint ^ string_of_int !fresh_counter
  in
    if used_name name then
      fresh ~hint ()
    else (
      use_name name;
      name
    )
213

214 215
(* Alpha conversion of [prule]. We rename bound parameters using
   fresh names. *)
216 217
let alphaconvert_rule parameters prule =
  let phi =
218 219 220
    List.combine parameters (List.map (fun x -> fresh ~hint:x ()) parameters)
  in
    { prule with
221 222
        pr_parameters  = List.map (Misc.support_assoc phi) prule.pr_parameters;
        pr_branches    = rewrite_branches phi prule.pr_branches
223 224
    }

POTTIER Francois's avatar
POTTIER Francois committed
225
(* Rewrite a rule taking bound names into account. We rename parameters
226
   to avoid capture. *)
227 228 229 230
let rewrite_rule phi prule =
  let ids =
    List.fold_left (fun acu (f, d) -> StringSet.add f (StringSet.add d acu))
      StringSet.empty phi
231
  in
232
  let captured_parameters =
233 234
    List.filter (fun p -> StringSet.mem p ids) prule.pr_parameters
  in
235
  let prule =
236 237 238
    alphaconvert_rule captured_parameters prule
  in
    { prule with
239 240
        pr_nt = rewrite_nonterminal phi prule.pr_nt;
        pr_branches = rewrite_branches phi prule.pr_branches }
241

242 243 244 245 246 247
let rewrite_rules phi rules =
  List.map (rewrite_rule phi) rules

let rewrite_grammar phi grammar =
  (* We assume that [phi] affects only private symbols, so it does
     not affect the start symbols. *)
248
  if phi = identity_renaming then
249
    grammar
250
  else
251 252 253 254 255 256 257
    { grammar with pg_rules = rewrite_rules phi grammar.pg_rules }

(* ------------------------------------------------------------------------- *)
(* To rename (internalize) a nonterminal, we prefix it with its filename.
   This guarantees that names are unique. *)

let is_valid_nonterminal_character = function
258
  | 'A' .. 'Z'
259 260 261 262 263 264 265 266 267 268 269
  | 'a' .. 'z'
  | '_'
  | '\192' .. '\214'
  | '\216' .. '\246'
  | '\248' .. '\255'
  | '0' .. '9' ->
      true
  | _ ->
      false

let restrict filename =
270 271 272 273
  let m = Bytes.of_string (Filename.chop_suffix filename (if Settings.coq then ".vy" else ".mly")) in
  for i = 0 to Bytes.length m - 1 do
    if not (is_valid_nonterminal_character (Bytes.get m i)) then
      Bytes.set m i '_'
274
  done;
275
  Bytes.unsafe_to_string m
276

277
let rename nonterminal filename =
278 279 280
  let name = restrict filename ^ "_" ^ nonterminal in
    if used_name name then
      fresh ~hint:name ()
281
    else
282 283 284 285
      (use_name name; name)

(* ------------------------------------------------------------------------- *)
type symbol_kind =
286

287 288 289
  (* The nonterminal is declared public at a particular position. *)
  | PublicNonTerminal of Positions.t

290
  (* The nonterminal is declared (nonpublic) at a particular position. *)
291 292 293 294 295
  | PrivateNonTerminal of Positions.t

  (* The symbol is a token. *)
  | Token of token_properties

296
  (* We do not know yet what the symbol means.
297 298 299 300 301 302
     This is defined in the sequel or it is free in the partial grammar. *)
  | DontKnow of Positions.t

type symbol_table =
    (symbol, symbol_kind) Hashtbl.t

303
let find_symbol (symbols : symbol_table) symbol =
304 305
  Hashtbl.find symbols symbol

306
let add_in_symbol_table (symbols : symbol_table) symbol kind =
307 308 309 310
  use_name symbol;
  Hashtbl.add symbols symbol kind;
  symbols

311
let replace_in_symbol_table (symbols : symbol_table) symbol kind =
312 313 314
  Hashtbl.replace symbols symbol kind;
  symbols

315
let empty_symbol_table () : symbol_table =
316 317
  Hashtbl.create 13

318
let store_symbol (symbols : symbol_table) symbol kind =
319 320 321 322 323 324
  match find_symbol symbols symbol, kind with

  (* The symbol is not known so far. Add it. *)
  | exception Not_found ->
      add_in_symbol_table symbols symbol kind

325 326
  (* There are two definitions of this symbol in one grammatical unit
     (that is, one .mly file), and at least one of them is private.
327
     This is forbidden. *)
328 329 330
  | PrivateNonTerminal p, PrivateNonTerminal p'
  | PublicNonTerminal p, PrivateNonTerminal p'
  | PrivateNonTerminal p, PublicNonTerminal p' ->
331
      Error.error [ p; p']
332 333
        "the nonterminal symbol %s is multiply defined.\n\
         Only %%public symbols can have split definitions."
334 335 336
        symbol

  (* The symbol is known to be a token but declared as a nonterminal.*)
337 338
  | Token tkp, (PrivateNonTerminal p | PublicNonTerminal p)
  | (PrivateNonTerminal p | PublicNonTerminal p), Token tkp ->
339 340 341 342
      Error.error [ p; tkp.tk_position ]
           "the identifier %s is a reference to a token."
           symbol

343 344 345 346
  (* In the following cases, we do not gain any piece of information.
     As of 2017/03/29, splitting the definition of a %public nonterminal
     symbol is permitted. (It used to be permitted over multiple units,
     but forbidden within a single unit.) *)
347
  | _, DontKnow _
348 349
  | Token _, Token _
  | PublicNonTerminal _, PublicNonTerminal _ ->
350 351 352 353 354
      symbols

  (* We learn that the symbol is a nonterminal or a token. *)
  | DontKnow _, _ ->
      replace_in_symbol_table symbols symbol kind
355 356

let store_used_symbol position tokens symbols symbol =
357 358 359 360 361 362 363
  let kind =
    try
      Token (StringMap.find symbol tokens)
    with Not_found ->
      DontKnow position
  in
  store_symbol symbols symbol kind
364

365
let non_terminal_is_not_reserved symbol positions =
366 367
  if symbol = "error" then
    Error.error positions
368 369
      "%s is reserved and thus cannot be used \
       as a non-terminal symbol." symbol
370

371
let non_terminal_is_not_a_token tokens symbol positions =
372 373 374
  try
    let tkp = StringMap.find symbol tokens in
      Error.error (positions @ [ tkp.tk_position ])
375 376
         "the identifier %s is a reference to a token."
         symbol
377 378 379 380 381 382
  with Not_found -> ()

let store_public_nonterminal tokens symbols symbol positions =
  non_terminal_is_not_reserved symbol positions;
  non_terminal_is_not_a_token tokens symbol positions;
  store_symbol symbols symbol (PublicNonTerminal (List.hd positions))
383

384 385 386 387 388
let store_private_nonterminal tokens symbols symbol positions =
  non_terminal_is_not_reserved symbol positions;
  non_terminal_is_not_a_token tokens symbol positions;
  store_symbol symbols symbol (PrivateNonTerminal (List.hd positions))

389 390
(* for debugging, presumably:

391 392 393 394 395 396 397 398 399 400 401 402 403
let string_of_kind = function
  | PublicNonTerminal p ->
      Printf.sprintf "public (%s)" (Positions.string_of_pos p)

  | PrivateNonTerminal p ->
      Printf.sprintf "private (%s)" (Positions.string_of_pos p)

  | Token tk ->
      Printf.sprintf "token (%s)" tk.tk_filename

  | DontKnow p ->
      Printf.sprintf "only used at (%s)" (Positions.string_of_pos p)

404
let string_of_symbol_table t =
405 406 407 408 409 410 411
  let b = Buffer.create 13 in
  let m = 1 + Hashtbl.fold (fun k v acu -> max (String.length k) acu) t 0 in
  let fill_blank s =
    let s' = String.make m ' ' in
      String.blit s 0 s' 0 (String.length s);
      s'
  in
412 413
    Hashtbl.iter (fun k v -> Buffer.add_string b
                    (Printf.sprintf "%s: %s\n"
414
                       (fill_blank k) (string_of_kind v))) t;
415
    Buffer.contents b
416
*)
417

418
let is_private_symbol t x =
419 420 421
  try
    match Hashtbl.find t x with
      | PrivateNonTerminal _ ->
422
          true
423
      | _ ->
424
          false
425
  with Not_found ->
426 427
    false

428 429
let fold_on_private_symbols f init t =
  Hashtbl.fold
430 431 432 433
    (fun k -> function PrivateNonTerminal _ -> (fun acu -> f acu k)
       | _ -> (fun acu -> acu))
    t init

434 435
let fold_on_public_symbols f init t =
  Hashtbl.fold
436 437 438 439
    (fun k -> function PublicNonTerminal _ -> (fun acu -> f acu k)
       | _ -> (fun acu -> acu))
    t init

440 441
let iter_on_only_used_symbols f t =
  Hashtbl.iter
442 443
    (fun k -> function DontKnow pos -> f k pos
       | _ -> ())
444
    t
445

446
let symbols_of grammar (pgrammar : Syntax.partial_grammar) =
447
  let tokens = grammar.p_tokens in
448
  let symbols_of_rule symbols prule =
449 450
    let rec store_except_rule_parameters symbols parameter =
      let symbol, parameters = Parameters.unapp parameter in
451 452 453 454 455 456 457 458 459 460
      (* Process the reference to [symbol]. *)
      let symbols =
        if List.mem symbol.value prule.pr_parameters then
          (* Rule parameters are bound locally, so they are not taken into account. *)
          symbols
        else
          store_used_symbol symbol.position tokens symbols symbol.value
      in
      (* Process the parameters. *)
      List.fold_left store_except_rule_parameters symbols parameters
461
    in
462

463 464
    (* Analyse each branch. *)
    let symbols = List.fold_left (fun symbols branch ->
465
      List.fold_left (fun symbols (_, p, _) ->
466
        store_except_rule_parameters symbols p
467 468 469 470
      ) symbols branch.pr_producers
    ) symbols prule.pr_branches
    in
      (* Store the symbol declaration. *)
471 472
      (* A nonterminal symbol is considered public if it is declared using
         %public or %start. *)
473 474
      if prule.pr_public_flag
        || StringMap.mem prule.pr_nt grammar.p_start_symbols then
475
        store_public_nonterminal tokens symbols prule.pr_nt prule.pr_positions
476
      else
477
        store_private_nonterminal tokens symbols prule.pr_nt prule.pr_positions
478 479 480
  in
    List.fold_left symbols_of_rule (empty_symbol_table ()) pgrammar.pg_rules

481
let merge_rules symbols pgs =
482 483 484

  (* Retrieve all the public symbols. *)
  let public_symbols =
485
    List.fold_left (fold_on_public_symbols (fun s k -> StringSet.add k s))
486 487 488 489
      (StringSet.singleton "error")
      symbols
  in

490
  (* We check the references in each grammar can be bound to
491
     a public symbol. *)
492 493 494
  let _ =
    List.iter
      (iter_on_only_used_symbols
495 496 497
         (fun k pos -> if not (StringSet.mem k public_symbols) then
            Error.error [ pos ]
              "%s is undefined." k))
498 499 500
      symbols
  in
  (* Detect private symbol clashes and rename them if necessary. *)
501 502
  let detect_private_symbol_clashes =
    fold_on_private_symbols
503
      (fun (defined, clashes) symbol ->
504
         if StringSet.mem symbol defined
505 506
           || StringSet.mem symbol public_symbols then
           (defined, StringSet.add symbol clashes)
507
         else
508
           (StringSet.add symbol defined, clashes))
509 510
  in
  let _private_symbols, clashes =
511
    List.fold_left detect_private_symbol_clashes (StringSet.empty, StringSet.empty) symbols
512 513
  in
  let rpgs = List.map
514
    (fun (symbol_table, pg) ->
515 516
       let renaming =
         StringSet.fold
517 518 519 520 521 522 523 524 525
           (fun x phi ->
              if is_private_symbol symbol_table x then begin
                  let x' = rename x pg.pg_filename in
                    Printf.fprintf stderr
                      "Note: the nonterminal symbol %s (from %s) is renamed %s.\n"
                      x pg.pg_filename x';
                    (x, x') :: phi
                end
              else phi)
526
           clashes []
527
       in
528
         rewrite_grammar renaming pg)
529 530
    pgs
  in
531 532

    (* Merge public nonterminal definitions
533 534
       and copy private nonterminal definitions. Since the clash between
       private symbols have already been resolved, these copies are safe. *)
535 536 537 538
    List.fold_left
      (fun rules rpg -> List.fold_left
         (fun rules r ->
            let r =
539 540 541
              try
                let r' = StringMap.find r.pr_nt rules in
                let positions = r.pr_positions @ r'.pr_positions in
542 543 544
                let ra, ra' =
                  List.length r.pr_parameters,
                  List.length r'.pr_parameters
545 546
                in
                  (* The arity of the parameterized symbols must be constant.*)
547 548
                  if ra <> ra' then
                    Error.error positions
549 550 551 552 553
                      "the symbol %s is defined with arities %d and %d."
                         r.pr_nt ra ra'
                  else if r.pr_inline_flag <> r'.pr_inline_flag then
                    Error.error positions
                         "not all definitions of %s are marked %%inline." r.pr_nt
554 555
                  else
                    (* We combine the different branches. The parameters
556
                       could have different names, we rename them with
557
                       the fresh names assigned earlier (see the next
558 559 560
                       comment). *)
                    let phi = List.combine r.pr_parameters r'.pr_parameters in
                    let rbr = rewrite_branches phi r.pr_branches in
561
                      { r' with
562
                          pr_positions = positions;
563 564
                          pr_branches  = rbr @ r'.pr_branches;
                          pr_attributes = r.pr_attributes @ r'.pr_attributes;
565
                      }
566
              with Not_found ->
567
                (* We alphaconvert the rule in order to avoid the capture of
568 569 570 571
                   private symbols coming from another unit. *)
                alphaconvert_rule r.pr_parameters r
            in
              StringMap.add r.pr_nt r rules) rules rpg.pg_rules)
572 573 574 575 576 577 578 579 580 581
      StringMap.empty rpgs

let empty_grammar =
  {
    p_preludes                = [];
    p_postludes               = [];
    p_parameters              = [];
    p_start_symbols           = StringMap.empty;
    p_types                   = [];
    p_tokens                  = StringMap.empty;
582 583
    p_rules                   = StringMap.empty;
    p_on_error_reduce         = [];
584 585
    p_grammar_attributes      = [];
    p_symbol_attributes       = [];
586 587 588 589 590
  }

let join grammar pgrammar =
  let filename = pgrammar.pg_filename in
    List.fold_left (join_declaration filename) grammar pgrammar.pg_declarations
591
    |> join_postlude pgrammar.pg_postlude
592

593 594 595 596 597 598 599 600 601 602 603 604 605
(* If a rule is marked %inline, then it must not carry an attribute. *)
let check_inline_attribute prule =
  match prule.pr_inline_flag, prule.pr_attributes with
  | true, (id, _payload) :: _attributes ->
      Error.error
        [Positions.position id]
        "the nonterminal symbol %s is declared %%inline.\n\
         It cannot carry an attribute."
        prule.pr_nt
  | true, []
  | false, _ ->
      ()

606 607 608
let check_parameterized_grammar_is_well_defined grammar =

  (* Every start symbol is defined and has a %type declaration. *)
609
  StringMap.iter
610 611
    (fun nonterminal p ->
       if not (StringMap.mem nonterminal grammar.p_rules) then
612
         Error.error [p] "the start symbol %s is undefined." nonterminal;
613
       if not (List.exists (function
614 615
                            | ParameterVar { value = id }, _ -> id = nonterminal
                            | _ -> false) grammar.p_types) then
616 617
         Error.error [p]
           "the type of the start symbol %s is unspecified." nonterminal;
618 619
    ) grammar.p_start_symbols;

620 621
  (* Every %type definition refers to well-defined (terminal or nonterminal)
     symbols and has, at its head, a nonterminal symbol. *)
622
  (* Same check for %on_error_reduce definitions. *)
623 624 625 626 627 628 629 630 631 632 633 634 635 636

  let reserved = [ "error" ] in

  let rec check (kind : string) (must_be_nonterminal : bool) (p : Syntax.parameter) =
    (* Destructure head and arguments. *)
    let head, ps = Parameters.unapp p in
    let head = value head in
    (* Check if [head] is a nonterminal or terminal symbol. *)
    let is_nonterminal = StringMap.mem head grammar.p_rules
    and is_terminal = StringMap.mem head grammar.p_tokens || List.mem head reserved in
    (* If [head] is not satisfactory, error. *)
    if not (is_terminal || is_nonterminal) then
      Error.error [Parameters.position p]
             "%s is undefined." head;
637 638 639
    if (must_be_nonterminal && not is_nonterminal) then
      Error.error [Parameters.position p]
             "%s is a terminal symbol,\n\
640 641
              but %s declarations are applicable only to nonterminal symbols."
             (Parameters.print true p) kind;
642 643
    (* Then, check the arguments. *)
    List.iter (check kind false) ps
644
  in
645

646 647 648 649 650 651 652 653 654
  let check_fst kind must_be_nonterminal (p, _) =
    check kind must_be_nonterminal p
  in

  List.iter (check_fst "%type" true) grammar.p_types;
  List.iter (check_fst "%on_error_reduce" true) grammar.p_on_error_reduce;
  List.iter (fun (params, _) ->
    List.iter (check "%attribute" false) params
  ) grammar.p_symbol_attributes;
655 656 657

  (* Every reference to a symbol is well defined. *)
  let used_tokens = ref StringSet.empty in
658
  let mark_token_as_used token =
659 660
    used_tokens := StringSet.add token !used_tokens
  in
661
  let check_identifier_reference grammar prule s p =
662 663 664
    (* Mark the symbol as a used token if this is a token. *)
    if StringMap.mem s grammar.p_tokens then
      mark_token_as_used s;
665

666
    if not (StringMap.mem s grammar.p_rules
667 668 669
           || StringMap.mem s grammar.p_tokens
           || List.mem s prule.pr_parameters
           || List.mem s reserved) then
670
      Error.error [ p ] "%s is undefined." s
671 672
  in
    StringMap.iter
673 674 675 676 677 678 679 680 681 682
      (fun k prule ->

         (* The formal parameters of each rule must have distinct names. *)
         prule.pr_parameters
           |> List.sort compare
           |> Misc.dup compare
           |> Option.iter (fun x ->
                Error.error prule.pr_positions
                  "several parameters of this rule are named \"%s\"." x
              );
683

684
         (* Check each branch. *)
685
         List.iter (fun { pr_producers = producers;
686 687
                pr_branch_prec_annotation;
              } -> ignore (List.fold_left
688

689
            (* Check the producers. *)
690
            (fun already_seen (id, p, _) ->
691 692
               let symbol, parameters = Parameters.unapp p in
               let s = symbol.value and p = symbol.position in
693
               let already_seen =
694 695 696
                 (* Check the producer id is unique. *)
                 if StringSet.mem id.value already_seen then
                   Error.error [ id.position ]
697
                        "there are multiple producers named %s in this sequence."
698 699 700 701 702 703
                        id.value;
                 StringSet.add id.value already_seen
               in

                 (* Check that the producer is defined somewhere. *)
                 check_identifier_reference grammar prule s p;
704
                 StringMap.iter (check_identifier_reference grammar prule)
705 706 707
                   (List.fold_left Parameters.identifiers StringMap.empty parameters);

                 (* If this producer seems to be a reference to a token, make sure it
708 709
                    is a real token, as opposed to a pseudo-token introduced in a
                    priority declaration. *)
710
                 (try
711
                    if not ((StringMap.find s grammar.p_tokens).tk_is_declared
712
                           || List.mem s reserved) then
713 714 715 716
                      Error.errorp symbol
                        "%s has not been declared as a token." s
                  with Not_found -> ());
                 already_seen
717

718 719
            ) StringSet.empty producers);

720
            match pr_branch_prec_annotation with
721 722 723 724

              | None -> ()

              | Some terminal ->
725
                  check_identifier_reference grammar prule
726
                    terminal.value terminal.position;
727

728
                  (* Furthermore, the symbol following %prec must be a valid
729
                     token identifier. *)
730
                  if not (StringMap.mem terminal.value grammar.p_tokens) then
731 732
                    Error.errorp terminal
                      "%s is undefined." terminal.value)
733

734
         prule.pr_branches;
735

736
         (* It is forbidden to use %inline on a %start symbol. *)
737
         if (prule.pr_inline_flag
738
             && StringMap.mem k grammar.p_start_symbols) then
739
           Error.error prule.pr_positions
740
                "%s cannot be both a start symbol and inlined." k;
741

742 743 744
         (* If a rule is marked %inline, then it must not carry an attribute. *)
         check_inline_attribute prule

745
      ) grammar.p_rules;
746

747
  (* Check that every token is used. *)
748 749 750 751 752 753
  if not Settings.ignore_all_unused_tokens then begin
    match Settings.token_type_mode with
    | Settings.TokenTypeOnly ->
        ()
    | Settings.TokenTypeAndCode
    | Settings.CodeOnly _ ->
754
        StringMap.iter (fun token { tk_position = p } ->
755 756
          if not (StringSet.mem token !used_tokens
               || StringSet.mem token Settings.ignored_unused_tokens) then
757
            Error.warning [p]
758
              "the token %s is unused." token
759
        ) grammar.p_tokens
760
  end
761 762

let join_partial_grammars pgs =
763 764 765
  (* Prior to joining the partial grammars, remove all uses of token aliases. *)
  let pgs = ExpandTokenAliases.dealias_grammars pgs in
  (* Join the partial grammars. *)
766 767 768
  let grammar = List.fold_left join empty_grammar pgs in
  let symbols = List.map (symbols_of grammar) pgs in
  let tpgs = List.combine symbols pgs in
769
  let rules = merge_rules symbols tpgs in
770 771 772 773
  let grammar = { grammar with p_rules = rules } in
  (* Check well-formedness. *)
  check_parameterized_grammar_is_well_defined grammar;
  grammar