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
66
67
68
69
70
71
72
73
74
75
76
77
78
79
|
(**************************************************************************)
(* *)
(* Menhir *)
(* *)
(* Franois Pottier and Yann Rgis-Gianas, INRIA Rocquencourt *)
(* *)
(* Copyright 2005 Institut National de Recherche en Informatique et *)
(* en Automatique. All rights reserved. This file is distributed *)
(* under the terms of the Q Public License version 1.0, with the *)
(* change described in file LICENSE. *)
(* *)
(**************************************************************************)
open Positions
open Syntax
let current_token_precedence =
let c = ref 0 in
fun pos1 pos2 ->
incr c;
PrecedenceLevel (Error.get_filemark (), !c, pos1, pos2)
let current_reduce_precedence =
let c = ref 0 in
fun () ->
incr c;
PrecedenceLevel (Error.get_filemark (), !c, Lexing.dummy_pos, Lexing.dummy_pos)
module IdSet = Set.Make (struct
type t = identifier located
let compare id1 id2 =
compare (value id1) (value id2)
end)
let defined_identifiers ((ido, _) : producer) accu =
Option.fold IdSet.add ido accu
let defined_identifiers (producers : producer list) =
List.fold_right defined_identifiers producers IdSet.empty
let check_production_group right_hand_sides pos1 pos2 action =
begin
match right_hand_sides with
| [] ->
assert false
| ((producers : producer list), _, _, _) :: right_hand_sides ->
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.errorp id
"Two productions that share a semantic action must define\n\
exactly the same identifiers."
with Not_found ->
()
) right_hand_sides
end;
begin
if List.length right_hand_sides > 1 && Action.use_dollar action then
Error.signal pos1 pos2
"A semantic action that is shared between several productions must\n\
not use the $i notation -- semantic values must be named instead."
end
let override pos o1 o2 =
match o1, o2 with
| Some _, Some _ ->
Error.signalN [ pos ] "This production carries two %prec declarations.";
o2
| None, Some _ ->
o2
| _, None ->
o1
|
