partialGrammar.ml 23.4 KB
Newer Older
1 2 3 4 5 6 7 8
open Misc
open Syntax
open Positions

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

9
let join_declaration filename (grammar : grammar) decl =
10 11 12 13 14 15
  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. *)

16
  | DCode code ->
17
      { grammar with p_preludes = grammar.p_preludes @ [ code ] }
18
  | DParameter (Stretch.Declared stretch) ->
19 20 21 22 23 24 25 26 27
      { 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. *)

  | DToken (ocamltype, terminal) ->
28
      let token_property =
29
        try
30

31
          (* Retrieve any previous definition for this token. *)
32

33 34 35
          let token_property =
            StringMap.find terminal grammar.p_tokens
          in
36

37 38 39
          (* If the previous definition was actually a %token declaration
             (as opposed to a %left, %right, or %nonassoc specification),
             signal an error. *)
40

41 42 43
          if token_property.tk_is_declared then
            Error.errorp decl
              "the token %s has multiple definitions." terminal
44

45
          (* Otherwise, update the previous definition. *)
46

47 48
          else
            { token_property with
49 50 51 52 53
              tk_is_declared = true;
              tk_ocamltype   = ocamltype;
              tk_filename    = filename;
              tk_position    = decl.position;
            }
54

55
        with Not_found ->
56

57
          (* If no previous definition exists, create one. *)
58

59 60
          {
            tk_filename      = filename;
61 62 63 64 65
            tk_ocamltype     = ocamltype;
            tk_associativity = UndefinedAssoc;
            tk_precedence    = UndefinedPrecedence;
            tk_position      = decl.position;
            tk_is_declared   = true
66
          }
67 68 69

      in
      { grammar with
70
        p_tokens = StringMap.add terminal token_property grammar.p_tokens }
71 72 73 74 75 76 77 78 79 80 81 82 83

  (* 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 }

84 85 86 87 88 89
  (* Reductions on error for nonterminals. *)

  | DOnErrorReduce (nonterminal) ->
      { grammar with
        p_on_error_reduce = nonterminal :: grammar.p_on_error_reduce }

90 91 92 93 94
  (* Token associativity and precedence. *)

  | DTokenProperties (terminal, assoc, prec) ->

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

98 99
      let token_properties, grammar =
        try
100
          StringMap.find terminal grammar.p_tokens, grammar
101 102 103
        with Not_found ->
          let p = {
            tk_filename      = filename;
104 105 106 107 108 109
            tk_ocamltype     = None;
            tk_associativity = UndefinedAssoc;
            tk_precedence    = prec;
            tk_is_declared   = false;
            (* Will be updated later. *)
            tk_position      = decl.position;
110 111
          } in
          p, { grammar with
112
               p_tokens = StringMap.add terminal p grammar.p_tokens }
113 114 115 116
      in

      (* Reject duplicate precedence declarations. *)

117
      if token_properties.tk_associativity <> UndefinedAssoc then
118 119 120
        Error.error
          [ decl.position; token_properties.tk_position ]
          "there are multiple precedence declarations for token %s." terminal;
121 122 123

      (* Record the new declaration. *)

124
      token_properties.tk_precedence <- prec;
125 126 127 128
      token_properties.tk_associativity <- assoc;
      grammar

(* ------------------------------------------------------------------------- *)
129
(* This stores an optional trailer into a grammar.
130 131
   Trailers are stored in an arbitrary order. *)

132
let join_trailer trailer grammar =
133
  match trailer with
134 135 136
  | None ->
      grammar
  | Some trailer ->
137 138 139 140 141 142 143 144 145
      { grammar with p_postludes = trailer :: grammar.p_postludes }

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

type renaming =
   (nonterminal * nonterminal) list

146 147
let identity_renaming =
  []
148 149 150 151

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

152
let rewrite_parameter phi parameter =
153 154 155 156 157 158 159 160 161 162 163 164 165 166 167
  Parameters.map (Positions.map (Misc.support_assoc phi)) parameter

let rewrite_element phi (ido, parameter) =
  ido, rewrite_parameter phi parameter

let rewrite_branch phi ({ pr_producers = producers } as branch) =
  { branch with pr_producers = List.map (rewrite_element phi) producers }

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

168
let fresh_counter = ref 0
169 170 171

let names = ref StringSet.empty

172
let use_name name =
173 174
  names := StringSet.add name !names

175
let used_name name =
176 177
  StringSet.mem name !names

