partialGrammar.ml 23.7 KB
Newer Older
1 2 3 4 5 6 7 8 9 10
open Misc
open Syntax
open ConcreteSyntax
open InternalSyntax
open Positions

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

POTTIER Francois's avatar
POTTIER Francois committed
11
let join_declaration filename (grammar : grammar) decl =
12 13 14 15 16 17
  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
18
  | DCode code ->
19
      { grammar with p_preludes = grammar.p_preludes @ [ code ] }
POTTIER Francois's avatar
POTTIER Francois committed
20
  | DParameter (Stretch.Declared stretch) ->
21 22 23 24 25 26 27 28 29
      { 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
30
      let token_property =
31
        try
32

33
          (* Retrieve any previous definition for this token. *)
34

35 36 37
          let token_property =
            StringMap.find terminal grammar.p_tokens
          in
38

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

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

47
          (* Otherwise, update the previous definition. *)
48

POTTIER Francois's avatar
POTTIER Francois committed
49 50
          else
            { token_property with
51 52 53 54 55
              tk_is_declared = true;
              tk_ocamltype   = ocamltype;
              tk_filename    = filename;
              tk_position    = decl.position;
            }
56

POTTIER Francois's avatar
POTTIER Francois committed
57
        with Not_found ->
58

59
          (* If no previous definition exists, create one. *)
60

POTTIER Francois's avatar
POTTIER Francois committed
61 62
          {
            tk_filename      = filename;
63 64 65 66 67
            tk_ocamltype     = ocamltype;
            tk_associativity = UndefinedAssoc;
            tk_precedence    = UndefinedPrecedence;
            tk_position      = decl.position;
            tk_is_declared   = true
POTTIER Francois's avatar
POTTIER Francois committed
68
          }
69 70 71

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

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

86 87 88 89 90 91
  (* Reductions on error for nonterminals. *)

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

92 93 94 95 96
  (* Token associativity and precedence. *)

  | DTokenProperties (terminal, assoc, prec) ->

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

POTTIER Francois's avatar
POTTIER Francois committed
100 101
      let token_properties, grammar =
        try
102
          StringMap.find terminal grammar.p_tokens, grammar
POTTIER Francois's avatar
POTTIER Francois committed
103 104 105
        with Not_found ->
          let p = {
            tk_filename      = filename;
106 107 108 109 110 111
            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
112 113
          } in
          p, { grammar with
114
               p_tokens = StringMap.add terminal p grammar.p_tokens }
115 116 117 118
      in

      (* Reject duplicate precedence declarations. *)

POTTIER Francois's avatar
POTTIER Francois committed
119
      if token_properties.tk_associativity <> UndefinedAssoc then
120 121 122
        Error.error
          [ decl.position; token_properties.tk_position ]
          "there are multiple precedence declarations for token %s." terminal;
123 124 125

      (* Record the new declaration. *)

126
      token_properties.tk_precedence <- prec;
127 128 129 130
      token_properties.tk_associativity <- assoc;
      grammar

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

POTTIER Francois's avatar
POTTIER Francois committed
134
let join_trailer trailer grammar =
135
  match trailer with
POTTIER Francois's avatar
POTTIER Francois committed
136 137 138
  | None ->
      grammar
  | Some trailer ->
139 140 141 142 143 144 145 146 147
      { 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
148 149
let identity_renaming =
  []
150 151 152 153

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

POTTIER Francois's avatar
POTTIER Francois committed
154
let rewrite_parameter phi parameter =
155 156 157 158 159 160 161 162 163 164 165 166 167 168 169
  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
170
let fresh_counter = ref 0
171 172 173

let names = ref StringSet.empty

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

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

POTTIER Francois's avatar
POTTIER Francois committed
180 181
let rec fresh ?(hint = "v") () =
  let name =
182 183 184 185 186 187 188 189 190
    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
191

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

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

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

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

POTTIER Francois's avatar
POTTIER Francois committed
255
let rename nonterminal filename =
256 257 258
  let name = restrict filename ^ "_" ^ nonterminal in
    if used_name name then
      fresh ~hint:name ()
POTTIER Francois's avatar
POTTIER Francois committed
259
    else
260 261 262 263 264 265
      (use_name name; name)

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

266
(* TEMPORARY why unused?
267 268
let is_public grammar prule =
  prule.pr_public_flag || StringMap.mem prule.pr_nt grammar.p_start_symbols
269
*)
270 271
(* ------------------------------------------------------------------------- *)
type symbol_kind =
POTTIER Francois's avatar
POTTIER Francois committed
272

273 274 275 276 277 278 279 280 281
  (* 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
282
  (* We do not know yet what the symbol means.
283 284 285 286 287 288
     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

289
let find_symbol (symbols : symbol_table) symbol =
290 291
  Hashtbl.find symbols symbol

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

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

301
let empty_symbol_table () : symbol_table =
302 303
  Hashtbl.create 13

POTTIER Francois's avatar
POTTIER Francois committed
304
let store_symbol (symbols : symbol_table) symbol kind =
305 306 307
  try
    let sym_info = find_symbol symbols symbol in
      match sym_info, kind with
POTTIER Francois's avatar
POTTIER Francois committed
308

309 310 311 312
        (* 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
313
            Error.error [ p; p']
314 315 316 317
                 "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
318
        | (Token tkp, (PrivateNonTerminal p | PublicNonTerminal p))
319 320 321 322 323 324 325
        | ((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
326
            symbols
327 328 329 330

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

  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
341
let non_terminal_is_not_reserved symbol positions =
342 343
  if symbol = "error" then
    Error.error positions
344 345
      "%s is reserved and thus cannot be used \
       as a non-terminal symbol." symbol
346

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

360 361 362 363 364
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))

365 366
(* for debugging, presumably:

367 368 369 370 371 372 373 374 375 376 377 378 379
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
380
let string_of_symbol_table t =
381 382 383 384 385 386 387
  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
388 389
    Hashtbl.iter (fun k v -> Buffer.add_string b
                    (Printf.sprintf "%s: %s\n"
390
                       (fill_blank k) (string_of_kind v))) t;
391
    Buffer.contents b
392
*)
393

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

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

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

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

POTTIER Francois's avatar
POTTIER Francois committed
418 419
let fold_on_private_symbols f init t =
  Hashtbl.fold
420 421 422 423
    (fun k -> function PrivateNonTerminal _ -> (fun acu -> f acu k)
       | _ -> (fun acu -> acu))
    t init

POTTIER Francois's avatar
POTTIER Francois committed
424 425
let fold_on_public_symbols f init t =
  Hashtbl.fold
426 427 428 429
    (fun k -> function PublicNonTerminal _ -> (fun acu -> f acu k)
       | _ -> (fun acu -> acu))
    t init

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

POTTIER Francois's avatar
POTTIER Francois committed
436
let symbols_of grammar (pgrammar : ConcreteSyntax.grammar) =
437
  let tokens = grammar.p_tokens in
POTTIER Francois's avatar
POTTIER Francois committed
438 439
  let symbols_of_rule symbols prule =
    let rec store_except_rule_parameters =
440
      fun symbols (symbol, parameters) ->
441 442 443 444
        (* Rule parameters are bound locally, so they are not taken into
           account. *)
        if List.mem symbol.value prule.pr_parameters then
          symbols
POTTIER Francois's avatar
POTTIER Francois committed
445
        else
446 447
          (* Otherwise, mark this symbol as being used and analyse its
             parameters. *)
POTTIER Francois's avatar
POTTIER Francois committed
448 449 450
          List.fold_left
            (fun symbols -> function
               | ParameterApp (symbol, parameters) ->
451 452 453 454 455
                   store_except_rule_parameters symbols (symbol, parameters)
               | ParameterVar symbol ->
                   store_except_rule_parameters symbols (symbol, [])
            )
            (store_used_symbol symbol.position tokens symbols symbol.value) parameters
456
    in
POTTIER Francois's avatar
POTTIER Francois committed
457

458 459
    (* Analyse each branch. *)
    let symbols = List.fold_left (fun symbols branch ->
POTTIER Francois's avatar
POTTIER Francois committed
460
      List.fold_left (fun symbols (_, p) ->
461 462
        let symbol, parameters = Parameters.unapp p in
        store_except_rule_parameters symbols (symbol, parameters)
463 464 465 466
      ) symbols branch.pr_producers
    ) symbols prule.pr_branches
    in
      (* Store the symbol declaration. *)
POTTIER Francois's avatar
POTTIER Francois committed
467 468
      if prule.pr_public_flag
        || StringMap.mem prule.pr_nt grammar.p_start_symbols then
469
        store_public_nonterminal tokens symbols prule.pr_nt prule.pr_positions
470
      else
471
        store_private_nonterminal tokens symbols prule.pr_nt prule.pr_positions
472 473 474
  in
    List.fold_left symbols_of_rule (empty_symbol_table ()) pgrammar.pg_rules

POTTIER Francois's avatar
POTTIER Francois committed
475
let merge_rules symbols pgs =
476 477 478

  (* Retrieve all the public symbols. *)
  let public_symbols =
POTTIER Francois's avatar
POTTIER Francois committed
479
    List.fold_left (fold_on_public_symbols (fun s k -> StringSet.add k s))
480 481 482 483
      (StringSet.singleton "error")
      symbols
  in

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

    (* Merge public nonterminal definitions
527 528
       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
529 530 531 532
    List.fold_left
      (fun rules rpg -> List.fold_left
         (fun rules r ->
            let r =
533 534 535
              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
536 537 538
                let ra, ra' =
                  List.length r.pr_parameters,
                  List.length r'.pr_parameters
539 540
                in
                  (* The arity of the parameterized symbols must be constant.*)
POTTIER Francois's avatar
POTTIER Francois committed
541 542
                  if ra <> ra' then
                    Error.error positions
543 544 545 546 547
                      "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
548 549
                  else
                    (* We combine the different branches. The parameters
550
                       could have different names, we rename them with
POTTIER Francois's avatar
POTTIER Francois committed
551
                       the fresh names assigned earlier (see the next
552 553 554
                       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
555
                      { r' with
556
                          pr_positions = positions;
POTTIER Francois's avatar
POTTIER Francois committed
557 558
                          pr_branches  = rbr @ r'.pr_branches
                      }
559
              with Not_found ->
POTTIER Francois's avatar
POTTIER Francois committed
560
                (* We alphaconvert the rule in order to avoid the capture of
561 562 563 564
                   private symbols coming from another unit. *)
                alphaconvert_rule r.pr_parameters r
            in
              StringMap.add r.pr_nt r rules) rules rpg.pg_rules)
565 566 567 568 569 570 571 572 573 574
      StringMap.empty rpgs

let empty_grammar =
  {
    p_preludes                = [];
    p_postludes               = [];
    p_parameters              = [];
    p_start_symbols           = StringMap.empty;
    p_types                   = [];
    p_tokens                  = StringMap.empty;
575 576
    p_rules                   = StringMap.empty;
    p_on_error_reduce         = [];
577 578 579 580 581 582 583 584 585 586
  }

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
587
  StringMap.iter
588 589
    (fun nonterminal p ->
       if not (StringMap.mem nonterminal grammar.p_rules) then
590
         Error.error [p] "the start symbol %s is undefined." nonterminal;
POTTIER Francois's avatar
POTTIER Francois committed
591
       if not (List.exists (function
592 593
                            | ParameterVar { value = id }, _ -> id = nonterminal
                            | _ -> false) grammar.p_types) then
594 595
         Error.error [p]
           "the type of the start symbol %s is unspecified." nonterminal;
596 597
    ) grammar.p_start_symbols;

598
  let parameter_head_symb = function
599 600 601 602
    | ParameterVar id -> id
    | ParameterApp (id, _) -> id
  in

603 604 605 606 607 608 609 610
  (* 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 ->
      let head_symb = parameter_head_symb p in
      if not (StringMap.mem (value head_symb) grammar.p_rules) then
611
        Error.error [Parameters.position p]
612
             "this should be a nonterminal symbol.\n\
613
              %s declarations are applicable only to nonterminal symbols." kind
614 615 616 617
    ) ps
  in
  check "%type" (List.map fst grammar.p_types);
  check "%on_error_reduce" grammar.p_on_error_reduce;
618 619 620 621

  (* 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
622
  let mark_token_as_used token =
623 624
    used_tokens := StringSet.add token !used_tokens
  in
POTTIER Francois's avatar
POTTIER Francois committed
625
  let check_identifier_reference grammar prule s p =
626 627 628
    (* 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
629

630
    if not (StringMap.mem s grammar.p_rules
631 632 633
           || StringMap.mem s grammar.p_tokens
           || List.mem s prule.pr_parameters
           || List.mem s reserved) then
634
      Error.error [ p ] "%s is undefined." s
635 636 637 638
  in
    StringMap.iter
      (fun k prule -> List.iter

639
         (* Check each branch. *)
POTTIER Francois's avatar
POTTIER Francois committed
640
         (fun { pr_producers = producers;
641 642
                pr_branch_prec_annotation;
              } -> ignore (List.fold_left
643

644
            (* Check the producers. *)
645
            (fun already_seen (id, p) ->
646 647
               let symbol, parameters = Parameters.unapp p in
               let s = symbol.value and p = symbol.position in
POTTIER Francois's avatar
POTTIER Francois committed
648
               let already_seen =
649 650 651
                 (* 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
652
                        "there are multiple producers named %s in this sequence."
653 654 655 656 657 658
                        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
659
                 StringMap.iter (check_identifier_reference grammar prule)
660 661 662
                   (List.fold_left Parameters.identifiers StringMap.empty parameters);

                 (* If this producer seems to be a reference to a token, make sure it
663 664
                    is a real token, as opposed to a pseudo-token introduced in a
                    priority declaration. *)
665
                 (try
666
                    if not ((StringMap.find s grammar.p_tokens).tk_is_declared
POTTIER Francois's avatar
POTTIER Francois committed
667
                           || List.mem s reserved) then
668 669 670 671
                      Error.errorp symbol
                        "%s has not been declared as a token." s
                  with Not_found -> ());
                 already_seen
672

673 674
            ) StringSet.empty producers);

675
            match pr_branch_prec_annotation with
676 677 678 679

              | None -> ()

              | Some terminal ->
POTTIER Francois's avatar
POTTIER Francois committed
680
                  check_identifier_reference grammar prule
681
                    terminal.value terminal.position;
682

683
                  (* Furthermore, the symbol following %prec must be a valid
POTTIER Francois's avatar
POTTIER Francois committed
684
                     token identifier. *)
685
                  if not (StringMap.mem terminal.value grammar.p_tokens) then
686 687
                    Error.errorp terminal
                      "%s is undefined." terminal.value)
688

689
         prule.pr_branches;
690

691
         (* It is forbidden to use %inline on a %start symbol. *)
POTTIER Francois's avatar
POTTIER Francois committed
692
         if (prule.pr_inline_flag
693
             && StringMap.mem k grammar.p_start_symbols) then
POTTIER Francois's avatar
POTTIER Francois committed
694
           Error.error prule.pr_positions
695
                "%s cannot be both a start symbol and inlined." k;
696 697

      ) grammar.p_rules;
POTTIER Francois's avatar
POTTIER Francois committed
698

699
  (* Check that every token is used. *)
700 701 702 703 704 705
  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
706
        StringMap.iter (fun token { tk_position = p } ->
707 708
          if not (StringSet.mem token !used_tokens
               || StringSet.mem token Settings.ignored_unused_tokens) then
POTTIER Francois's avatar
POTTIER Francois committed
709
            Error.warning [p]
710
              "the token %s is unused." token
711
        ) grammar.p_tokens
712
  end;
POTTIER Francois's avatar
POTTIER Francois committed
713

714 715 716 717 718 719
  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
720
  let rules = merge_rules symbols tpgs in
721
  check_parameterized_grammar_is_well_defined { grammar with p_rules = rules }