- type opcode = (t -> t -> t -> Tree.t -> Tree.node -> StateSet.t * t)
-
- type t = opcode Cache.Lvl3.t
-
- let dummy _ _ _ _ _ = failwith "Uninitialized L3JIT"
-
-
- let show_stats a =
- let count = ref 0 in
- Cache.Lvl3.iteri (fun _ _ _ _ b -> if not b then incr count) a;
- Logger.print err_formatter "@?L3JIT: %i used entries@\n@?" !count
- let create () =
- let v = Cache.Lvl3.create 1024 dummy in
- if !Options.verbose then at_exit (fun () -> show_stats v);
- v
-
- let find t tlist s1 s2 =
- Cache.Lvl3.find t
- (Uid.to_int s2.StateSet.Node.id)
- (Uid.to_int s1.StateSet.Node.id)
- (Uid.to_int tlist.Translist.Node.id)
-
- let add t tlist s1 s2 v =
- Cache.Lvl3.add t
- (Uid.to_int s2.StateSet.Node.id)
- (Uid.to_int s1.StateSet.Node.id)
- (Uid.to_int tlist.Translist.Node.id)
- v
-
- let compile auto trl s1 s2 =
- let orig_s1, orig_s2 =
- Translist.fold (fun t (a1, a2) ->
- let _, _, _, f = Transition.node t in
- let fs1, fs2 = Formula.st f in
- (StateSet.union a1 fs1, StateSet.union a2 fs2)
- ) trl (StateSet.empty, StateSet.empty)
- in
- let ns1 = StateSet.inter s1 orig_s1
- and ns2 = StateSet.inter s2 orig_s2 in
- let res, ops, todo = eval_trans auto ns1 ns2 trl in
- let code, not_marking = ResJIT.compile ops in
- let todo_code, todo_notmarking =
- List.fold_left (fun (l, b) (p, q, o) -> let c, b' = ResJIT.compile o in
- (p, q, c)::l, b && b')
- ([], not_marking) todo
- in
- let opcode = res, code, todo_notmarking, todo_code in
- opcode
-
- let gen_code auto tlist s1 s2 =
- let res, code, not_marking, todo_code = compile auto tlist s1 s2 in
- let f =
- if todo_code == [] then
- if not_marking then begin fun empty_slot sl1 sl2 _ node ->
- let slot1_empty = sl1 == empty_slot
- and slot2_empty = sl2 == empty_slot in
- if slot1_empty && slot2_empty then res,sl2
- else
- let sl =
- if slot2_empty then
- if slot1_empty then
- Array.copy empty_slot
- else sl1
- else sl2
- in
- U.exec sl sl1 sl2 node code;
- res, sl
- end
- else (* marking *) begin fun empty_slot sl1 sl2 _ node ->
- let sl =
- if sl2 == empty_slot then
- if sl1 == empty_slot then
- Array.copy empty_slot
- else sl1
- else sl2
- in
- U.exec sl sl1 sl2 node code;
- res, sl
- end
- else (* todo != [] *)
- begin fun empty_slot sl1 sl2 tree node ->
- let sl =
- if sl2 == empty_slot then
- if sl1 == empty_slot then
- Array.copy empty_slot
- else sl1
- else sl2
- in
- U.exec sl sl1 sl2 node code;
- List.fold_left
- (fun ares (p, q, code) ->
- if !p tree node then begin
- if code != ResJIT.Nil then U.exec sl sl1 sl2 node code;
- StateSet.add q ares
- end
- else ares) res todo_code, sl
-
- end
- in
- f
-
- let cache_apply cache auto tlist s1 s2 =
- let f = gen_code auto tlist s1 s2 in
- LOG(__ "grammar" 2 "Inserting: %i, %a, %a\n%!"
- (Uid.to_int tlist.Translist.Node.id) StateSet.print s1 StateSet.print s2);
- add cache tlist s1 s2 f; f
+ type opcode = (t -> t -> t -> Tree.t -> Tree.node -> StateSet.t * t)
+
+ type t = opcode Cache.Lvl3.t
+
+ let dummy _ _ _ _ _ = failwith "Uninitialized L3JIT"
+
+
+ let show_stats a =
+ let count = ref 0 in
+ Cache.Lvl3.iteri (fun _ _ _ _ b -> if not b then incr count) a;
+ Logger.print err_formatter "@?L3JIT: %i used entries@\n@?" !count
+ let create () =
+ let v = Cache.Lvl3.create 1024 dummy in
+ if !Options.verbose then at_exit (fun () -> show_stats v);
+ v
+
+ let find t tlist s1 s2 =
+ Cache.Lvl3.find t
+ (Uid.to_int s2.StateSet.Node.id)
+ (Uid.to_int s1.StateSet.Node.id)
+ (Uid.to_int tlist.Translist.Node.id)
+
+ let add t tlist s1 s2 v =
+ Cache.Lvl3.add t
+ (Uid.to_int s2.StateSet.Node.id)
+ (Uid.to_int s1.StateSet.Node.id)
+ (Uid.to_int tlist.Translist.Node.id)
+ v
+
+ let compile auto trl s1 s2 =
+ let orig_s1, orig_s2 =
+ Translist.fold (fun t (a1, a2) ->
+ let _, _, _, f = Transition.node t in
+ let fs1, fs2 = Formula.st f in
+ (StateSet.union a1 fs1, StateSet.union a2 fs2)
+ ) trl (StateSet.empty, StateSet.empty)
+ in
+ let ns1 = StateSet.inter s1 orig_s1
+ and ns2 = StateSet.inter s2 orig_s2 in
+ let res, ops, todo = eval_trans auto ns1 ns2 trl in
+ let code, not_marking = ResJIT.compile ops in
+ let todo_code, todo_notmarking =
+ List.fold_left (fun (l, b) (p, q, o) -> let c, b' = ResJIT.compile o in
+ (p, q, c)::l, b && b')
+ ([], not_marking) todo
+ in
+ let opcode = res, code, todo_notmarking, todo_code in
+ opcode
+
+ let gen_code auto tlist s1 s2 =
+ let res, code, not_marking, todo_code = compile auto tlist s1 s2 in
+ let f =
+ if todo_code == [] then
+ if not_marking then begin fun empty_slot sl1 sl2 _ node ->
+ let slot1_empty = sl1 == empty_slot
+ and slot2_empty = sl2 == empty_slot in
+ if slot1_empty && slot2_empty then res,sl2
+ else
+ let sl =
+ if slot2_empty then
+ if slot1_empty then
+ Array.copy empty_slot
+ else sl1
+ else sl2
+ in
+ U.exec sl sl1 sl2 node code;
+ res, sl
+ end
+ else (* marking *) begin fun empty_slot sl1 sl2 _ node ->
+ let sl =
+ if sl2 == empty_slot then
+ if sl1 == empty_slot then
+ Array.copy empty_slot
+ else sl1
+ else sl2
+ in
+ U.exec sl sl1 sl2 node code;
+ res, sl
+ end
+ else (* todo != [] *)
+ begin fun empty_slot sl1 sl2 tree node ->
+ let sl =
+ if sl2 == empty_slot then
+ if sl1 == empty_slot then
+ Array.copy empty_slot
+ else sl1
+ else sl2
+ in
+ U.exec sl sl1 sl2 node code;
+ List.fold_left
+ (fun ares (p, q, code) ->
+ if !p tree node then begin
+ if code != ResJIT.Nil then U.exec sl sl1 sl2 node code;
+ StateSet.add q ares
+ end
+ else ares) res todo_code, sl
+
+ end
+ in
+ f
+
+ let cache_apply cache auto tlist s1 s2 =
+ let f = gen_code auto tlist s1 s2 in
+ LOG(__ "grammar" 2 "Inserting: %i, %a, %a\n%!"
+ (Uid.to_int tlist.Translist.Node.id) StateSet.print s1 StateSet.print s2);
+ add cache tlist s1 s2 f; f