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]. *)

POTTIER Francois's avatar
POTTIER Francois committed
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. *)

POTTIER Francois's avatar
POTTIER Francois committed
16
  | DCode code ->
17
      { grammar with p_preludes = grammar.p_preludes @ [ code ] }
POTTIER Francois's avatar
POTTIER Francois committed
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) ->
POTTIER Francois's avatar
POTTIER Francois committed
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

POTTIER Francois's avatar
POTTIER Francois committed
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

POTTIER Francois's avatar
POTTIER Francois committed
55
        with Not_found ->
56

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

POTTIER Francois's avatar
POTTIER Francois committed
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
POTTIER Francois's avatar
POTTIER Francois committed
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

POTTIER Francois's avatar
POTTIER Francois committed
98 99
      let token_properties, grammar =
        try
100
          StringMap.find terminal grammar.p_tokens, grammar
POTTIER Francois's avatar
POTTIER Francois committed
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;
POTTIER Francois's avatar
POTTIER Francois committed
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. *)

POTTIER Francois's avatar
POTTIER Francois committed
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

(* ------------------------------------------------------------------------- *)
POTTIER Francois's avatar
POTTIER Francois committed
129
(* This stores an optional trailer into a grammar.
130 131
   Trailers are stored in an arbitrary order. *)

POTTIER Francois's avatar
POTTIER Francois committed
132
let join_trailer trailer grammar =
133
  match trailer with
POTTIER Francois's avatar
POTTIER Francois committed
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

POTTIER Francois's avatar
POTTIER Francois committed
146 147
let identity_renaming =
  []
148 149 150 151

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

POTTIER Francois's avatar
POTTIER Francois committed
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

POTTIER Francois's avatar
POTTIER Francois committed
168
let fresh_counter = ref 0
169 170 171

let names = ref StringSet.empty

POTTIER Francois's avatar
POTTIER Francois committed
172
let use_name name =
173 174
  names := StringSet.add name !names

POTTIER Francois's avatar
POTTIER Francois committed
175
let used_name name =
176 177
  StringSet.mem name !names

POTTIER Francois's avatar
POTTIER Francois committed
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
    )
POTTIER Francois's avatar
POTTIER Francois committed
189

190 191
(* Alpha conversion of [prule]. We rename bound parameters using
   fresh names. *)
POTTIER Francois's avatar
POTTIER Francois committed
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
Typo.  
POTTIER Francois committed
201
(* Rewrite a rule taking bound names into account. We rename parameters
202
   to avoid capture. *)
POTTIER Francois's avatar
POTTIER Francois committed
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
POTTIER Francois's avatar
POTTIER Francois committed
208
  let captured_parameters =
209 210
    List.filter (fun p -> StringSet.mem p ids) prule.pr_parameters
  in
POTTIER Francois's avatar
POTTIER Francois committed
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 }
POTTIER Francois's avatar
POTTIER Francois committed
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. *)
POTTIER Francois's avatar
POTTIER Francois committed
224
  if phi = identity_renaming then
225
    grammar
POTTIER Francois's avatar
POTTIER Francois committed
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
POTTIER Francois's avatar
POTTIER Francois committed
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

POTTIER Francois's avatar
POTTIER Francois committed
253
let rename nonterminal filename =
254 255 256
  let name = restrict filename ^ "_" ^ nonterminal in
    if used_name name then
      fresh ~hint:name ()
POTTIER Francois's avatar
POTTIER Francois committed
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 =
POTTIER Francois's avatar
POTTIER Francois committed
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

POTTIER Francois's avatar
POTTIER Francois committed
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

POTTIER Francois's avatar
POTTIER Francois committed
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
POTTIER Francois's avatar
POTTIER Francois committed
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') ->
POTTIER Francois's avatar
POTTIER Francois committed
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.*)
POTTIER Francois's avatar
POTTIER Francois committed
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 _ ->
POTTIER Francois's avatar
POTTIER Francois committed
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)

POTTIER Francois's avatar
POTTIER Francois committed
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

POTTIER Francois's avatar
POTTIER Francois committed
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))
POTTIER Francois's avatar
POTTIER Francois committed
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)

POTTIER Francois's avatar
POTTIER Francois committed
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
POTTIER Francois's avatar
POTTIER Francois committed
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

POTTIER Francois's avatar
POTTIER Francois committed
392
let is_private_symbol t x =
393 394 395
  try
    match Hashtbl.find t x with
      | PrivateNonTerminal _ ->
396
          true
POTTIER Francois's avatar
POTTIER Francois committed
397

398
      | _ ->
399
          false
POTTIER Francois's avatar
POTTIER Francois committed
400
  with Not_found ->
401 402
    false

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

410
      | _ ->
411
          false
POTTIER Francois's avatar
POTTIER Francois committed
412
  with Not_found ->
413
    false
414
*)
415

POTTIER Francois's avatar
POTTIER Francois committed
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