178 179
let rec fresh ?(hint = "v") () =
  let name =
180 181 182 183 184 185 186 187 188
    incr fresh_counter;
    hint ^ string_of_int !fresh_counter
  in
    if used_name name then
      fresh ~hint ()
    else (
      use_name name;
      name
    )
189

190 191
(* Alpha conversion of [prule]. We rename bound parameters using
   fresh names. *)
192 193
let alphaconvert_rule parameters prule =
  let phi =
194 195 196
    List.combine parameters (List.map (fun x -> fresh ~hint:x ()) parameters)
  in
    { prule with
197 198
        pr_parameters  = List.map (Misc.support_assoc phi) prule.pr_parameters;
        pr_branches    = rewrite_branches phi prule.pr_branches
199 200
    }

POTTIER Francois's avatar
POTTIER Francois committed
201
(* Rewrite a rule taking bound names into account. We rename parameters
202
   to avoid capture. *)
203 204 205 206
let rewrite_rule phi prule =
  let ids =
    List.fold_left (fun acu (f, d) -> StringSet.add f (StringSet.add d acu))
      StringSet.empty phi
207
  in
208
  let captured_parameters =
209 210
    List.filter (fun p -> StringSet.mem p ids) prule.pr_parameters
  in
211
  let prule =
212 213 214
    alphaconvert_rule captured_parameters prule
  in
    { prule with
215 216
        pr_nt = rewrite_nonterminal phi prule.pr_nt;
        pr_branches = rewrite_branches phi prule.pr_branches }
217

218 219 220 221 222 223
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. *)
224
  if phi = identity_renaming then
225
    grammar
226
  else
227 228 229 230 231 232 233
    { 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
234
  | 'A' .. 'Z'
235 236 237 238 239 240 241 242 243 244 245
  | 'a' .. 'z'
  | '_'
  | '\192' .. '\214'
  | '\216' .. '\246'
  | '\248' .. '\255'
  | '0' .. '9' ->
      true
  | _ ->
      false

let restrict filename =
246 247 248 249
  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 '_'
250
  done;
251
  Bytes.unsafe_to_string m
252

253
let rename nonterminal filename =
254 255 256
  let name = restrict filename ^ "_" ^ nonterminal in
    if used_name name then
      fresh ~hint:name ()
257
    else
258 259 260 261 262 263
      (use_name name; name)

(* ------------------------------------------------------------------------- *)
(* A nonterminal is considered public if it is declared using %public
   or %start. *)

264
(* TEMPORARY why unused?
265 266
let is_public grammar prule =
  prule.pr_public_flag || StringMap.mem prule.pr_nt grammar.p_start_symbols
267
*)
268 269
(* ------------------------------------------------------------------------- *)
type symbol_kind =
270

271 272 273 274 275 276 277 278 279
  (* The nonterminal is declared public at a particular position. *)
  | PublicNonTerminal of Positions.t

  (* The nonterminal is not declared public at a particular position. *)
  | PrivateNonTerminal of Positions.t

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

280
  (* We do not know yet what the symbol means.
281 282 283 284 285 286
     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

287
let find_symbol (symbols : symbol_table) symbol =
288 289
  Hashtbl.find symbols symbol

290
let add_in_symbol_table (symbols : symbol_table) symbol kind =
291 292 293 294
  use_name symbol;
  Hashtbl.add symbols symbol kind;
  symbols

295
let replace_in_symbol_table (symbols : symbol_table) symbol kind =
296 297 298
  Hashtbl.replace symbols symbol kind;
  symbols

299
let empty_symbol_table () : symbol_table =
300 301
  Hashtbl.create 13

302
let store_symbol (symbols : symbol_table) symbol kind =
303 304 305
  try
    let sym_info = find_symbol symbols symbol in
      match sym_info, kind with
306

307 308 309 310
        (* There are two definitions of the same symbol in one
           particular unit. This is forbidden. *)
        | (PublicNonTerminal p | PrivateNonTerminal p),
          (PublicNonTerminal p' | PrivateNonTerminal p') ->
311
            Error.error [ p; p']
312 313 314 315
                 "the nonterminal symbol %s is multiply defined."
                 symbol

        (* The symbol is known to be a token but declared as a non terminal.*)
316
        | (Token tkp, (PrivateNonTerminal p | PublicNonTerminal p))
317 318 319 320 321 322 323
        | ((PrivateNonTerminal p | PublicNonTerminal p), Token tkp) ->
            Error.error [ p; tkp.tk_position ]
                 "the identifier %s is a reference to a token."
                 symbol

        (* We do not gain any piece of information. *)
        | _, DontKnow _ | Token _, Token _ ->
324
            symbols
325 326 327 328

        (* We learn that the symbol is a non terminal or a token. *)
        | DontKnow _, _ ->
            replace_in_symbol_table symbols symbol kind
329 330 331 332 333 334 335 336 337 338

  with Not_found ->
    add_in_symbol_table symbols symbol kind

let store_used_symbol position tokens symbols symbol =
  try
    store_symbol symbols symbol (Token (StringMap.find symbol tokens))
  with Not_found ->
    store_symbol symbols symbol (DontKnow position)

339
let non_terminal_is_not_reserved symbol positions =
340 341
  if symbol = "error" then
    Error.error positions
342 343
      "%s is reserved and thus cannot be used \
       as a non-terminal symbol." symbol
344

345
let non_terminal_is_not_a_token tokens symbol positions =
346 347 348
  try
    let tkp = StringMap.find symbol tokens in
      Error.error (positions @ [ tkp.tk_position ])
349 350
         "the identifier %s is a reference to a token."
         symbol
351 352 353 354 355 356
  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))
357

358 359 360 361 362
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))

