X-Git-Url: http://git.nguyen.vg/gitweb/?a=blobdiff_plain;f=src%2Fl2JIT.ml;h=c3f212e6dd7d31ac318c1a2ab46512dbf6a1dc4a;hb=refs%2Fheads%2Fmaster;hp=c15d236595c0835a7b05c376bbef2489790f88e4;hpb=762af11c30f30845ab7cd72d640ea153ed160487;p=SXSI%2Fxpathcomp.git diff --git a/src/l2JIT.ml b/src/l2JIT.ml index c15d236..c3f212e 100644 --- a/src/l2JIT.ml +++ b/src/l2JIT.ml @@ -146,6 +146,12 @@ let has_text l = Ptset.Int.mem Tag.pcdata l let rec translate_jump tree tag (jkind:Ata.jump_kind) dir s = let child, desc, sib, fol = Tree.tags tree tag in + let not_elements = + Ptset.Int.add Tag.pcdata + (Ptset.Int.add Tag.attribute + (Ptset.Int.add Tag.attribute_data + (Tree.attribute_tags tree))) + in match jkind, dir with | NIL, _ -> _nop | NODE, DIR_LEFT -> FIRST_CHILD s @@ -179,9 +185,21 @@ let rec translate_jump tree tag (jkind:Ata.jump_kind) dir s = let labels = Ptset.Int.inter l_many t in let c = Ptset.Int.cardinal labels in if c == 0 then _nop - else if c == 1 then tagged_many s (Ptset.Int.choose labels) - else if c > 5 then if has_text labels then any s else any_notext s - else select_many s labels + else + let not_t = Ptset.Int.diff l_many labels in + let () = + LOG(__ "level2-jit" 3 "Would jump for tag %s to labels %a, not relevant tags: %a" + (Tag.to_string tag) + TagSet.print (TagSet.inj_positive labels) + TagSet.print (TagSet.inj_positive not_t)) + in + if Ptset.Int.subset not_t not_elements then + if has_text labels then any s else any_notext s + else if c == 1 then tagged_many s (Ptset.Int.choose labels) + else + if c >= 5 then + if has_text labels then any s else any_notext s + else select_many s labels | CAPTURE_MANY (t), DIR_LEFT -> if Ptset.Int.is_singleton t then TAGGED_SUBTREE(s, Ptset.Int.choose t) @@ -189,26 +207,43 @@ let rec translate_jump tree tag (jkind:Ata.jump_kind) dir s = else assert false | _ -> assert false +let count = ref 0 +let () = at_exit (fun () -> Logger.verbose Format.err_formatter "Compute jump called %i times\n" !count) +module Memo = Hashtbl.Make(struct + type t = Tag.t * StateSet.t * dir + let equal (a,b,c) (d,e,f) = a == d && b == e && c == f + let hash (a, b, c) = HASHINT3(a, Uid.to_int b.StateSet.Node.id, (Obj.magic c)) +end) + +let memo = Memo.create 1024 +let init () = Memo.clear memo + let compute_jump auto tree tag states dir = - if !Options.no_jump then + if !Config.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 - LOG(__ "level2-jit" 2 - "Computed jumps for %s %a %s, from %a : %a%!" - (Tag.to_string tag) - StateSet.print states - (if dir == DIR_LEFT then "left" else "right") - Ata.print_kind jkind - print_jump jump - ); - jump + try + Memo.find memo (tag, states, dir) + with + Not_found -> begin + incr count; + let jkind = Ata.top_down_approx auto states tree in + let jump = translate_jump tree tag jkind dir states in + LOG(__ "level2-jit" 2 + "Computed jumps for %s %a %s, from %a : %a%!" + (Tag.to_string tag) + StateSet.print states + (if dir == DIR_LEFT then "left" else "right") + Ata.print_kind jkind + print_jump jump + ); + Memo.add memo (tag, states, dir) jump; jump + end let compile cache2 auto tree tag states = let tr_list, states1, states2 = - Ata.get_trans ~attributes:(TagSet.inj_positive (Tree.attribute_tags tree)) auto states tag + Ata.get_trans (*~attributes:(TagSet.inj_positive (Tree.attribute_tags tree))*) auto states tag in let op = let empty_s1 = StateSet.is_empty states1 in @@ -232,7 +267,7 @@ let compile cache2 auto tree tag states = | BOTH(tr, NOP _, r) -> RIGHT (tr, r) | _ -> op in - add cache2 tag states op; + if not !Config.no_cache then add cache2 tag states op; op let get_transitions = function