15 | OP_LEFT2 of State.t * State.t
16 | OP_RIGHT1 of State.t
17 | OP_RIGHT2 of State.t * State.t
18 | OP_LEFT1_RIGHT1 of State.t * State.t
19 | OP_LEFT2_RIGHT1 of State.t * State.t * State.t
20 | OP_LEFT1_RIGHT2 of State.t * State.t * State.t
21 | OP_LEFT2_RIGHT2 of State.t * State.t * State.t * State.t
23 | OP_SELF_LEFT1 of State.t
24 | OP_SELF_LEFT2 of State.t * State.t
25 | OP_SELF_RIGHT1 of State.t
26 | OP_SELF_RIGHT2 of State.t * State.t
27 | OP_SELF_LEFT1_RIGHT1 of State.t * State.t
28 | OP_SELF_LEFT2_RIGHT1 of State.t * State.t * State.t
29 | OP_SELF_LEFT1_RIGHT2 of State.t * State.t * State.t
30 | OP_SELF_LEFT2_RIGHT2 of State.t * State.t * State.t * State.t
31 | OP_OTHER of instr array
33 type code = Nil | Cons of State.t * opcode * code
38 | Cons(_, _, t) -> 1 + length t
40 fprintf fmt "length of code is %i\n%!" (length l)
43 let print_instr fmt i =
45 | SELF _ -> fprintf fmt "SELF"
46 | LEFT q -> fprintf fmt "LEFT{%a}" State.print q
47 | RIGHT q -> fprintf fmt "RIGHT{%a}" State.print q
49 let print_opcode fmt code =
51 | OP_NOP _ -> fprintf fmt "OP_NOP"
54 fprintf fmt "OP_LEFT1{%a}" State.print src
56 | OP_LEFT2 (src1, src2) ->
57 fprintf fmt "OP_LEFT2{%a, %a}" State.print src1 State.print src2
60 fprintf fmt "OP_RIGHT1{%a}" State.print src
62 | OP_RIGHT2 (src1, src2) ->
63 fprintf fmt "OP_RIGHT2{%a, %a}" State.print src1 State.print src2
65 | OP_LEFT1_RIGHT1 (src1, src2) ->
66 fprintf fmt "OP_LEFT1_RIGHT1{%a}{%a}" State.print src1 State.print src2
68 | OP_LEFT2_RIGHT1 (src1, src2, src3) ->
69 fprintf fmt "OP_LEFT2_RIGHT1{%a, %a}{%a}"
70 State.print src1 State.print src2 State.print src3
72 | OP_LEFT1_RIGHT2 (src1, src2, src3) ->
73 fprintf fmt "OP_LEFT1_RIGHT2{%a}{%a, %a}"
74 State.print src1 State.print src2 State.print src3
76 | OP_LEFT2_RIGHT2 (src1, src2, src3, src4) ->
77 fprintf fmt "OP_LEFT2_RIGHT2{%a, %a}{%a, %a}"
78 State.print src1 State.print src2 State.print src3 State.print src4
83 | OP_SELF_LEFT1 src ->
84 fprintf fmt "OP_SELF_LEFT1{%a}" State.print src
86 | OP_SELF_LEFT2 (src1, src2) ->
87 fprintf fmt "OP_SELF_LEFT2{%a, %a}" State.print src1 State.print src2
89 | OP_SELF_RIGHT1 src ->
90 fprintf fmt "OP_SELF_RIGHT1{%a}" State.print src
92 | OP_SELF_RIGHT2 (src1, src2) ->
93 fprintf fmt "OP_SELF_RIGHT2{%a, %a}" State.print src1 State.print src2
95 | OP_SELF_LEFT1_RIGHT1 (src1, src2) ->
96 fprintf fmt "OP_SELF_LEFT1_RIGHT1{%a}{%a}" State.print src1 State.print src2
98 | OP_SELF_LEFT2_RIGHT1 (src1, src2, src3) ->
99 fprintf fmt "OP_SELF_LEFT2_RIGHT1{%a, %a}{%a}"
100 State.print src1 State.print src2 State.print src3
102 | OP_SELF_LEFT1_RIGHT2 (src1, src2, src3) ->
103 fprintf fmt "OP_SELF_LEFT1_RIGHT2{%a}{%a, %a}"
104 State.print src1 State.print src2 State.print src3
106 | OP_SELF_LEFT2_RIGHT2 (src1, src2, src3, src4) ->
107 fprintf fmt "OP_SELF_LEFT2_RIGHT2{%a, %a}{%a, %a}"
108 State.print src1 State.print src2 State.print src3 State.print src4
110 fprintf fmt "OP_OTHER: ";
111 Array.iter (fun i -> print_instr fmt i; fprintf fmt " ") line
113 let merge_rev equal choose l =
119 let j = List.hd acc in
120 if equal i j then (choose i j)::(List.tl acc)
123 let compile_instr_list l =
124 let linstr = merge_rev (=) (fun i _ -> i) (List.sort (fun x y -> compare y x) l) in
127 | [ LEFT q ] -> OP_LEFT1 q
128 | [ LEFT q1; LEFT q2 ] -> OP_LEFT2(q2, q1)
129 | [ RIGHT q ] -> OP_RIGHT1 q
130 | [ RIGHT q1; RIGHT q2 ] -> OP_RIGHT2(q2, q1)
131 | [ LEFT q1; RIGHT q2 ] -> OP_LEFT1_RIGHT1(q1, q2)
132 | [ LEFT q1; LEFT q2; RIGHT q3 ] -> OP_LEFT2_RIGHT1 (q2, q1, q3)
133 | [ LEFT q1; RIGHT q2; RIGHT q3 ] -> OP_LEFT1_RIGHT2 (q1, q3, q2)
134 | [ LEFT q1; LEFT q2; RIGHT q3; RIGHT q4 ] -> OP_LEFT2_RIGHT2 (q2, q1, q4, q3)
135 | [ SELF () ] -> OP_SELF()
137 | [ SELF _; LEFT q ] -> OP_SELF_LEFT1 q
138 | [ SELF _; LEFT q1; LEFT q2 ] -> OP_SELF_LEFT2(q2, q1)
139 | [ SELF _; RIGHT q ] -> OP_SELF_RIGHT1 q
140 | [ SELF _; RIGHT q1; RIGHT q2 ] -> OP_SELF_RIGHT2(q2, q1)
141 | [ SELF _; LEFT q1; RIGHT q2 ] -> OP_SELF_LEFT1_RIGHT1(q1, q2)
142 | [ SELF _; LEFT q1; LEFT q2; RIGHT q3 ] -> OP_SELF_LEFT2_RIGHT1 (q2, q1, q3)
143 | [ SELF _; LEFT q1; RIGHT q2; RIGHT q3 ] -> OP_SELF_LEFT1_RIGHT2 (q1, q3, q2)
144 | [ SELF _; LEFT q1; LEFT q2; RIGHT q3; RIGHT q4 ] ->
145 OP_SELF_LEFT2_RIGHT2 (q2, q1, q4, q3)
146 | i -> OP_OTHER (Array.of_list i)
153 | (a, b)::ll -> loop ll (Cons(a,b, acc))
157 let rec filter_uniq statel stater l =
163 (fun ((a_il, al, ar)as acc) i ->
166 if List.mem q al then acc
167 else (i :: a_il, q::al, ar)
169 if List.mem q ar then acc
170 else (i :: a_il, al, q :: ar)
171 | _ -> (i :: a_il, al, ar)) ([], statel, stater) il
173 (s, nil) :: (filter_uniq nsl nsr ll)
176 let l = List.sort (fun (s1, _) (s2, _) -> compare s1 s2) l in
177 let l = filter_uniq [] [] l in
179 (fun (s1, _) (s2, _) -> s1 = s2)
180 (fun (s1, i1) (_, i2) -> (s1, i1@i2)) l
184 (fun (_, l) -> List.exists (function SELF _ -> true | _ -> false) l)
187 let l = List.map (fun (s, il) -> (s, compile_instr_list il)) l in
188 let l = List.filter (fun (_, instr) -> instr <> OP_NOP ()) l in
189 to_list l, not marking
194 let () = at_exit (fun () -> Printf.eprintf "Dummy affectations %i/%i\n%!" !_empty !_total)
198 DEFINE SET(a, b) = (a) <- (b)
200 DEFINE EXEC_INSTR_TEMPLATE(ns) = fun slot1 slot2 t inst acc ->
202 | SELF _ -> ns.snoc acc t
203 | LEFT src -> ns.concat acc slot1.(src)
204 | RIGHT src -> ns.concat acc slot2.(src)
207 DEFINE EXEC_CODE_TEMPLATE(ns) = fun slot slot1 slot2 t dst code ->
212 SET(slot.(dst), slot1.(src))
214 | OP_LEFT2 (src1, src2) ->
215 SET(slot.(dst) , ns.concat slot1.(src1) slot1.(src2))
217 | OP_RIGHT1 src -> SET(slot.(dst) , slot2.(src))
219 | OP_RIGHT2 (src1, src2) ->
220 SET (slot.(dst) , ns.concat slot2.(src1) slot2.(src2) )
222 | OP_LEFT1_RIGHT1 (src1, src2) ->
223 SET (slot.(dst) , ns.concat slot1.(src1) slot2.(src2))
225 | OP_LEFT2_RIGHT1 (src1, src2, src3) ->
226 SET (slot.(dst) , ns.concat3 slot1.(src1) slot1.(src2) slot2.(src3))
228 | OP_LEFT1_RIGHT2 (src1, src2, src3) ->
229 TRACE("res-jit", 3, __ "slot==slot1: %b, slot==slot2:%b\n" (slot==slot1) (slot==slot2));
230 SET (slot.(dst) , ns.concat3 slot1.(src1) slot2.(src2) slot2.(src3));
232 | OP_LEFT2_RIGHT2 (src1, src2, src3, src4) ->
233 SET (slot.(dst) , ns.concat4 slot1.(src1) slot1.(src2) slot2.(src3) slot2.(src4))
236 slot.(dst) <- ns.singleton t
238 | OP_SELF_LEFT1 src -> slot.(dst) <- ns.cons t slot1.(src)
240 | OP_SELF_LEFT2 (src1, src2) ->
241 slot.(dst) <- ns.conscat t slot1.(src1) slot1.(src2)
243 | OP_SELF_RIGHT1 src -> slot.(dst) <- ns.cons t slot2.(src)
245 | OP_SELF_RIGHT2 (src1, src2) ->
246 slot.(dst) <- ns.conscat t slot2.(src1) slot2.(src2)
248 | OP_SELF_LEFT1_RIGHT1 (src1, src2) ->
249 slot.(dst) <- ns.conscat t slot1.(src1) slot2.(src2)
251 | OP_SELF_LEFT2_RIGHT1 (src1, src2, src3) ->
252 slot.(dst) <- ns.conscat3 t slot1.(src1) slot1.(src2) slot2.(src3)
254 | OP_SELF_LEFT1_RIGHT2 (src1, src2, src3) ->
255 slot.(dst) <- ns.conscat3 t slot1.(src1) slot2.(src2) slot2.(src3)
257 | OP_SELF_LEFT2_RIGHT2 (src1, src2, src3, src4) ->
259 ns.conscat4 t slot1.(src1) slot1.(src2) slot2.(src3) slot2.(src4)
261 let acc = ref ns.empty in
262 let len = Array.length line - 1 in
264 acc := exec_instr slot1 slot2 t line.(j) !acc
271 module NS : NodeSet.S
273 val exec : t -> t -> t -> Tree.node -> code -> unit
280 module NS = NodeSet.Count
281 type t = NodeSet.Count.t array
283 let pr fmt (state, count) =
284 fprintf fmt "%a: %i" State.print state (NS.length count)
286 Pretty.print_array ~sep:", " pr fmt (Array.mapi (fun x y -> (x,y)) s)
288 let exec_instr = EXEC_INSTR_TEMPLATE(NodeSet.Count)
289 let exec_code = EXEC_CODE_TEMPLATE(NodeSet.Count)
290 (* inline by hand for efficiency reason *)
291 let rec exec slot slot1 slot2 t code =
294 | Cons(dst, opcode, code1) ->
295 TRACE("res-jit", 3, __ " %a := %a\n%!"
296 State.print dst print_opcode opcode;
298 exec_code slot slot1 slot2 t dst opcode;
302 | Cons(dst, opcode, code1) ->
303 TRACE("res-jit", 3, __ " %a := %a\n%!"
304 State.print dst print_opcode opcode;
306 exec_code slot slot1 slot2 t dst opcode;
307 exec slot slot1 slot2 t code1
310 let exec slot slot1 slot2 t code =
311 TRACE("res-jit", 3, __ "Node %i:\n" (Node.to_int t));
312 TRACE("res-jit", 3, __ " LEFT : %a\n" pr_slot slot1);
313 TRACE("res-jit", 3, __ " RIGHT : %a\n" pr_slot slot2);
314 exec slot slot1 slot2 t code;
315 TRACE("res-jit", 3, __ " RES : %a\n\n%!" pr_slot slot)
321 module NS = NodeSet.Mat
322 type t = NodeSet.Mat.t array
324 let pr fmt (state, count) =
325 fprintf fmt "%a: %i" State.print state (NS.length count)
327 Pretty.print_array ~sep:", " pr fmt (Array.mapi (fun x y -> (x,y)) s)
329 let exec_instr = EXEC_INSTR_TEMPLATE(NodeSet.Mat)
330 let exec_code = EXEC_CODE_TEMPLATE(NodeSet.Mat)
331 (* inline by hand for efficiency reason *)
332 let rec exec slot slot1 slot2 t code =
335 | Cons(dst, code, code1) ->
336 exec_code slot slot1 slot2 t dst code;
340 | Cons(dst', code', code1') ->
341 exec_code slot slot1 slot2 t dst' code';
342 exec slot slot1 slot2 t code1'