363 364
(* for debugging, presumably:

365 366 367 368 369 370 371 372 373 374 375 376 377
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)

378
let string_of_symbol_table t =
379 380 381 382 383 384 385
  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
386 387
    Hashtbl.iter (fun k v -> Buffer.add_string b
                    (Printf.sprintf "%s: %s\n"
388
                       (fill_blank k) (string_of_kind v))) t;
389
    Buffer.contents b
390
*)
391

392
let is_private_symbol t x =
393 394 395
  try
    match Hashtbl.find t x with
      | PrivateNonTerminal _ ->
396
          true
397

398
      | _ ->
399
          false
400
  with Not_found ->
401 402
    false

403
(* TEMPORARY why unused?
404
let is_public_symbol t x =
405 406 407
  try
    match Hashtbl.find t x with
      | PublicNonTerminal _ ->
408
          true
409

410
      | _ ->
411
          false
412
  with Not_found ->
413
    false
414
*)
415

416 417
let fold_on_private_symbols f init t =
  Hashtbl.fold
418 419 420 421
    (fun k -> function PrivateNonTerminal _ -> (fun acu -> f acu k)
       | _ -> (fun acu -> acu))
    t init

422 423
let fold_on_public_symbols f init t =
  Hashtbl.fold
424 425 426 427
    (fun k -> function PublicNonTerminal _ -> (fun acu -> f acu k)
       | _ -> (fun acu -> acu))
    t init

428 429
let iter_on_only_used_symbols f t =
  Hashtbl.iter
430 431
    (fun k -> function DontKnow pos -> f k pos
       | _ -> ())
432
    t
433

434
let symbols_of grammar (pgrammar : Syntax.partial_grammar) =
435
  let tokens = grammar.p_tokens in
436
  let symbols_of_rule symbols prule =
437 438 439 440 441 442 443 444 445 446 447 448 449
    let rec store_except_rule_parameters symbols parameter =
      let symbol, parameters = Parameters.unapp parameter in
      (* Rule parameters are bound locally, so they are not taken into account. *)
      if List.mem symbol.value prule.pr_parameters then
        (* TEMPORARY probable BUG: even if the symbol is locally bound, its
           parameters should still be examined! *)
        symbols
      else
        (* Otherwise, mark this symbol as used and analyse its parameters. *)
        List.fold_left
          store_except_rule_parameters
          (store_used_symbol symbol.position tokens symbols symbol.value)
          parameters
450
    in
451

452 453
    (* Analyse each branch. *)
    let symbols = List.fold_left (fun symbols branch ->
454
      List.fold_left (fun symbols (_, p) ->
455
        store_except_rule_parameters symbols p
456 457 458 459
      ) symbols branch.pr_producers
    ) symbols prule.pr_branches
    in
      (* Store the symbol declaration. *)
460 461
      if prule.pr_public_flag
        || StringMap.mem prule.pr_nt grammar.p_start_symbols then
462
        store_public_nonterminal tokens symbols prule.pr_nt prule.pr_positions
463
      else
464
        store_private_nonterminal tokens symbols prule.pr_nt prule.pr_positions
465 466 467
  in
    List.fold_left symbols_of_rule (empty_symbol_table ()) pgrammar.pg_rules

