partialGrammar.ml 23.7 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 201 202
    }

(* Rewrite a rule taking bounded names into account. We rename parameters
   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 437
  let symbols_of_rule symbols prule =
    let rec store_except_rule_parameters =
438
      fun symbols (symbol, parameters) ->
439 440 441 442
        (* 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
443
        else
444 445
          (* Otherwise, mark this symbol as being used and analyse its
             parameters. *)
POTTIER Francois's avatar
POTTIER Francois committed
446 447 448
          List.fold_left
            (fun symbols -> function
               | ParameterApp (symbol, parameters) ->
449 450 451 452 453
                   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
454
    in
POTTIER Francois's avatar
POTTIER Francois committed
455

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

POTTIER Francois's avatar
POTTIER Francois committed
473
let merge_rules symbols pgs =
474 475 476

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

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

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

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

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

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

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

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

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

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

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

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

671 672
            ) StringSet.empty producers);

673
            match pr_branch_prec_annotation with
674 675 676 677

              | None -> ()

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

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

687
         prule.pr_branches;
688

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

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

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

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