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 SET (slot.(dst) , ns.concat3 slot1.(src1) slot2.(src2) slot2.(src3));
231 | OP_LEFT2_RIGHT2 (src1, src2, src3, src4) ->
232 SET (slot.(dst) , ns.concat4 slot1.(src1) slot1.(src2) slot2.(src3) slot2.(src4))
235 slot.(dst) <- ns.singleton t
237 | OP_SELF_LEFT1 src -> slot.(dst) <- ns.cons t slot1.(src)
239 | OP_SELF_LEFT2 (src1, src2) ->
240 slot.(dst) <- ns.conscat t slot1.(src1) slot1.(src2)
242 | OP_SELF_RIGHT1 src -> slot.(dst) <- ns.cons t slot2.(src)
244 | OP_SELF_RIGHT2 (src1, src2) ->
245 slot.(dst) <- ns.conscat t slot2.(src1) slot2.(src2)
247 | OP_SELF_LEFT1_RIGHT1 (src1, src2) ->
248 slot.(dst) <- ns.conscat t slot1.(src1) slot2.(src2)
250 | OP_SELF_LEFT2_RIGHT1 (src1, src2, src3) ->
251 slot.(dst) <- ns.conscat3 t slot1.(src1) slot1.(src2) slot2.(src3)
253 | OP_SELF_LEFT1_RIGHT2 (src1, src2, src3) ->
254 slot.(dst) <- ns.conscat3 t slot1.(src1) slot2.(src2) slot2.(src3)
256 | OP_SELF_LEFT2_RIGHT2 (src1, src2, src3, src4) ->
258 ns.conscat4 t slot1.(src1) slot1.(src2) slot2.(src3) slot2.(src4)
260 let acc = ref ns.empty in
261 let len = Array.length line - 1 in
263 acc := exec_instr slot1 slot2 t line.(j) !acc
270 module NS : NodeSet.S
272 val exec : t -> t -> t -> Tree.node -> code -> unit
273 val print : Format.formatter -> t -> unit
274 val var : int -> t -> t
275 val close : ((int*State.t, NS.t) Hashtbl.t) -> t -> t
276 val is_open : t -> bool
283 module NS = NodeSet.Count
284 type t = NodeSet.Count.t array
286 let pr fmt (state, count) =
287 fprintf fmt "%a: %i" State.print state (NS.length count)
289 Pretty.print_array ~sep:", " pr fmt (Array.mapi (fun x y -> (x,y)) s)
291 let exec_instr = EXEC_INSTR_TEMPLATE(NodeSet.Count)
292 let exec_code = EXEC_CODE_TEMPLATE(NodeSet.Count)
293 (* inline by hand for efficiency reason *)
294 let rec exec slot slot1 slot2 t code =
297 | Cons(dst, opcode, code1) ->
298 TRACE("res-jit", 3, __ " %a := %a\n%!"
299 State.print dst print_opcode opcode;
301 exec_code slot slot1 slot2 t dst opcode;
305 | Cons(dst, opcode, code1) ->
306 TRACE("res-jit", 3, __ " %a := %a\n%!"
307 State.print dst print_opcode opcode;
309 exec_code slot slot1 slot2 t dst opcode;
310 exec slot slot1 slot2 t code1
313 let exec slot slot1 slot2 t code =
314 TRACE("res-jit", 3, __ "Node %i:\n" (Node.to_int t));
315 TRACE("res-jit", 3, __ " LEFT : %a\n" pr_slot slot1);
316 TRACE("res-jit", 3, __ " RIGHT : %a\n" pr_slot slot2);
317 exec slot slot1 slot2 t code;
318 TRACE("res-jit", 3, __ " RES : %a\n\n%!" pr_slot slot)
324 let is_open _ = false
329 module NS = NodeSet.Mat
330 type t = NodeSet.Mat.t array
332 let pr fmt (state, count) =
333 fprintf fmt "%a: %i" State.print state (NS.length count)
335 Pretty.print_array ~sep:", " pr fmt (Array.mapi (fun x y -> (x,y)) s)
337 let exec_instr = EXEC_INSTR_TEMPLATE(NodeSet.Mat)
338 let exec_code = EXEC_CODE_TEMPLATE(NodeSet.Mat)
339 (* inline by hand for efficiency reason *)
340 let rec exec slot slot1 slot2 t code =
343 | Cons(dst, code, code1) ->
344 exec_code slot slot1 slot2 t dst code;
348 | Cons(dst', code', code1') ->
349 exec_code slot slot1 slot2 t dst' code';
350 exec slot slot1 slot2 t code1'
355 let is_open _ = false
360 module Make(U : NodeSet.S) =
365 let pr fmt (state, count) =
366 fprintf fmt "%a: %i" State.print state (NS.length count)
368 Pretty.print_array ~sep:", " pr fmt (Array.mapi (fun x y -> (x,y)) s)
370 let exec_instr = EXEC_INSTR_TEMPLATE(U)
371 let exec_code = EXEC_CODE_TEMPLATE(U)
372 (* inline by hand for efficiency reason *)
373 let rec exec slot slot1 slot2 t code =
376 | Cons(dst, opcode, code1) ->
377 TRACE("res-jit", 3, __ " %a := %a\n%!"
378 State.print dst print_opcode opcode;
380 exec_code slot slot1 slot2 t dst opcode;
384 | Cons(dst, opcode, code1) ->
385 TRACE("res-jit", 3, __ " %a := %a\n%!"
386 State.print dst print_opcode opcode;
388 exec_code slot slot1 slot2 t dst opcode;
389 exec slot slot1 slot2 t code1
392 let exec slot slot1 slot2 t code =
393 TRACE("res-jit", 3, __ "Node %i:\n" (Node.to_int t));
394 TRACE("res-jit", 3, __ " LEFT : %a\n" pr_slot slot1);
395 TRACE("res-jit", 3, __ " RIGHT : %a\n" pr_slot slot2);
396 exec slot slot1 slot2 t code;
397 TRACE("res-jit", 3, __ " RES : %a\n\n%!" pr_slot slot)
401 Array.mapi (fun j _ -> NS.var (i,j)) t
403 Array.map (NS.close h) t
406 List.exists NS.is_open (Array.to_list t)