parserAux.ml 2.47 KB
Newer Older
1 2 3
open Positions
open Syntax

4
let new_precedence_level =
5 6 7
  let c = ref 0 in
  fun pos1 pos2 ->
    incr c;
8
    PrecedenceLevel (InputFile.get_input_file (), !c, pos1, pos2)
9

10
let new_production_level =
11 12 13
  let c = ref 0 in
  fun () ->
    incr c;
14
    ProductionLevel (InputFile.get_input_file (), !c)
15

16 17 18 19 20
let new_on_error_reduce_level =
  new_production_level
    (* the counter is shared with [new_production_level],
       but this is irrelevant *)

21 22 23 24 25 26
module IdSet = Set.Make (struct
  type t = identifier located
  let compare id1 id2 =
    compare (value id1) (value id2)
end)

27
let defined_identifiers (_, ido, _) accu =
28 29
  Option.fold IdSet.add ido accu

30
let defined_identifiers producers =
31 32
  List.fold_right defined_identifiers producers IdSet.empty

33
let check_production_group right_hand_sides =
34 35 36
  begin
    match right_hand_sides with
    | [] ->
37
        assert false
38
    | (producers, _, _, _) :: right_hand_sides ->
39 40 41 42 43 44 45 46 47 48 49 50 51 52 53
        let ids = defined_identifiers producers in
        List.iter (fun (producers, _, _, _) ->
          let ids' = defined_identifiers producers in
          try
            let id =
              IdSet.choose (IdSet.union
                                  (IdSet.diff ids ids')
                                  (IdSet.diff ids' ids))
            in
            Error.error [Positions.position id]
              "two productions that share a semantic action must define\n\
               exactly the same identifiers."
          with Not_found ->
            ()
          ) right_hand_sides
54
  end
55

Yann Régis-Gianas's avatar
Yann Régis-Gianas committed
56 57
(* [normalize_producer i p] assigns a name of the form [_i]
   to the unnamed producer [p]. *)
58 59 60 61 62 63 64 65
let normalize_producer i (pos, opt_identifier, parameter) =
  let id =
    match opt_identifier with
      | Some id -> id
      | None -> Positions.with_pos pos ("_" ^ string_of_int (i + 1))
  in
  (id, parameter)

66 67
let normalize_producers producers =
  List.mapi normalize_producer producers
68 69 70 71

let override pos o1 o2 =
  match o1, o2 with
  | Some _, Some _ ->
72
      Error.signal [ pos ] "this production carries two %%prec declarations.";
73 74 75 76 77
      o2
  | None, Some _ ->
      o2
  | _, None ->
      o1
78

79
(* Only unnamed producers can be referred to using positional identifiers.
80 81
   Besides, such positions must be taken in the interval [1
   .. List.length producers]. The output array [p] is such that
82
   [p.(idx) = Some x] if [idx] must be referred to using [x], not
83 84
   [$(idx + 1)]. *)
let producer_names producers =
85 86 87
  producers
  |> List.map (fun (_, oid, _) -> Option.map Positions.value oid)
  |> Array.of_list