Minor code factoring.
authorKim Nguyễn <kn@lri.fr>
Fri, 20 Apr 2012 14:05:44 +0000 (16:05 +0200)
committerKim Nguyễn <kn@lri.fr>
Fri, 20 Apr 2012 14:05:44 +0000 (16:05 +0200)
Call Ata.init() before a global top-down run to clear global cache.

src/runtime.ml

index 3299675..fa92977 100644 (file)
@@ -113,55 +113,37 @@ module Make (U : ResJIT.S) : S with type result_set = U.NS.t =
           let opcode = res, code, todo_notmarking, todo_code in
           opcode
 
+       let choose_slot empty sl1 sl2 =
+         if sl1 != empty then sl1
+         else if sl2 != empty then sl2
+         else Array.copy empty
+
         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 todo_code == [] then begin
               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
+                if sl1 == empty_slot && sl2 == empty_slot then res, empty_slot
                 else
-                  let sl =
-                    if slot2_empty then
-                      if slot1_empty then
-                        Array.copy empty_slot
-                      else sl1
-                    else sl2
-                  in
+                  let sl = choose_slot empty_slot sl1 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
+              end else (* marking *) begin fun empty_slot sl1 sl2 _ node ->
+               let sl = choose_slot empty_slot sl1 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
+             end
+           end else (* todo_code *) begin fun empty_slot sl1 sl2 tree node ->
+             let sl = choose_slot empty_slot sl1 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
 
@@ -205,20 +187,20 @@ DEFINE LOOP_TAG (t, states, tag, ctx) = (
       let res_len = StateSet.max_elt auto.states + 1 in
       let empty_slot = Array.create res_len U.NS.empty in
       let nil_res = auto.bottom_states, empty_slot in
-      let cache3 = L3JIT.create () in
-      let mark_subtree  =
-        fun s subtree -> if subtree != U.NS.empty then
+
+      let mark_subtree s subtree =
+       if subtree != U.NS.empty then
           let r = Array.copy empty_slot in
           r.(auto.last) <- subtree;
-          s,r
+          s, r
         else
-          s,empty_slot
+          s, empty_slot
       in
+      let cache3 = L3JIT.create () in
       let l3jit_dispatch trl s1 s2 t sl1 sl2 =
         let f = L3JIT.find cache3 trl s1 s2 in
         if f == L3JIT.dummy then (L3JIT.cache_apply cache3 auto trl s1 s2) empty_slot sl1 sl2 tree t
         else f empty_slot sl1 sl2 tree t
-
       in
       let cache2 = L2JIT.create () in
       let rec loop t states ctx =
@@ -308,13 +290,11 @@ DEFINE LOOP_TAG (t, states, tag, ctx) = (
       r
 
     let full_top_down_run auto states tree root =
-      (*Ata.init (); *)
       top_down_run auto tree root states (Tree.closing tree root)
 
     let top_down_run auto tree root =
-      (*Ata.init (); *)
+      Ata.init ();
       let res, slot = full_top_down_run auto auto.init tree root in
-
       slot.(StateSet.min_elt auto.topdown_marking_states)
 
 
@@ -751,7 +731,7 @@ let dispatch_param1 conf id2 y0 y1 =
             else c
           in
           LOG(__ "twopass" 2 "\nTransitions are:\n%!");
-          LOG(__ "twopass" 2"\nTransitions are:\n%a\n%!" 
+          LOG(__ "twopass" 2"\nTransitions are:\n%a\n%!"
             Translist.print trans
           );
           let s1 = loop (Tree.first_child tree t) lstates ctx
@@ -788,7 +768,7 @@ let dispatch_param1 conf id2 y0 y1 =
           let trans, _, _ =
           let c = Cache.Lvl2.find cache2 (Uid.to_int states.StateSet.Node.id) tag in
             if c == dummy2 then
-              let c = Ata.get_trans  ~attributes:attributes auto states tag in 
+              let c = Ata.get_trans  ~attributes:attributes auto states tag in
               Cache.Lvl2.add cache2 (Uid.to_int states.StateSet.Node.id) tag c;
               c
             else c