partialGrammar.ml 23.2 KB
Newer Older
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65
open Misc
open Syntax
open ConcreteSyntax
open InternalSyntax
open Positions
open Keyword

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

let join_declaration filename (grammar : grammar) decl = 
  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. *)

  | DCode code -> 
      { grammar with p_preludes = grammar.p_preludes @ [ code ] }
  | DParameter (Stretch.Declared stretch) -> 
      { 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) ->
      let token_property = 
	try

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

	  let token_property =
	    StringMap.find terminal grammar.p_tokens
	  in

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

	  if token_property.tk_is_declared then
	    Error.errorp decl
	      (Printf.sprintf "the token %s has multiple definitions." terminal)

	  (* Otherwise, update the previous definition. *)

	  else 
	    { token_property with 
	      tk_is_declared = true;
	      tk_ocamltype   = ocamltype;
	      tk_filename    = filename;
	      tk_position    = decl.position;
	    }

	with Not_found -> 

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

	  { 
	    tk_filename      = filename; 
	    tk_ocamltype     = ocamltype;
	    tk_associativity = UndefinedAssoc;
66
	    tk_precedence    = UndefinedPrecedence;
67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86
	    tk_position      = decl.position;
	    tk_is_declared   = true
	  } 

      in
      { grammar with
	p_tokens = StringMap.add terminal token_property grammar.p_tokens }

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

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

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

93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108
  (* Token associativity and precedence. *)

  | DTokenProperties (terminal, assoc, prec) ->

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

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

      (* Reject duplicate precedence declarations. *)

      if token_properties.tk_associativity <> UndefinedAssoc then 
	Error.error
	  [ decl.position; token_properties.tk_position ]
	  (Printf.sprintf "there are multiple precedence declarations for token %s." terminal);

      (* Record the new declaration. *)

127
      token_properties.tk_precedence <- prec;
128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248
      token_properties.tk_associativity <- assoc;
      grammar

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

