-
Notifications
You must be signed in to change notification settings - Fork 5
/
Tools.ml
85 lines (72 loc) · 3.01 KB
/
Tools.ml
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
80
81
82
83
84
open LibUtil;
open Structure;
let empty_entry ename _ =
raise (Stream.Error ("entry [" ^ ename ^ "] is empty"));
let keep_prev_loc strm = match Stream.peek strm with
[ None -> [< >]
| Some (_tok0,init_loc) ->
let rec go prev_loc strm1 = match strm1 with parser
[ [< (tok,cur_loc); 'strm >] ->
[< (tok, {prev_loc; cur_loc; prev_loc_only = False});
'go cur_loc strm >]
| [< >] -> [< >] ] in
go init_loc strm ];
let drop_prev_loc strm = Stream.map (fun (tok,r) -> (tok,r.cur_loc)) strm;
let get_cur_loc strm = match Stream.peek strm with
[ Some (_,r) -> r.cur_loc
| None -> FanLoc.ghost ];
let get_prev_loc strm = begin
let result = match Stream.peek strm with
[ Some (_, {prev_loc; prev_loc_only = True; _}) ->
begin Stream.junk strm; prev_loc end
| Some (_, {prev_loc; prev_loc_only = False;_}) -> prev_loc
| None -> FanLoc.ghost ];
result
end;
let is_level_labelled n = fun [ {lname=Some n1; _ } -> n = n1 | _ -> False ];
let warning_verbose = ref True;
let rec get_token_list entry tokl last_tok = fun
[ Node {node = (`Stoken _ | `Skeyword _ as tok); son = son; brother = DeadEnd} ->
get_token_list entry [last_tok :: tokl] tok son
| tree ->
if tokl = [] then None
else Some (List.rev [last_tok :: tokl], last_tok, tree) ];
let eq_Stoken_ids s1 s2 = match (s1,s2) with
[ ((`Antiquot,_),_) -> False
| (_,(`Antiquot,_)) -> False
| ((_,s1),(_,s2)) -> s1 = s2];
let logically_eq_symbols entry =
let rec eq_symbols s1 s2 = match (s1, s2) with
[ (`Snterm e1, `Snterm e2) -> e1.ename = e2.ename
| (`Snterm e1, `Sself) -> e1.ename = entry.ename
| (`Sself, `Snterm e2) -> entry.ename = e2.ename
| (`Snterml (e1, l1), `Snterml (e2, l2)) -> e1.ename = e2.ename && l1 = l2
| (`Slist0 s1, `Slist0 s2) |
(`Slist1 s1, `Slist1 s2) |
(`Sopt s1, `Sopt s2) |
(`Stry s1, `Stry s2) -> eq_symbols s1 s2
| (`Slist0sep (s1, sep1), `Slist0sep (s2, sep2)) |
(`Slist1sep (s1, sep1), `Slist1sep (s2, sep2)) ->
eq_symbols s1 s2 && eq_symbols sep1 sep2
| (`Stree t1, `Stree t2) -> eq_trees t1 t2
| (`Stoken (_, s1), `Stoken (_, s2)) -> eq_Stoken_ids s1 s2
| _ -> s1 = s2 ]
and eq_trees t1 t2 = match (t1, t2) with
[ (Node n1, Node n2) ->
eq_symbols n1.node n2.node && eq_trees n1.son n2.son &&
eq_trees n1.brother n2.brother
| (LocAct _ _ | DeadEnd, LocAct _ _ | DeadEnd) -> True
| _ -> False ] in eq_symbols;
let rec eq_symbol s1 s2 = match (s1, s2) with
[ (`Snterm e1, `Snterm e2) -> e1 == e2
| (`Snterml (e1, l1), `Snterml (e2, l2)) -> e1 == e2 && l1 = l2
| (`Slist0 s1, `Slist0 s2) |
(`Slist1 s1, `Slist1 s2) |
(`Sopt s1, `Sopt s2) |
(`Stry s1, `Stry s2) -> eq_symbol s1 s2
| (`Slist0sep (s1, sep1), `Slist0sep (s2, sep2)) |
(`Slist1sep (s1, sep1), `Slist1sep (s2, sep2)) ->
eq_symbol s1 s2 && eq_symbol sep1 sep2
| (`Stree _, `Stree _) -> False
| (`Stoken (_, s1), `Stoken (_, s2)) -> eq_Stoken_ids s1 s2
| _ -> s1 = s2 ];