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 PRINT_TEMPLATE(ns) =
201 let pr fmt (state, count) =
202 fprintf fmt "%a: %i" State.print state (ns.length count)
204 Pretty.print_array ~sep:", " pr fmt (Array.mapi (fun x y -> (x,y)) s)
206 DEFINE EXEC_INSTR_TEMPLATE(ns) = fun slot1 slot2 t inst acc ->
208 | SELF _ -> ns.snoc acc t
209 | LEFT src -> ns.concat acc slot1.(src)
210 | RIGHT src -> ns.concat acc slot2.(src)
213 DEFINE EXEC_CODE_TEMPLATE(ns) = fun slot slot1 slot2 t dst code ->
218 SET(slot.(dst), slot1.(src))
220 | OP_LEFT2 (src1, src2) ->
221 SET(slot.(dst) , ns.concat slot1.(src1) slot1.(src2))
223 | OP_RIGHT1 src -> SET(slot.(dst) , slot2.(src))
225 | OP_RIGHT2 (src1, src2) ->
226 SET (slot.(dst) , ns.concat slot2.(src1) slot2.(src2) )
228 | OP_LEFT1_RIGHT1 (src1, src2) ->
229 SET (slot.(dst) , ns.concat slot1.(src1) slot2.(src2))
231 | OP_LEFT2_RIGHT1 (src1, src2, src3) ->
232 SET (slot.(dst) , ns.concat3 slot1.(src1) slot1.(src2) slot2.(src3))
234 | OP_LEFT1_RIGHT2 (src1, src2, src3) ->
235 SET (slot.(dst) , ns.concat3 slot1.(src1) slot2.(src2) slot2.(src3));
237 | OP_LEFT2_RIGHT2 (src1, src2, src3, src4) ->
238 SET (slot.(dst) , ns.concat4 slot1.(src1) slot1.(src2) slot2.(src3) slot2.(src4))
241 slot.(dst) <- ns.singleton t
243 | OP_SELF_LEFT1 src -> slot.(dst) <- ns.cons t slot1.(src)
245 | OP_SELF_LEFT2 (src1, src2) ->
246 slot.(dst) <- ns.conscat t slot1.(src1) slot1.(src2)
248 | OP_SELF_RIGHT1 src -> slot.(dst) <- ns.cons t slot2.(src)
250 | OP_SELF_RIGHT2 (src1, src2) ->
251 slot.(dst) <- ns.conscat t slot2.(src1) slot2.(src2)
253 | OP_SELF_LEFT1_RIGHT1 (src1, src2) ->
254 slot.(dst) <- ns.conscat t slot1.(src1) slot2.(src2)
256 | OP_SELF_LEFT2_RIGHT1 (src1, src2, src3) ->
257 slot.(dst) <- ns.conscat3 t slot1.(src1) slot1.(src2) slot2.(src3)
259 | OP_SELF_LEFT1_RIGHT2 (src1, src2, src3) ->
260 slot.(dst) <- ns.conscat3 t slot1.(src1) slot2.(src2) slot2.(src3)
262 | OP_SELF_LEFT2_RIGHT2 (src1, src2, src3, src4) ->
264 ns.conscat4 t slot1.(src1) slot1.(src2) slot2.(src3) slot2.(src4)
266 let acc = ref ns.empty in
267 let len = Array.length line - 1 in
269 acc := exec_instr slot1 slot2 t line.(j) !acc
274 DEFINE EXEC_REC_TEMPLATE =
277 | Cons(dst, opcode, code1) ->
278 TRACE("res-jit", 3, __ " %a := %a\n%!"
279 State.print dst print_opcode opcode;
281 exec_code slot slot1 slot2 t dst opcode;
285 | Cons(dst, opcode, code1) ->
286 TRACE("res-jit", 3, __ " %a := %a\n%!"
287 State.print dst print_opcode opcode;
289 exec_code slot slot1 slot2 t dst opcode;
290 exec slot slot1 slot2 t code1
294 DEFINE EXEC_TEMPLATE =
295 (TRACE("res-jit", 3, __ "Node %i:\n" (Node.to_int t));
296 TRACE("res-jit", 3, __ " LEFT : %a\n" pr_slot slot1);
297 TRACE("res-jit", 3, __ " RIGHT : %a\n" pr_slot slot2);
298 exec slot slot1 slot2 t code;
299 TRACE("res-jit", 3, __ " RES : %a\n\n%!" pr_slot slot))
304 module NS : NodeSet.S
306 val exec : t -> t -> t -> Tree.node -> code -> unit
307 val print : Format.formatter -> t -> unit
308 val var : int -> t -> t
309 val close : ((int*State.t, NS.t) Hashtbl.t) -> t -> t
310 val is_open : t -> bool
315 module NS = NodeSet.Count
316 type t = NodeSet.Count.t array
317 let print fmt s = PRINT_TEMPLATE(NS)
318 let exec_instr = EXEC_INSTR_TEMPLATE(NodeSet.Count)
319 let exec_code = EXEC_CODE_TEMPLATE(NodeSet.Count)
320 let rec exec slot slot1 slot2 t code = EXEC_REC_TEMPLATE
321 let exec slot slot1 slot2 t code = EXEC_TEMPLATE
324 let is_open _ = false
329 module NS = NodeSet.Mat
330 type t = NodeSet.Mat.t array
331 let print fmt s = PRINT_TEMPLATE(NS)
332 let exec_instr = EXEC_INSTR_TEMPLATE(NodeSet.Mat)
333 let exec_code = EXEC_CODE_TEMPLATE(NodeSet.Mat)
334 let rec exec slot slot1 slot2 t code = EXEC_REC_TEMPLATE
335 let exec slot slot1 slot2 t code = EXEC_TEMPLATE
338 let is_open _ = false
343 module Make(U : NodeSet.S) =
347 let print fmt s = PRINT_TEMPLATE(NS)
348 let exec_instr = EXEC_INSTR_TEMPLATE(U)
349 let exec_code = EXEC_CODE_TEMPLATE(U)
350 let rec exec slot slot1 slot2 t code = EXEC_REC_TEMPLATE
351 let exec slot slot1 slot2 t code = EXEC_TEMPLATE
353 Array.mapi (fun j _ -> NS.var (i,j)) t
355 Array.map (NS.close h) t
358 List.exists NS.is_open (Array.to_list t)