let join_trailer trailer grammar = 
  match trailer with
  | None -> 
      grammar 
  | Some trailer -> 
      { 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

let identity_renaming = 
  [] 

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

let rewrite_parameter phi parameter = 
  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

let fresh_counter = ref 0 

let names = ref StringSet.empty

let use_name name = 
  names := StringSet.add name !names

let used_name name = 
  StringSet.mem name !names

let rec fresh ?(hint = "v") () = 
  let name = 
    incr fresh_counter;
    hint ^ string_of_int !fresh_counter
  in
    if used_name name then
      fresh ~hint ()
    else (
      use_name name;
      name
    )
      
(* Alpha conversion of [prule]. We rename bound parameters using
   fresh names. *)
let alphaconvert_rule parameters prule = 
  let phi = 
    List.combine parameters (List.map (fun x -> fresh ~hint:x ()) parameters)
  in
    { prule with
	pr_parameters  = List.map (Misc.support_assoc phi) prule.pr_parameters;
	pr_branches    = rewrite_branches phi prule.pr_branches
    }

(* Rewrite a rule taking bounded names into account. We rename parameters
   to avoid capture. *)
let rewrite_rule phi prule = 
  let ids = 
    List.fold_left (fun acu (f, d) -> StringSet.add f (StringSet.add d acu)) 
      StringSet.empty phi 
  in
  let captured_parameters = 
    List.filter (fun p -> StringSet.mem p ids) prule.pr_parameters
  in
  let prule = 
    alphaconvert_rule captured_parameters prule
  in
    { prule with
	pr_nt = rewrite_nonterminal phi prule.pr_nt;
	pr_branches = rewrite_branches phi prule.pr_branches }
      
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. *)
  if phi = identity_renaming then 
    grammar
  else 
    { 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
  | 'A' .. 'Z' 
  | 'a' .. 'z'
  | '_'
  | '\192' .. '\214'
  | '\216' .. '\246'
  | '\248' .. '\255'
  | '0' .. '9' ->
      true
  | _ ->
      false

let restrict filename =
249 250 251 252
  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 '_'
253
  done;
254
  Bytes.unsafe_to_string m
255 256 257 258 259 260 261 262 263 264 265 266

let rename nonterminal filename = 
  let name = restrict filename ^ "_" ^ nonterminal in
    if used_name name then
      fresh ~hint:name ()
    else 
      (use_name name; name)

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

267
(* TEMPORARY why unused?
268 269
let is_public grammar prule =
  prule.pr_public_flag || StringMap.mem prule.pr_nt grammar.p_start_symbols
270
*)
271 272 273 274 275 276 277 278 279 280 281 282
(* ------------------------------------------------------------------------- *)
type symbol_kind =
    
  (* 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

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

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

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

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

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

305
let store_symbol (symbols : symbol_table) symbol kind = 
306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368
  try
    let sym_info = find_symbol symbols symbol in
      match sym_info, kind with
	  
	(* There are two definitions of the same symbol in one
	   particular unit. This is forbidden. *)
	| (PublicNonTerminal p | PrivateNonTerminal p),
	  (PublicNonTerminal p' | PrivateNonTerminal p') ->
	    Error.error [ p; p'] 
	      (Printf.sprintf 
		 "the nonterminal symbol %s is multiply defined."
		 symbol)

	(* The symbol is known to be a token but declared as a non terminal.*)
	| (Token tkp, (PrivateNonTerminal p | PublicNonTerminal p)) 
	| ((PrivateNonTerminal p | PublicNonTerminal p), Token tkp) ->
	    Error.error [ p; tkp.tk_position ]
	      (Printf.sprintf 
		 "The identifier %s is a reference to a token."
		 symbol)

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

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

  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)

let non_terminal_is_not_reserved symbol positions = 
  if symbol = "error" then
    Error.error positions
      (Printf.sprintf "%s is reserved and thus cannot be used \
                       as a non-terminal symbol." symbol)

let non_terminal_is_not_a_token tokens symbol positions = 
  try
    let tkp = StringMap.find symbol tokens in
      Error.error (positions @ [ tkp.tk_position ])
      (Printf.sprintf 
	 "The identifier %s is a reference to a token."
	 symbol)
  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))
      
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))

369 370
(* for debugging, presumably:

371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395
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)

let string_of_symbol_table t = 
  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
    Hashtbl.iter (fun k v -> Buffer.add_string b 
		    (Printf.sprintf "%s: %s\n" 
		       (fill_blank k) (string_of_kind v))) t;
    Buffer.contents b
396
*)
397 398 399 400 401 402 403 404 405 406 407 408

let is_private_symbol t x = 
  try
    match Hashtbl.find t x with
      | PrivateNonTerminal _ ->
	  true
	    
      | _ ->
	  false
  with Not_found -> 
    false

409
(* TEMPORARY why unused?
410 411 412 413 414 415 416 417 418 419
let is_public_symbol t x = 
  try
    match Hashtbl.find t x with
      | PublicNonTerminal _ ->
	  true
	    
      | _ ->
	  false
  with Not_found -> 
    false
420
*)
421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478

let fold_on_private_symbols f init t = 
  Hashtbl.fold 
    (fun k -> function PrivateNonTerminal _ -> (fun acu -> f acu k)
       | _ -> (fun acu -> acu))
    t init

let fold_on_public_symbols f init t = 
  Hashtbl.fold 
    (fun k -> function PublicNonTerminal _ -> (fun acu -> f acu k)
       | _ -> (fun acu -> acu))
    t init

let iter_on_only_used_symbols f t = 
  Hashtbl.iter 
    (fun k -> function DontKnow pos -> f k pos
       | _ -> ())
    t 