468
let merge_rules symbols pgs =
469 470 471

  (* Retrieve all the public symbols. *)
  let public_symbols =
472
    List.fold_left (fold_on_public_symbols (fun s k -> StringSet.add k s))
473 474 475 476
      (StringSet.singleton "error")
      symbols
  in

477
  (* We check the references in each grammar can be bound to
478
     a public symbol. *)
479 480 481
  let _ =
    List.iter
      (iter_on_only_used_symbols
482 483 484
         (fun k pos -> if not (StringSet.mem k public_symbols) then
            Error.error [ pos ]
              "%s is undefined." k))
485 486 487
      symbols
  in
  (* Detect private symbol clashes and rename them if necessary. *)
488 489
  let detect_private_symbol_clashes =
    fold_on_private_symbols
490
      (fun (defined, clashes) symbol ->
491
         if StringSet.mem symbol defined
492 493
           || StringSet.mem symbol public_symbols then
           (defined, StringSet.add symbol clashes)
494
         else
495
           (StringSet.add symbol defined, clashes))
496 497
  in
  let _private_symbols, clashes =
498
    List.fold_left detect_private_symbol_clashes (StringSet.empty, StringSet.empty) symbols
499 500
  in
  let rpgs = List.map
501
    (fun (symbol_table, pg) ->
502 503
       let renaming =
         StringSet.fold
504 505 506 507 508 509 510 511 512
           (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)
513
           clashes []
514
       in
515
         rewrite_grammar renaming pg)
516 517
    pgs
  in
518 519

    (* Merge public nonterminal definitions
520 521
       and copy private nonterminal definitions. Since the clash between
       private symbols have already been resolved, these copies are safe. *)
522 523 524 525
    List.fold_left
      (fun rules rpg -> List.fold_left
         (fun rules r ->
            let r =
526 527 528
              try
                let r' = StringMap.find r.pr_nt rules in
                let positions = r.pr_positions @ r'.pr_positions in
529 530 531
                let ra, ra' =
                  List.length r.pr_parameters,
                  List.length r'.pr_parameters
532 533
                in
                  (* The arity of the parameterized symbols must be constant.*)
534 535
                  if ra <> ra' then
                    Error.error positions
536 537 538 539 540
                      "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
541 542
                  else
                    (* We combine the different branches. The parameters
543
                       could have different names, we rename them with
544
                       the fresh names assigned earlier (see the next
545 546 547
                       comment). *)
                    let phi = List.combine r.pr_parameters r'.pr_parameters in
                    let rbr = rewrite_branches phi r.pr_branches in
548
                      { r' with
549
                          pr_positions = positions;
550 551
                          pr_branches  = rbr @ r'.pr_branches
                      }
552
              with Not_found ->
553
                (* We alphaconvert the rule in order to avoid the capture of
554 555 556 557
                   private symbols coming from another unit. *)
                alphaconvert_rule r.pr_parameters r
            in
              StringMap.add r.pr_nt r rules) rules rpg.pg_rules)
558 559 560 561 562 563 564 565 566 567
      StringMap.empty rpgs

let empty_grammar =
  {
    p_preludes                = [];
    p_postludes               = [];
    p_parameters              = [];
    p_start_symbols           = StringMap.empty;
    p_types                   = [];
    p_tokens                  = StringMap.empty;
568 569
    p_rules                   = StringMap.empty;
    p_on_error_reduce         = [];
570 571 572 573 574 575 576 577 578 579
  }

let join grammar pgrammar =
  let filename = pgrammar.pg_filename in
    List.fold_left (join_declaration filename) grammar pgrammar.pg_declarations
    $$ join_trailer pgrammar.pg_trailer

let check_parameterized_grammar_is_well_defined grammar =

  (* Every start symbol is defined and has a %type declaration. *)
580
  StringMap.iter
581 582
    (fun nonterminal p ->
       if not (StringMap.mem nonterminal grammar.p_rules) then
583
         Error.error [p] "the start symbol %s is undefined." nonterminal;
584
       if not (List.exists (function
585 586
                            | ParameterVar { value = id }, _ -> id = nonterminal
                            | _ -> false) grammar.p_types) then
587 588
         Error.error [p]
           "the type of the start symbol %s is unspecified." nonterminal;
589 590
    ) grammar.p_start_symbols;

