Add command line option to disable caching and jumping

diff --git a/src/l2JIT.ml b/src/l2JIT.ml
index efe7854..a1f1ac4 100644 (file)
--- a/src/l2JIT.ml
+++ b/src/l2JIT.ml
@@ -207,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 () -> Printf.eprintf "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 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
@@ -250,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 !Options.no_cache then add cache2 tag states op;
   op
 
 let get_transitions = function

diff --git a/src/l2JIT.mli b/src/l2JIT.mli
index c4a7578..3e1641d 100644 (file)
--- a/src/l2JIT.mli
+++ b/src/l2JIT.mli
@@ -44,3 +44,4 @@ val add : t -> int -> StateSet.Node.t -> opcode -> unit
 val compile : t -> Ata.t -> Tree.t -> TagSet.elt -> StateSet.t -> opcode
 
 val get_transitions : opcode -> Translist.t
+val init : unit -> unit

diff --git a/src/options.ml b/src/options.ml
index 1e349a6..1975212 100644 (file)
--- a/src/options.ml
+++ b/src/options.ml
@@ -14,6 +14,7 @@ let count_only = ref false
 let time = ref false
 let bottom_up = ref false
 let no_jump = ref false
+let no_cache = ref false
 let verbose = ref false
 let text_index_type = ref 0
 let do_perf = ref false
@@ -81,6 +82,9 @@ let spec = Arg.align
 
     "-nj", Arg.Set(no_jump), " disable jumping";
 
+    "-nc", Arg.Set(no_cache), " disable caching";
+
+
     "-p",  Arg.Set(do_perf), " dump perf counters (Linux only)";
 
     "-index-type", Arg.Symbol ([ "default"; "swcsa"; "rlcsa" ],

diff --git a/src/options.mli b/src/options.mli
index cfb229d..6267853 100644 (file)
--- a/src/options.mli
+++ b/src/options.mli
@@ -11,6 +11,7 @@ val time : bool ref
 val tc_threshold : int ref
 val bottom_up : bool ref
 val no_jump : bool ref
+val no_cache : bool ref
 val verbose : bool ref
 val text_index_type : int ref
 val do_perf : bool ref

diff --git a/src/runtime.ml b/src/runtime.ml
index 52583c0..46e1b01 100644 (file)
--- a/src/runtime.ml
+++ b/src/runtime.ml
@@ -152,7 +152,8 @@ module Make (U : ResJIT.S) : S with type result_set = U.NS.t =
           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
+          if not !Options.no_cache then add cache tlist s1 s2 f;
+         f
       end
 
 DEFINE LOOP (t, states, ctx) = (
@@ -295,6 +296,7 @@ DEFINE LOOP_TAG (t, states, tag, ctx) = (
 
     let top_down_run auto tree root =
       Ata.init ();
+      L2JIT.init();
       let res, slot = full_top_down_run auto auto.init tree root in
       slot.(StateSet.min_elt auto.topdown_marking_states)