let symbols_of grammar (pgrammar : ConcreteSyntax.grammar) = 
  let tokens = grammar.p_tokens in
  let symbols_of_rule symbols prule = 
    let rec store_except_rule_parameters = 
      fun symbols (symbol, parameters) ->
	(* Rule parameters are bound locally, so they are not taken into
	   account. *)
	if List.mem symbol.value prule.pr_parameters then
	  symbols
	else 
	  (* Otherwise, mark this symbol as being used and analyse its
	     parameters. *)
	  List.fold_left 
	    (fun symbols -> function 
	       | ParameterApp (symbol, parameters) -> 
		   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
    in
      
    (* Analyse each branch. *)
    let symbols = List.fold_left (fun symbols branch ->
      List.fold_left (fun symbols (_, p) -> 
	let symbol, parameters = Parameters.unapp p in
	store_except_rule_parameters symbols (symbol, parameters)
      ) symbols branch.pr_producers
    ) symbols prule.pr_branches
    in
      (* Store the symbol declaration. *)
      if prule.pr_public_flag 
	|| StringMap.mem prule.pr_nt grammar.p_start_symbols then 
	store_public_nonterminal tokens symbols prule.pr_nt prule.pr_positions
      else
	store_private_nonterminal tokens symbols prule.pr_nt prule.pr_positions
  in
    List.fold_left symbols_of_rule (empty_symbol_table ()) pgrammar.pg_rules

479
let merge_rules symbols pgs = 
480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507

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

  (* We check the references in each grammar can be bound to 
     a public symbol. *)
  let _ = 
    List.iter 
      (iter_on_only_used_symbols 
	 (fun k pos -> if not (StringSet.mem k public_symbols) then
	    Error.error [ pos ]
	      (Printf.sprintf "%s is undefined." k)))
      symbols
  in
  (* Detect private symbol clashes and rename them if necessary. *)
  let detect_private_symbol_clashes = 
    fold_on_private_symbols 
      (fun (defined, clashes) symbol ->
	 if StringSet.mem symbol defined 
	   || StringSet.mem symbol public_symbols then
	   (defined, StringSet.add symbol clashes)
	 else 
	   (StringSet.add symbol defined, clashes))
  in 
508
  let _private_symbols, clashes = 
509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579
    List.fold_left detect_private_symbol_clashes (StringSet.empty, StringSet.empty) symbols
  in 
  let rpgs = List.map 
    (fun (symbol_table, pg) ->
       let renaming = 
	 StringSet.fold 
	   (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)
	   clashes []    
       in
	 rewrite_grammar renaming pg)
    pgs
  in
    
    (* Merge public nonterminal definitions 
       and copy private nonterminal definitions. Since the clash between
       private symbols have already been resolved, these copies are safe. *)
    List.fold_left 
      (fun rules rpg -> List.fold_left 
	 (fun rules r -> 
	    let r = 
	      try
		let r' = StringMap.find r.pr_nt rules in
		let positions = r.pr_positions @ r'.pr_positions in
		let ra, ra' = 
		  List.length r.pr_parameters, 
		  List.length r'.pr_parameters 		  
		in
		  (* The arity of the parameterized symbols must be constant.*)
		  if ra <> ra' then 
		    Error.error positions 
		      (Printf.sprintf "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
		      (Printf.sprintf 
			 "not all definitions of %s are marked %%inline." r.pr_nt)
		  else 
		    (* We combine the different branches. The parameters 
		       could have different names, we rename them with
		       the fresh names assigned earlier (see the next 
		       comment). *)
		    let phi = List.combine r.pr_parameters r'.pr_parameters in
		    let rbr = rewrite_branches phi r.pr_branches in
		      { r' with 
			  pr_positions = positions;
			  pr_branches  = rbr @ r'.pr_branches 
		      } 
	      with Not_found ->
		(* We alphaconvert the rule in order to avoid the capture of 
		   private symbols coming from another unit. *)
		alphaconvert_rule r.pr_parameters r
	    in
	      StringMap.add r.pr_nt r rules) rules rpg.pg_rules)
      StringMap.empty rpgs

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

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

589
(* Check that there are not two symbols carrying the same name. *)
590

591
let check_keywords producers action =
592 593 594 595 596 597 598 599 600 601 602 603 604 605
  List.iter (fun keyword ->
    match Positions.value keyword with
      | Position (RightNamed id, _, _) ->
	let found = ref false in
	List.iter (fun (ido, _) ->
	  if ido.value = id then found := true
	) producers;
	if not !found then
	  Error.errorp keyword
	    (Printf.sprintf "%s refers to a nonexistent symbol." id)
      | Position (Left, _, _)
      | SyntaxError ->
	()
  ) (Action.pkeywords action)
606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622

let check_parameterized_grammar_is_well_defined grammar =

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

623
  let parameter_head_symb = function
624 625 626 627
    | ParameterVar id -> id
    | ParameterApp (id, _) -> id
  in

628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643
  (* 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
        Error.errorp (Parameters.with_pos p)
          (Printf.sprintf
             "this should be a nonterminal symbol.\n\
              %s declarations are applicable only to nonterminal symbols." kind)
    ) ps
  in
  check "%type" (List.map fst grammar.p_types);
  check "%on_error_reduce" grammar.p_on_error_reduce;
644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666

  (* Every reference to a symbol is well defined. *)
  let reserved = [ "error" ] in
  let used_tokens = ref StringSet.empty in
  let mark_token_as_used token = 
    used_tokens := StringSet.add token !used_tokens
  in
  let check_identifier_reference grammar prule s p = 
    (* 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;
    
    if not (StringMap.mem s grammar.p_rules
	   || StringMap.mem s grammar.p_tokens
	   || List.mem s prule.pr_parameters
	   || List.mem s reserved) then
      Error.error [ p ] (Printf.sprintf "%s is undefined." s)
  in
    StringMap.iter
      (fun k prule -> List.iter

	 (* Check each branch. *)
	 (fun { pr_producers = producers; 
667 668 669
	        pr_branch_prec_annotation;
	        pr_action = action 
	      } -> ignore (List.fold_left
670

671 672 673 674 675
	    (* Check the producers. *)
            (fun already_seen (id, p) ->
	       let symbol, parameters = Parameters.unapp p in
	       let s = symbol.value and p = symbol.position in
	       let already_seen = 
676 677 678 679 680 681 682
		 (* Check the producer id is unique. *)
		 if StringSet.mem id.value already_seen then
		   Error.error [ id.position ]
		     (Printf.sprintf
			"there are multiple producers named %s in this sequence." 
			id.value);
		 StringSet.add id.value already_seen
683 684 685 686 687 688
	       in

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

690 691 692
		 (* If this producer seems to be a reference to a token, make sure it
                    is a real token, as opposed to a pseudo-token introduced in a
                    priority declaration. *)
693 694 695 696 697 698 699
		 (try
                    if not ((StringMap.find s grammar.p_tokens).tk_is_declared
                           || List.mem s reserved) then 
		      Error.errorp symbol
			(Printf.sprintf "%s has not been declared as a token." s)
		  with Not_found -> ());
		 already_seen
700

701 702
            ) StringSet.empty producers);

703
	    check_keywords producers action;
704

705
            match pr_branch_prec_annotation with
706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735

              | None -> ()

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

		  (* It is forbidden to use the %prec directive with %inline. *)
		  if prule.pr_inline_flag then
		    Error.errorp terminal
		      "use of %prec is forbidden in an %inlined nonterminal definition.";

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

	 prule.pr_branches;

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

      ) grammar.p_rules;
    
  (* Check that every token is used. *)
736 737 738 739 740 741 742 743 744 745 746 747
  if not Settings.ignore_all_unused_tokens then begin
    match Settings.token_type_mode with
    | Settings.TokenTypeOnly ->
        ()
    | Settings.TokenTypeAndCode
    | Settings.CodeOnly _ ->
        StringMap.iter (fun token { tk_position = p } -> 
          if not (StringSet.mem token !used_tokens
               || StringSet.mem token Settings.ignored_unused_tokens) then
            Error.warning [p] 
              (Printf.sprintf "the token %s is unused." token)
        ) grammar.p_tokens
748 749 750 751 752 753 754 755
  end;
    
  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
756
  let rules = merge_rules symbols tpgs in 
757
  check_parameterized_grammar_is_well_defined { grammar with p_rules = rules }