From a6baedc6c67cb1de0587a779f8bcddf276b0bf4c Mon Sep 17 00:00:00 2001 From: kim Date: Tue, 7 Feb 2012 17:23:28 +0000 Subject: [PATCH] Temporary commit. git-svn-id: svn+ssh://idea.nguyen.vg/svn/sxsi/branches/xpathcomp/trace-refactor@1197 3cdefd35-fc62-479d-8e8d-bae585ffb9ca --- include/trace.ml | 2 +- src/OCamlDriver.cpp | 4 +++ src/ata.ml | 83 +++++++++++++++++++++++---------------------- src/l2JIT.ml | 27 ++++++++------- src/resJIT.ml | 61 +++++++++++++++++++++++---------- src/runtime.ml | 16 ++++++--- src/tracer.ml | 4 +-- src/tree.ml | 3 ++ src/tree.mli | 1 + 9 files changed, 124 insertions(+), 77 deletions(-) diff --git a/include/trace.ml b/include/trace.ml index 21e3a95..c4a72bd 100644 --- a/include/trace.ml +++ b/include/trace.ml @@ -1,7 +1,7 @@ IFNDEF TRACE__ML__ THEN DEFINE TRACE__ML__ - +module Loc = Camlp4.PreCast.Loc let __ x = ignore (Format.flush_str_formatter()); Format.kfprintf diff --git a/src/OCamlDriver.cpp b/src/OCamlDriver.cpp index bb007a8..c1a4fdd 100644 --- a/src/OCamlDriver.cpp +++ b/src/OCamlDriver.cpp @@ -281,6 +281,10 @@ NoAlloc extern "C" value caml_xml_tree_next_element(value tree, value node){ return (Val_int(XMLTREE(tree)->NextElement(TREENODEVAL(node)))); } +NoAlloc extern "C" value caml_xml_tree_next_node_before(value tree, value node, value ctx){ + return (Val_int(XMLTREE(tree)->NextNodeBefore(TREENODEVAL(node), TREENODEVAL(ctx)))); +} + NoAlloc extern "C" value caml_xml_tree_prev_sibling(value tree, value node){ return (Val_int(XMLTREE(tree)->PrevSibling(TREENODEVAL(node)))); } diff --git a/src/ata.ml b/src/ata.ml index 21c1a7f..da2f8ce 100644 --- a/src/ata.ml +++ b/src/ata.ml @@ -1,5 +1,6 @@ INCLUDE "debug.ml" INCLUDE "utils.ml" +INCLUDE "trace.ml" open Format @@ -118,12 +119,12 @@ let compute_jump auto tree states l marking = | [ (_, (l, r, _) ) ] when l == StateSet.empty -> JUMP_ONE(rel_labels) | _ -> - if Ptset.Int.mem Tag.pcdata rel_labels then - let () = - D_TRACE_(Format.eprintf ">>> Computed rel_labels: %a\n%!" - TagSet.print (TagSet.inj_positive rel_labels)) - in NODE - else STAR + if Ptset.Int.mem Tag.pcdata rel_labels then begin + TRACE("top-down-approx", 3, __ "Computed rel_labels: %a\n" + TagSet.print + (TagSet.inj_positive rel_labels)); + NODE + end else STAR module Cache = Hashtbl.Make(StateSet) let cache = Cache.create 1023 @@ -208,39 +209,42 @@ let top_down_approx auto states tree = merge_trans by_states merge_labels (List.sort by_states uniq_states_trs) in - D_TRACE_( - let is_pairwise_disjoint l = - List.for_all (fun ((ts, _) as tr) -> - List.for_all (fun ((ts', _) as tr') -> - (ts == ts' && (by_states tr tr' == 0)) || - TagSet.is_empty (TagSet.cap ts ts')) l) l - in - let is_complete l = TagSet.positive - (List.fold_left (fun acc (ts, _) -> TagSet.cup acc ts) - TagSet.empty l) - == - (Tree.node_tags tree) - in - eprintf "Top-down approximation (%b, %b):\n%!" - (is_pairwise_disjoint td_approx) - (is_complete td_approx); - List.iter (fun (ts,(l,r, m)) -> - let ts = if TagSet.cardinal ts >10 - then TagSet.diff TagSet.any - (TagSet.diff - (TagSet.inj_positive (Tree.node_tags tree)) - ts) - else ts - in - eprintf "%a, %a, %b -> %a, %a\n%!" - StateSet.print states - TagSet.print ts - m - StateSet.print l - StateSet.print r - ) td_approx; - eprintf "\n%!" - + TRACE( + "top-down-approx", 2, + let is_pairwise_disjoint l = + List.for_all (fun ((ts, _) as tr) -> + List.for_all (fun ((ts', _) as tr') -> + (ts == ts' && (by_states tr tr' == 0)) || + TagSet.is_empty (TagSet.cap ts ts')) l) l + in + let is_complete l = TagSet.positive + (List.fold_left (fun acc (ts, _) -> TagSet.cup acc ts) + TagSet.empty l) + == + (Tree.node_tags tree) + in + let pr_td_approx fmt td_approx = + List.iter (fun (ts,(l,r, m)) -> + let ts = if TagSet.cardinal ts >10 + then TagSet.diff TagSet.any + (TagSet.diff + (TagSet.inj_positive (Tree.node_tags tree)) + ts) + else ts + in + fprintf fmt "\t%a, %a, %b -> %a, %a\n%!" + StateSet.print states + TagSet.print ts + m + StateSet.print l + StateSet.print r + ) td_approx; + fprintf fmt "\n%!" + in + __ " pairwise-disjoint:%b, complete:%b:\n%a" + (is_pairwise_disjoint td_approx) + (is_complete td_approx) + pr_td_approx td_approx ); let jump = compute_jump @@ -248,4 +252,3 @@ let top_down_approx auto states tree = (List.exists (fun (_,(_,_,b)) -> b) td_approx) in Cache.add cache states jump; jump - diff --git a/src/l2JIT.ml b/src/l2JIT.ml index 6eccae3..7a73d12 100644 --- a/src/l2JIT.ml +++ b/src/l2JIT.ml @@ -1,5 +1,6 @@ INCLUDE "debug.ml" INCLUDE "utils.ml" +INCLUDE "trace.ml" open Format open Ata @@ -168,8 +169,8 @@ let rec translate_jump tree tag (jkind:Ata.jump_kind) dir s = let labels = Ptset.Int.inter l_one t in let c = Ptset.Int.cardinal labels in if c == 0 then _nop - else if Ptset.Int.for_all (fun lab -> not (Ptset.Int.mem lab l_many)) labels - then translate_jump tree tag (JUMP_MANY(labels)) dir s + else if Ptset.Int.for_all (fun lab -> not (Ptset.Int.mem lab l_many)) labels then + translate_jump tree tag (JUMP_MANY(labels)) dir s else if c == 1 then tagged_one s (Ptset.Int.choose labels) else if c > 5 then if has_text labels then any s else any_notext s else select_one s labels @@ -195,22 +196,22 @@ let rec translate_jump tree tag (jkind:Ata.jump_kind) dir s = | _ -> assert false let compute_jump auto tree tag states dir = - (*PROF_CFUN("L2JIT.compute_jump"); *) if !Options.no_jump then if dir == DIR_LEFT then FIRST_CHILD states else NEXT_SIBLING states else let jkind = Ata.top_down_approx auto states tree in let jump = translate_jump tree tag jkind dir states in - D_TRACE_(eprintf "Computed jumps for %s %a %s: %a\n%!" - (Tag.to_string tag) - StateSet.print states - (if dir == DIR_LEFT then "left" else "right") - print_jump jump); - jump + TRACE("level2-jit", 2, + __ "Computed jumps for %s %a %s: %a\n%!" + (Tag.to_string tag) + StateSet.print states + (if dir == DIR_LEFT then "left" else "right") + print_jump jump + ); + jump let compile cache2 auto tree tag states = - (*PROF_CFUN("L2JIT.compile"); *) let tr_list, states1, states2 = StateSet.fold (fun q acc -> @@ -231,9 +232,9 @@ let compile cache2 auto tree tag states = LEFT (tr_list, compute_jump auto tree tag states1 DIR_LEFT) else - BOTH (tr_list, - compute_jump auto tree tag states1 DIR_LEFT, - compute_jump auto tree tag states2 DIR_RIGHT) + let j1 = compute_jump auto tree tag states1 DIR_LEFT in + let j2 = compute_jump auto tree tag states2 DIR_RIGHT in + BOTH (tr_list, j1, j2); in let op = match op with (*BOTH(_, NOP _, NOP _) | LEFT(_, NOP _) | RIGHT(_, NOP _) -> RETURN() *) diff --git a/src/resJIT.ml b/src/resJIT.ml index 312b487..28f9281 100644 --- a/src/resJIT.ml +++ b/src/resJIT.ml @@ -1,5 +1,7 @@ INCLUDE "debug.ml" INCLUDE "utils.ml" +INCLUDE "trace.ml" + open Format type instr = @@ -193,7 +195,7 @@ let () = at_exit (fun () -> Printf.eprintf "Dummy affectations %i/%i\n%!" !_empt ;; *) -DEFINE SET(a, b) = a <- b +DEFINE SET(a, b) = (a) <- (b) DEFINE EXEC_INSTR_TEMPLATE(ns) = fun slot1 slot2 t inst acc -> match inst with @@ -207,12 +209,12 @@ DEFINE EXEC_CODE_TEMPLATE(ns) = fun slot slot1 slot2 t dst code -> | OP_NOP _ -> () | OP_LEFT1 src -> - if slot != slot1 then SET(slot.(dst), slot1.(src)) + SET(slot.(dst), slot1.(src)) | OP_LEFT2 (src1, src2) -> SET(slot.(dst) , ns.concat slot1.(src1) slot1.(src2)) - | OP_RIGHT1 src -> if slot != slot2 then SET(slot.(dst) , slot2.(src)) + | OP_RIGHT1 src -> SET(slot.(dst) , slot2.(src)) | OP_RIGHT2 (src1, src2) -> SET (slot.(dst) , ns.concat slot2.(src1) slot2.(src2) ) @@ -224,7 +226,8 @@ DEFINE EXEC_CODE_TEMPLATE(ns) = fun slot slot1 slot2 t dst code -> SET (slot.(dst) , ns.concat3 slot1.(src1) slot1.(src2) slot2.(src3)) | OP_LEFT1_RIGHT2 (src1, src2, src3) -> - SET (slot.(dst) , ns.concat3 slot1.(src1) slot2.(src2) slot2.(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)) @@ -276,6 +279,11 @@ 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 exec_instr = EXEC_INSTR_TEMPLATE(NodeSet.Count) let exec_code = EXEC_CODE_TEMPLATE(NodeSet.Count) @@ -283,21 +291,40 @@ module Count = 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 + | 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) + 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 exec_instr = EXEC_INSTR_TEMPLATE(NodeSet.Mat) let exec_code = EXEC_CODE_TEMPLATE(NodeSet.Mat) @@ -309,10 +336,10 @@ module Mat = 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 + | Nil -> () + | Cons(dst', code', code1') -> + exec_code slot slot1 slot2 t dst' code'; + exec slot slot1 slot2 t code1' end end diff --git a/src/runtime.ml b/src/runtime.ml index d74c26a..101aceb 100644 --- a/src/runtime.ml +++ b/src/runtime.ml @@ -116,7 +116,7 @@ module Make (U : ResJIT.S) : S with type result_set = U.NS.t = Translist.fold (fun t (a1, a2) -> let _, _, _, f = Transition.node t in let (_, _, fs1), (_, _, fs2) = Formula.st f in - (StateSet.union s1 fs1, StateSet.union s2 fs2) + (StateSet.union a1 fs1, StateSet.union a2 fs2) ) trl (StateSet.empty, StateSet.empty) in let ns1 = StateSet.inter s1 orig_s1 @@ -191,7 +191,7 @@ module Make (U : ResJIT.S) : S with type result_set = U.NS.t = DEFINE LOOP (t, states, ctx) = ( let _t = (t) in TRACE("top-down-run", 3, - __ "Entering node %i (tag %s, context %i) with states %a\n%!" + __ "Entering node %i with loop (tag %s, context %i) with states %a\n%!" (Node.to_int _t) (Tag.to_string (Tree.tag tree _t)) (Node.to_int (ctx)) @@ -205,6 +205,12 @@ DEFINE LOOP (t, states, ctx) = ( DEFINE LOOP_TAG (t, states, tag, ctx) = ( let _t = (t) in (* to avoid duplicating expression t *) + TRACE("top-down-run", 3, + __ "Entering node %i with loop_tag (tag %s, context %i) with states %a\n%!" + (Node.to_int _t) + (Tag.to_string (tag)) + (Node.to_int (ctx)) + (StateSet.print) (states)); if _t == Tree.nil then nil_res else l2jit_dispatch @@ -254,10 +260,12 @@ DEFINE LOOP_TAG (t, states, tag, ctx) = ( match instr with | L2JIT.NOP () -> nil_res | L2JIT.FIRST_CHILD s -> LOOP ((Tree.first_child tree t), s, ctx) - | L2JIT.NEXT_SIBLING s -> LOOP ((Tree.next_sibling tree t), s, ctx) +(* | L2JIT.NEXT_SIBLING s -> LOOP ((Tree.next_sibling tree t), s, ctx) *) + | L2JIT.NEXT_SIBLING s -> LOOP ((Tree.next_node_before tree t ctx), s, ctx) | L2JIT.FIRST_ELEMENT s -> LOOP ((Tree.first_element tree t), s, ctx) - | L2JIT.NEXT_ELEMENT s -> LOOP ((Tree.next_element tree t), s, ctx) +(* | L2JIT.NEXT_ELEMENT s -> LOOP ((Tree.next_element tree t), s, ctx) *) + | L2JIT.NEXT_ELEMENT s -> LOOP ((Tree.next_node_before tree t ctx), s, ctx) | L2JIT.TAGGED_DESCENDANT (s, tag) -> LOOP_TAG ((Tree.tagged_descendant tree t tag), s, tag, ctx) diff --git a/src/tracer.ml b/src/tracer.ml index eae76a5..9eae547 100644 --- a/src/tracer.ml +++ b/src/tracer.ml @@ -3,7 +3,7 @@ open Format type tracer = string type level = int -let tracers = [ "top-down-run"; "top-down-approx"; "result-set" ] +let tracers = [ "top-down-run"; "top-down-approx"; "result-set"; "level2-jit"; "res-jit" ] let active_tracers : (tracer, int) Hashtbl.t = Hashtbl.create 17 let available () = tracers @@ -21,5 +21,5 @@ let trace t l s = if l <= level t then begin fprintf !tracer_output "%s: " t; - fprintf !tracer_output "%s" s + fprintf !tracer_output "%s%!" s end diff --git a/src/tree.ml b/src/tree.ml index b801780..6bda292 100644 --- a/src/tree.ml +++ b/src/tree.ml @@ -200,6 +200,9 @@ let next_sibling t n = tree_next_sibling t.doc n external tree_next_element : tree -> [`Tree] Node.t -> [`Tree] Node.t = "caml_xml_tree_next_element" "noalloc" let next_element t n = tree_next_element t.doc n +external tree_next_node_before : tree -> [`Tree] Node.t -> [`Tree] Node.t -> [`Tree] Node.t = "caml_xml_tree_next_node_before" "noalloc" +let next_node_before t n ctx = tree_next_node_before t.doc n ctx + external tree_tagged_following_sibling : tree -> [`Tree] Node.t -> Tag.t -> [`Tree] Node.t = "caml_xml_tree_tagged_following_sibling" "noalloc" let tagged_following_sibling t n tag = tree_tagged_following_sibling t.doc n tag diff --git a/src/tree.mli b/src/tree.mli index 0eb99c7..db15525 100644 --- a/src/tree.mli +++ b/src/tree.mli @@ -29,6 +29,7 @@ val select_child : t -> node -> unordered_set -> node val next_sibling : t -> node -> node val prev_sibling : t -> node -> node val next_element : t -> node -> node +val next_node_before : t -> node -> node -> node val tagged_following_sibling : t -> node -> Tag.t -> node val select_following_sibling : t -> node -> unordered_set -> node -- 2.17.1