INCLUDE "debug.ml"
INCLUDE "utils.ml"
-INCLUDE "trace.ml"
+INCLUDE "log.ml"
open Format
DEFINE SET(a, b) = (a) <- (b)
+DEFINE PRINT_TEMPLATE(ns) =
+ let pr fmt (state, count) =
+ fprintf fmt "%a: %i" State.print state (ns.length count)
+ in
+ Pretty.print_array ~sep:", " pr fmt (Array.mapi (fun x y -> (x,y)) s)
+
DEFINE EXEC_INSTR_TEMPLATE(ns) = fun slot1 slot2 t inst acc ->
match inst with
| SELF _ -> ns.snoc acc t
| OP_NOP _ -> ()
| OP_LEFT1 src ->
- SET(slot.(dst), slot1.(src))
+ SET(slot.(dst), slot1.(src))
| OP_LEFT2 (src1, src2) ->
- SET(slot.(dst) , ns.concat slot1.(src1) slot1.(src2))
+ SET(slot.(dst) , ns.concat slot1.(src1) slot1.(src2))
| OP_RIGHT1 src -> SET(slot.(dst) , slot2.(src))
SET (slot.(dst) , ns.concat slot2.(src1) slot2.(src2) )
| OP_LEFT1_RIGHT1 (src1, src2) ->
- SET (slot.(dst) , ns.concat slot1.(src1) slot2.(src2))
+ SET (slot.(dst) , ns.concat slot1.(src1) slot2.(src2))
| OP_LEFT2_RIGHT1 (src1, src2, src3) ->
- SET (slot.(dst) , ns.concat3 slot1.(src1) slot1.(src2) slot2.(src3))
+ SET (slot.(dst) , ns.concat3 slot1.(src1) slot1.(src2) slot2.(src3))
| OP_LEFT1_RIGHT2 (src1, src2, src3) ->
- TRACE("res-jit", 3, __ "slot==slot1: %b, slot==slot2:%b\n" (slot==slot1) (slot==slot2));
SET (slot.(dst) , ns.concat3 slot1.(src1) slot2.(src2) slot2.(src3));
| OP_LEFT2_RIGHT2 (src1, src2, src3, src4) ->
SET (slot.(dst) , ns.concat4 slot1.(src1) slot1.(src2) slot2.(src3) slot2.(src4))
| OP_SELF _ ->
- slot.(dst) <- ns.singleton t
+ LOG(__ "res-jit" 1 "Putting Node %i in the result set@\n" (Node.to_int t));
+ slot.(dst) <- ns.singleton t
- | OP_SELF_LEFT1 src -> slot.(dst) <- ns.cons t slot1.(src)
+ | OP_SELF_LEFT1 src ->
+ LOG(__ "res-jit" 1 "Putting Node %i in the result set@\n" (Node.to_int t));
+ slot.(dst) <- ns.cons t slot1.(src)
| OP_SELF_LEFT2 (src1, src2) ->
- slot.(dst) <- ns.conscat t slot1.(src1) slot1.(src2)
+ LOG(__ "res-jit" 1 "Putting Node %i in the result set@\n" (Node.to_int t));
+ slot.(dst) <- ns.conscat t slot1.(src1) slot1.(src2)
- | OP_SELF_RIGHT1 src -> slot.(dst) <- ns.cons t slot2.(src)
+ | OP_SELF_RIGHT1 src ->
+ LOG(__ "res-jit" 1 "Putting Node %i in the result set@\n" (Node.to_int t));
+ slot.(dst) <- ns.cons t slot2.(src)
| OP_SELF_RIGHT2 (src1, src2) ->
- slot.(dst) <- ns.conscat t slot2.(src1) slot2.(src2)
+ LOG(__ "res-jit" 1 "Putting Node %i in the result set@\n" (Node.to_int t));
+ slot.(dst) <- ns.conscat t slot2.(src1) slot2.(src2)
| OP_SELF_LEFT1_RIGHT1 (src1, src2) ->
- slot.(dst) <- ns.conscat t slot1.(src1) slot2.(src2)
+ LOG(__ "res-jit" 1 "Putting Node %i in the result set@\n" (Node.to_int t));
+ slot.(dst) <- ns.conscat t slot1.(src1) slot2.(src2)
| OP_SELF_LEFT2_RIGHT1 (src1, src2, src3) ->
- slot.(dst) <- ns.conscat3 t slot1.(src1) slot1.(src2) slot2.(src3)
+ LOG(__ "res-jit" 1 "Putting Node %i in the result set@\n" (Node.to_int t));
+ slot.(dst) <- ns.conscat3 t slot1.(src1) slot1.(src2) slot2.(src3)
| OP_SELF_LEFT1_RIGHT2 (src1, src2, src3) ->
- slot.(dst) <- ns.conscat3 t slot1.(src1) slot2.(src2) slot2.(src3)
+ LOG(__ "res-jit" 1 "Putting Node %i in the result set@\n" (Node.to_int t));
+ slot.(dst) <- ns.conscat3 t slot1.(src1) slot2.(src2) slot2.(src3)
| OP_SELF_LEFT2_RIGHT2 (src1, src2, src3, src4) ->
- slot.(dst) <-
- ns.conscat4 t slot1.(src1) slot1.(src2) slot2.(src3) slot2.(src4)
+ LOG(__ "res-jit" 1 "Putting Node %i in the result set@\n" (Node.to_int t));
+ slot.(dst) <-
+ ns.conscat4 t slot1.(src1) slot1.(src2) slot2.(src3) slot2.(src4)
| OP_OTHER line ->
let acc = ref ns.empty in
let len = Array.length line - 1 in
slot.(dst) <- !acc
+DEFINE EXEC_REC_TEMPLATE =
+ (match code with
+ | Nil -> ()
+ | Cons(dst, opcode, code1) ->
+ LOG(__ "res-jit" 3 " %a := %a"
+ State.print dst print_opcode opcode;
+ );
+ exec_code slot slot1 slot2 t dst opcode;
+ begin
+ match code1 with
+ | Nil -> ()
+ | Cons(dst, opcode, code1) ->
+ LOG(__ "res-jit" 3 " %a := %a"
+ State.print dst print_opcode opcode;
+ );
+ exec_code slot slot1 slot2 t dst opcode;
+ exec slot slot1 slot2 t code1
+
+ end)
+
+DEFINE EXEC_TEMPLATE =
+ (LOG(__ "res-jit" 3 "Node %i:@\nLEFT : %a@\nRIGHT : %a"
+ (Node.to_int t) print slot1 print slot2
+ );
+ exec slot slot1 slot2 t code;
+ LOG(__ "res-jit" 3 "RES : %a" print slot))
+
+
module type S =
sig
module NS : NodeSet.S
type t = NS.t array
val exec : t -> t -> t -> Tree.node -> code -> unit
+ val print : Format.formatter -> t -> unit
+ val var : int -> t -> t
+ val close : ((int*State.t, NS.t) Hashtbl.t) -> t -> t
+ val is_open : t -> bool
end
-
-
module Count =
struct
module NS = NodeSet.Count
type t = NodeSet.Count.t array
- let pr_slot fmt s =
- let pr fmt (state, count) =
- fprintf fmt "%a: %i" State.print state (NS.length count)
- in
- Pretty.print_array ~sep:", " pr fmt (Array.mapi (fun x y -> (x,y)) s)
-
+ let print fmt s = PRINT_TEMPLATE(NS)
let exec_instr = EXEC_INSTR_TEMPLATE(NodeSet.Count)
let exec_code = EXEC_CODE_TEMPLATE(NodeSet.Count)
- (* inline by hand for efficiency reason *)
- let rec exec slot slot1 slot2 t code =
- match code with
- | Nil -> ()
- | Cons(dst, opcode, code1) ->
- TRACE("res-jit", 3, __ " %a := %a\n%!"
- State.print dst print_opcode opcode;
- );
- exec_code slot slot1 slot2 t dst opcode;
- begin
- match code1 with
- | Nil -> ()
- | Cons(dst, opcode, code1) ->
- TRACE("res-jit", 3, __ " %a := %a\n%!"
- State.print dst print_opcode opcode;
- );
- exec_code slot slot1 slot2 t dst opcode;
- exec slot slot1 slot2 t code1
- end
-
- let exec slot slot1 slot2 t code =
- TRACE("res-jit", 3, __ "Node %i:\n" (Node.to_int t));
- TRACE("res-jit", 3, __ " LEFT : %a\n" pr_slot slot1);
- TRACE("res-jit", 3, __ " RIGHT : %a\n" pr_slot slot2);
- exec slot slot1 slot2 t code;
- TRACE("res-jit", 3, __ " RES : %a\n\n%!" pr_slot slot)
-
+ let rec exec slot slot1 slot2 t code = EXEC_REC_TEMPLATE
+ let var _ x = x
+ let close _ x = x
+ let is_open _ = false
end
module Mat =
struct
module NS = NodeSet.Mat
type t = NodeSet.Mat.t array
- let pr_slot fmt s =
- let pr fmt (state, count) =
- fprintf fmt "%a: %i" State.print state (NS.length count)
- in
- Pretty.print_array ~sep:", " pr fmt (Array.mapi (fun x y -> (x,y)) s)
-
+ let print fmt s = PRINT_TEMPLATE(NS)
let exec_instr = EXEC_INSTR_TEMPLATE(NodeSet.Mat)
let exec_code = EXEC_CODE_TEMPLATE(NodeSet.Mat)
- (* inline by hand for efficiency reason *)
- let rec exec slot slot1 slot2 t code =
- match code with
- | Nil -> ()
- | Cons(dst, code, code1) ->
- exec_code slot slot1 slot2 t dst code;
- begin
- match code1 with
- | Nil -> ()
- | Cons(dst', code', code1') ->
- exec_code slot slot1 slot2 t dst' code';
- exec slot slot1 slot2 t code1'
- end
+ let rec exec slot slot1 slot2 t code = EXEC_REC_TEMPLATE
+ let var _ x = x
+ let close _ x = x
+ let is_open _ = false
end
+module Make(U : NodeSet.S) =
+ struct
+ module NS = U
+ type t = U.t array
+ let print fmt s = PRINT_TEMPLATE(NS)
+ let exec_instr = EXEC_INSTR_TEMPLATE(U)
+ let exec_code = EXEC_CODE_TEMPLATE(U)
+ let rec exec slot slot1 slot2 t code = EXEC_REC_TEMPLATE
+ let exec slot slot1 slot2 t code = EXEC_TEMPLATE
+ let var i t =
+ Array.mapi (fun j _ -> NS.var (i,j)) t
+ let close h t =
+ Array.map (NS.close h) t
+
+ let is_open t =
+ List.exists NS.is_open (Array.to_list t)
+ end
projects / SXSI / xpathcomp.git / blobdiff