13 | OP_LEFT2 of State.t * State.t
14 | OP_RIGHT1 of State.t
15 | OP_RIGHT2 of State.t * State.t
16 | OP_LEFT1_RIGHT1 of State.t * State.t
17 | OP_LEFT2_RIGHT1 of State.t * State.t * State.t
18 | OP_LEFT1_RIGHT2 of State.t * State.t * State.t
19 | OP_LEFT2_RIGHT2 of State.t * State.t * State.t * State.t
21 | OP_SELF_LEFT1 of State.t
22 | OP_SELF_LEFT2 of State.t * State.t
23 | OP_SELF_RIGHT1 of State.t
24 | OP_SELF_RIGHT2 of State.t * State.t
25 | OP_SELF_LEFT1_RIGHT1 of State.t * State.t
26 | OP_SELF_LEFT2_RIGHT1 of State.t * State.t * State.t
27 | OP_SELF_LEFT1_RIGHT2 of State.t * State.t * State.t
28 | OP_SELF_LEFT2_RIGHT2 of State.t * State.t * State.t * State.t
29 | OP_OTHER of instr array
31 type code = Nil | Cons of State.t * opcode * code
36 | Cons(_, _, t) -> 1 + length t
38 fprintf fmt "length of code is %i\n%!" (length l)
41 let print_instr fmt i =
43 | SELF _ -> fprintf fmt "SELF"
44 | LEFT q -> fprintf fmt "LEFT{%a}" State.print q
45 | RIGHT q -> fprintf fmt "RIGHT{%a}" State.print q
47 let print_opcode fmt code =
49 | OP_NOP _ -> fprintf fmt "OP_NOP"
52 fprintf fmt "OP_LEFT1{%a}" State.print src
54 | OP_LEFT2 (src1, src2) ->
55 fprintf fmt "OP_LEFT2{%a, %a}" State.print src1 State.print src2
58 fprintf fmt "OP_RIGHT1{%a}" State.print src
60 | OP_RIGHT2 (src1, src2) ->
61 fprintf fmt "OP_RIGHT2{%a, %a}" State.print src1 State.print src2
63 | OP_LEFT1_RIGHT1 (src1, src2) ->
64 fprintf fmt "OP_LEFT1_RIGHT1{%a}{%a}" State.print src1 State.print src2
66 | OP_LEFT2_RIGHT1 (src1, src2, src3) ->
67 fprintf fmt "OP_LEFT2_RIGHT1{%a, %a}{%a}"
68 State.print src1 State.print src2 State.print src3
70 | OP_LEFT1_RIGHT2 (src1, src2, src3) ->
71 fprintf fmt "OP_LEFT1_RIGHT2{%a}{%a, %a}"
72 State.print src1 State.print src2 State.print src3
74 | OP_LEFT2_RIGHT2 (src1, src2, src3, src4) ->
75 fprintf fmt "OP_LEFT2_RIGHT2{%a, %a}{%a, %a}"
76 State.print src1 State.print src2 State.print src3 State.print src4
81 | OP_SELF_LEFT1 src ->
82 fprintf fmt "OP_SELF_LEFT1{%a}" State.print src
84 | OP_SELF_LEFT2 (src1, src2) ->
85 fprintf fmt "OP_SELF_LEFT2{%a, %a}" State.print src1 State.print src2
87 | OP_SELF_RIGHT1 src ->
88 fprintf fmt "OP_SELF_RIGHT1{%a}" State.print src
90 | OP_SELF_RIGHT2 (src1, src2) ->
91 fprintf fmt "OP_SELF_RIGHT2{%a, %a}" State.print src1 State.print src2
93 | OP_SELF_LEFT1_RIGHT1 (src1, src2) ->
94 fprintf fmt "OP_SELF_LEFT1_RIGHT1{%a}{%a}" State.print src1 State.print src2
96 | OP_SELF_LEFT2_RIGHT1 (src1, src2, src3) ->
97 fprintf fmt "OP_SELF_LEFT2_RIGHT1{%a, %a}{%a}"
98 State.print src1 State.print src2 State.print src3
100 | OP_SELF_LEFT1_RIGHT2 (src1, src2, src3) ->
101 fprintf fmt "OP_SELF_LEFT1_RIGHT2{%a}{%a, %a}"
102 State.print src1 State.print src2 State.print src3
104 | OP_SELF_LEFT2_RIGHT2 (src1, src2, src3, src4) ->
105 fprintf fmt "OP_SELF_LEFT2_RIGHT2{%a, %a}{%a, %a}"
106 State.print src1 State.print src2 State.print src3 State.print src4
108 fprintf fmt "OP_OTHER: ";
109 Array.iter (fun i -> print_instr fmt i; fprintf fmt " ") line
111 let merge_rev equal choose l =
117 let j = List.hd acc in
118 if equal i j then (choose i j)::(List.tl acc)
121 let compile_instr_list l =
122 let linstr = merge_rev (=) (fun i _ -> i) (List.sort (fun x y -> compare y x) l) in
125 | [ LEFT q ] -> OP_LEFT1 q
126 | [ LEFT q1; LEFT q2 ] -> OP_LEFT2(q2, q1)
127 | [ RIGHT q ] -> OP_RIGHT1 q
128 | [ RIGHT q1; RIGHT q2 ] -> OP_RIGHT2(q2, q1)
129 | [ LEFT q1; RIGHT q2 ] -> OP_LEFT1_RIGHT1(q1, q2)
130 | [ LEFT q1; LEFT q2; RIGHT q3 ] -> OP_LEFT2_RIGHT1 (q2, q1, q3)
131 | [ LEFT q1; RIGHT q2; RIGHT q3 ] -> OP_LEFT1_RIGHT2 (q1, q3, q2)
132 | [ LEFT q1; LEFT q2; RIGHT q3; RIGHT q4 ] -> OP_LEFT2_RIGHT2 (q2, q1, q4, q3)
133 | [ SELF () ] -> OP_SELF()
135 | [ SELF _; LEFT q ] -> OP_SELF_LEFT1 q
136 | [ SELF _; LEFT q1; LEFT q2 ] -> OP_SELF_LEFT2(q2, q1)
137 | [ SELF _; RIGHT q ] -> OP_SELF_RIGHT1 q
138 | [ SELF _; RIGHT q1; RIGHT q2 ] -> OP_SELF_RIGHT2(q2, q1)
139 | [ SELF _; LEFT q1; RIGHT q2 ] -> OP_SELF_LEFT1_RIGHT1(q1, q2)
140 | [ SELF _; LEFT q1; LEFT q2; RIGHT q3 ] -> OP_SELF_LEFT2_RIGHT1 (q2, q1, q3)
141 | [ SELF _; LEFT q1; RIGHT q2; RIGHT q3 ] -> OP_SELF_LEFT1_RIGHT2 (q1, q3, q2)
142 | [ SELF _; LEFT q1; LEFT q2; RIGHT q3; RIGHT q4 ] ->
143 OP_SELF_LEFT2_RIGHT2 (q2, q1, q4, q3)
144 | i -> OP_OTHER (Array.of_list i)
151 | (a, b)::ll -> loop ll (Cons(a,b, acc))
155 let rec filter_uniq statel stater l =
161 (fun ((a_il, al, ar)as acc) i ->
164 if List.mem q al then acc
165 else (i :: a_il, q::al, ar)
167 if List.mem q ar then acc
168 else (i :: a_il, al, q :: ar)
169 | _ -> (i :: a_il, al, ar)) ([], statel, stater) il
171 (s, nil) :: (filter_uniq nsl nsr ll)
174 let l = List.sort (fun (s1, _) (s2, _) -> compare s1 s2) l in
175 let l = filter_uniq [] [] l in
177 (fun (s1, _) (s2, _) -> s1 = s2)
178 (fun (s1, i1) (_, i2) -> (s1, i1@i2)) l
182 (fun (_, l) -> List.exists (function SELF _ -> true | _ -> false) l)
185 let l = List.map (fun (s, il) -> (s, compile_instr_list il)) l in
186 let l = List.filter (fun (_, instr) -> instr <> OP_NOP ()) l in
187 to_list l, not marking
192 let () = at_exit (fun () -> Printf.eprintf "Dummy affectations %i/%i\n%!" !_empty !_total)
196 DEFINE SET(a, b) = a <- b
198 DEFINE EXEC_INSTR_TEMPLATE(ns) = fun slot1 slot2 t inst acc ->
200 | SELF _ -> ns.snoc acc t
201 | LEFT src -> ns.concat acc slot1.(src)
202 | RIGHT src -> ns.concat acc slot2.(src)
205 DEFINE EXEC_CODE_TEMPLATE(ns) = fun slot slot1 slot2 t dst code ->
210 if slot != slot1 then SET(slot.(dst), slot1.(src))
212 | OP_LEFT2 (src1, src2) ->
213 SET(slot.(dst) , ns.concat slot1.(src1) slot1.(src2))
215 | OP_RIGHT1 src -> if slot != slot2 then SET(slot.(dst) , slot2.(src))
217 | OP_RIGHT2 (src1, src2) ->
218 SET (slot.(dst) , ns.concat slot2.(src1) slot2.(src2) )
220 | OP_LEFT1_RIGHT1 (src1, src2) ->
221 SET (slot.(dst) , ns.concat slot1.(src1) slot2.(src2))
223 | OP_LEFT2_RIGHT1 (src1, src2, src3) ->
224 SET (slot.(dst) , ns.concat3 slot1.(src1) slot1.(src2) slot2.(src3))
226 | OP_LEFT1_RIGHT2 (src1, src2, src3) ->
227 SET (slot.(dst) , ns.concat3 slot1.(src1) slot2.(src2) slot2.(src3))
229 | OP_LEFT2_RIGHT2 (src1, src2, src3, src4) ->
230 SET (slot.(dst) , ns.concat4 slot1.(src1) slot1.(src2) slot2.(src3) slot2.(src4))
233 slot.(dst) <- ns.singleton t
235 | OP_SELF_LEFT1 src -> slot.(dst) <- ns.cons t slot1.(src)
237 | OP_SELF_LEFT2 (src1, src2) ->
238 slot.(dst) <- ns.conscat t slot1.(src1) slot1.(src2)
240 | OP_SELF_RIGHT1 src -> slot.(dst) <- ns.cons t slot2.(src)
242 | OP_SELF_RIGHT2 (src1, src2) ->
243 slot.(dst) <- ns.conscat t slot2.(src1) slot2.(src2)
245 | OP_SELF_LEFT1_RIGHT1 (src1, src2) ->
246 slot.(dst) <- ns.conscat t slot1.(src1) slot2.(src2)
248 | OP_SELF_LEFT2_RIGHT1 (src1, src2, src3) ->
249 slot.(dst) <- ns.conscat3 t slot1.(src1) slot1.(src2) slot2.(src3)
251 | OP_SELF_LEFT1_RIGHT2 (src1, src2, src3) ->
252 slot.(dst) <- ns.conscat3 t slot1.(src1) slot2.(src2) slot2.(src3)
254 | OP_SELF_LEFT2_RIGHT2 (src1, src2, src3, src4) ->
256 ns.conscat4 t slot1.(src1) slot1.(src2) slot2.(src3) slot2.(src4)
258 let acc = ref ns.empty in
259 let len = Array.length line - 1 in
261 acc := exec_instr slot1 slot2 t line.(j) !acc
268 module NS : NodeSet.S
270 val exec : t -> t -> t -> Tree.node -> code -> unit
277 module NS = NodeSet.Count
278 type t = NodeSet.Count.t array
280 let exec_instr = EXEC_INSTR_TEMPLATE(NodeSet.Count)
281 let exec_code = EXEC_CODE_TEMPLATE(NodeSet.Count)
282 (* inline by hand for efficiency reason *)
283 let rec exec slot slot1 slot2 t code =
286 | Cons(dst, code, code1) ->
287 exec_code slot slot1 slot2 t dst code;
291 | Cons(dst, code, code1) ->
292 exec_code slot slot1 slot2 t dst code;
293 exec slot slot1 slot2 t code1
299 module NS = NodeSet.Mat
300 type t = NodeSet.Mat.t array
302 let exec_instr = EXEC_INSTR_TEMPLATE(NodeSet.Mat)
303 let exec_code = EXEC_CODE_TEMPLATE(NodeSet.Mat)
304 (* inline by hand for efficiency reason *)
305 let rec exec slot slot1 slot2 t code =
308 | Cons(dst, code, code1) ->
309 exec_code slot slot1 slot2 t dst code;
313 | Cons(dst, code, code1) ->
314 exec_code slot slot1 slot2 t dst code;
315 exec slot slot1 slot2 t code1