POTTIER Francois's avatar
POTTIER Francois committed
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

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

434
let symbols_of grammar (pgrammar : Syntax.partial_grammar) =
435
  let tokens = grammar.p_tokens in
POTTIER Francois's avatar
POTTIER Francois committed
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
POTTIER Francois's avatar
POTTIER Francois committed
451

452 453
    (* Analyse each branch. *)
    let symbols = List.fold_left (fun symbols branch ->
POTTIER Francois's avatar
POTTIER Francois committed
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. *)
POTTIER Francois's avatar
POTTIER Francois committed
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

POTTIER Francois's avatar
POTTIER Francois committed
468
let merge_rules symbols pgs =
469 470 471

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

POTTIER Francois's avatar
POTTIER Francois committed
477
  (* We check the references in each grammar can be bound to
478
     a public symbol. *)
POTTIER Francois's avatar
POTTIER Francois committed
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. *)
POTTIER Francois's avatar
POTTIER Francois committed
488 489
  let detect_private_symbol_clashes =
    fold_on_private_symbols
490
      (fun (defined, clashes) symbol ->
POTTIER Francois's avatar
POTTIER Francois committed
491
         if StringSet.mem symbol defined
492 493
           || StringSet.mem symbol public_symbols then
           (defined, StringSet.add symbol clashes)
POTTIER Francois's avatar
POTTIER Francois committed
494
         else
495
           (StringSet.add symbol defined, clashes))
POTTIER Francois's avatar
POTTIER Francois committed
496 497
  in
  let _private_symbols, clashes =
498
    List.fold_left detect_private_symbol_clashes (StringSet.empty, StringSet.empty) symbols
POTTIER Francois's avatar
POTTIER Francois committed
499 500
  in
  let rpgs = List.map
501
    (fun (symbol_table, pg) ->
POTTIER Francois's avatar
POTTIER Francois committed
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)
POTTIER Francois's avatar
POTTIER Francois committed
513
           clashes []
514
       in
515
         rewrite_grammar renaming pg)
516 517
    pgs
  in
POTTIER Francois's avatar
POTTIER Francois committed
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. *)
POTTIER Francois's avatar
POTTIER Francois committed
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
POTTIER Francois's avatar
POTTIER Francois committed
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.*)
POTTIER Francois's avatar
POTTIER Francois committed
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
POTTIER Francois's avatar
POTTIER Francois committed
541 542
                  else
                    (* We combine the different branches. The parameters
543
                       could have different names, we rename them with
POTTIER Francois's avatar
POTTIER Francois committed
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
POTTIER Francois's avatar
POTTIER Francois committed
548
                      { r' with
549
                          pr_positions = positions;
POTTIER Francois's avatar
POTTIER Francois committed
550 551
                          pr_branches  = rbr @ r'.pr_branches
                      }
552
              with Not_found ->
POTTIER Francois's avatar
POTTIER Francois committed
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. *)
POTTIER Francois's avatar
POTTIER Francois committed
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;
POTTIER Francois's avatar
POTTIER Francois committed
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
POTTIER Francois's avatar
POTTIER Francois committed
610
  let mark_token_as_used token =
611 612
    used_tokens := StringSet.add token !used_tokens
  in
POTTIER Francois's avatar
POTTIER Francois committed
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;
POTTIER Francois's avatar
POTTIER Francois committed
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. *)
POTTIER Francois's avatar
POTTIER Francois committed
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
POTTIER Francois's avatar
POTTIER Francois committed
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 ]
POTTIER Francois's avatar
POTTIER Francois committed
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;
POTTIER Francois's avatar
POTTIER Francois committed
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
POTTIER Francois's avatar
POTTIER Francois committed
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 ->
POTTIER Francois's avatar
POTTIER Francois committed
668
                  check_identifier_reference grammar prule
669
                    terminal.value terminal.position;
670

671
                  (* Furthermore, the symbol following %prec must be a valid
POTTIER Francois's avatar
POTTIER Francois committed
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. *)
POTTIER Francois's avatar
POTTIER Francois committed
680
         if (prule.pr_inline_flag
681
             && StringMap.mem k grammar.p_start_symbols) then
POTTIER Francois's avatar
POTTIER Francois committed
682
           Error.error prule.pr_positions
683
                "%s cannot be both a start symbol and inlined." k;
684 685

      ) grammar.p_rules;
POTTIER Francois's avatar
POTTIER Francois committed
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 _ ->
POTTIER Francois's avatar
POTTIER Francois committed
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
POTTIER Francois's avatar
POTTIER Francois committed
697
            Error.warning [p]
698
              "the token %s is unused." token
699
        ) grammar.p_tokens
700
  end;
POTTIER Francois's avatar
POTTIER Francois committed
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
POTTIER Francois's avatar
POTTIER Francois committed
708
  let rules = merge_rules symbols tpgs in
709
  check_parameterized_grammar_is_well_defined { grammar with p_rules = rules }