4 type node = State.t*TagSet.t*bool*Formula.t
5 include Hcons.Make(struct
7 let hash (s,ts,m,f) = HASHINT4(s,
8 Uid.to_int (TagSet.uid ts),
10 Uid.to_int (Formula.uid f)
12 let equal ((s,ts,m,f) as t) ((s',ts',m',f')as t') =
14 (s == s' && ts == ts' && m == m' && f == f')
17 let s1, l1, m1, f1 = node t1
18 and s2, l2, m2, f2 = node t2
20 let r = compare s1 s2 in
22 let r = TagSet.compare l1 l2 in
24 let r = compare m1 m2 in
29 let state, tagset , _, _ = node t in
30 fprintf ppf "(%a, %a)"
31 State.print state TagSet.print tagset
33 let print_arrow ppf t =
34 let _, _, mark, _ = node t in
36 (if mark then Pretty.double_right_arrow else Pretty.right_arrow)
39 let _, _, _, f = node t in
49 let b = Buffer.create 10 in
50 let fmt = formatter_of_buffer b in
51 fprintf fmt "@[%a@]@?" f x;
55 let lhs = make_str print_lhs t
56 and arrow = make_str print_arrow t
57 and rhs = make_str print_rhs t in
62 (fun (a_size, a_str) tr ->
63 let lhs, _, _ as str = str_trans tr in
64 let len = String.length lhs in
65 ((if len > a_size then len else a_size),
66 str::a_str)) (0, []) l
68 List.map (fun (lhs, arrow, rhs) ->
71 (Pretty.padding (size - Pretty.length lhs))
73 rhs) (List.rev strings)
77 let ( >< ) state (l,mark) = state,(l,mark,false)
78 let ( ><@ ) state (l,mark) = state,(l,mark,true)
79 let ( >=> ) (state,(label,mark,_bur)) form = (state,label,(make (state,label,mark,form)))