591 592 593 594 595 596
  (* Every %type definition has, at its head, a nonterminal symbol. *)
  (* Same check for %on_error_reduce definitions. *)
  (* Apparently we do not check the parameters at this point. Maybe this is
     done later, or not at all. *)
  let check (kind : string) (ps : Syntax.parameter list) =
    List.iter (fun p ->
597
      let (head_symb, _) = Parameters.unapp p in
598
      if not (StringMap.mem (value head_symb) grammar.p_rules) then
599
        Error.error [Parameters.position p]
600
             "this should be a nonterminal symbol.\n\
601
              %s declarations are applicable only to nonterminal symbols." kind
602 603 604 605
    ) ps
  in
  check "%type" (List.map fst grammar.p_types);
  check "%on_error_reduce" grammar.p_on_error_reduce;
606 607 608 609

  (* Every reference to a symbol is well defined. *)
  let reserved = [ "error" ] in
  let used_tokens = ref StringSet.empty in
610
  let mark_token_as_used token =
611 612
    used_tokens := StringSet.add token !used_tokens
  in
613
  let check_identifier_reference grammar prule s p =
614 615 616
    (* 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;
617

618
    if not (StringMap.mem s grammar.p_rules
619 620 621
           || StringMap.mem s grammar.p_tokens
           || List.mem s prule.pr_parameters
           || List.mem s reserved) then
622
      Error.error [ p ] "%s is undefined." s
623 624 625 626
  in
    StringMap.iter
      (fun k prule -> List.iter

627
         (* Check each branch. *)
628
         (fun { pr_producers = producers;
629 630
                pr_branch_prec_annotation;
              } -> ignore (List.fold_left
631

632
            (* Check the producers. *)
633
            (fun already_seen (id, p) ->
634 635
               let symbol, parameters = Parameters.unapp p in
               let s = symbol.value and p = symbol.position in
636
               let already_seen =
637 638 639
                 (* Check the producer id is unique. *)
                 if StringSet.mem id.value already_seen then
                   Error.error [ id.position ]
640
                        "there are multiple producers named %s in this sequence."
641 642 643 644 645 646
                        id.value;
                 StringSet.add id.value already_seen
               in

                 (* Check that the producer is defined somewhere. *)
                 check_identifier_reference grammar prule s p;
647
                 StringMap.iter (check_identifier_reference grammar prule)
648 649 650
                   (List.fold_left Parameters.identifiers StringMap.empty parameters);

                 (* If this producer seems to be a reference to a token, make sure it
651 652
                    is a real token, as opposed to a pseudo-token introduced in a
                    priority declaration. *)
653
                 (try
654
                    if not ((StringMap.find s grammar.p_tokens).tk_is_declared
655
                           || List.mem s reserved) then
656 657 658 659
                      Error.errorp symbol
                        "%s has not been declared as a token." s
                  with Not_found -> ());
                 already_seen
660

661 662
            ) StringSet.empty producers);

663
            match pr_branch_prec_annotation with
664 665 666 667

              | None -> ()

              | Some terminal ->
668
                  check_identifier_reference grammar prule
669
                    terminal.value terminal.position;
670

671
                  (* Furthermore, the symbol following %prec must be a valid
672
                     token identifier. *)
673
                  if not (StringMap.mem terminal.value grammar.p_tokens) then
674 675
                    Error.errorp terminal
                      "%s is undefined." terminal.value)
676

677
         prule.pr_branches;
678

679
         (* It is forbidden to use %inline on a %start symbol. *)
680
         if (prule.pr_inline_flag
681
             && StringMap.mem k grammar.p_start_symbols) then
682
           Error.error prule.pr_positions
683
                "%s cannot be both a start symbol and inlined." k;
684 685

      ) grammar.p_rules;
686

687
  (* Check that every token is used. *)
688 689 690 691 692 693
  if not Settings.ignore_all_unused_tokens then begin
    match Settings.token_type_mode with
    | Settings.TokenTypeOnly ->
        ()
    | Settings.TokenTypeAndCode
    | Settings.CodeOnly _ ->
694
        StringMap.iter (fun token { tk_position = p } ->
695 696
          if not (StringSet.mem token !used_tokens
               || StringSet.mem token Settings.ignored_unused_tokens) then
697
            Error.warning [p]
698
              "the token %s is unused." token
699
        ) grammar.p_tokens
700
  end;
701

702 703 704 705 706 707
  grammar

let join_partial_grammars pgs =
  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
708
  let rules = merge_rules symbols tpgs in
709
  check_parameterized_grammar_is_well_defined { grammar with p_rules = rules }