From 3c2dcd45ebe8d5c3134c8202efe329f76ffc0b8c Mon Sep 17 00:00:00 2001
From: =?utf8?q?Kim=20Nguy=E1=BB=85n?= <kn@lri.fr>
Date: Mon, 2 Apr 2012 15:09:27 +0200
Subject: [PATCH] Optimize the bottom-up run using a Camlp4 macro instead of an
 (un-inlined) recursive call.

---
 src/runtime.ml | 71 ++++++++++++++++++++++++++------------------------
 1 file changed, 37 insertions(+), 34 deletions(-)

diff --git a/src/runtime.ml b/src/runtime.ml
index ab30f27..bc771eb 100644
--- a/src/runtime.ml
+++ b/src/runtime.ml
@@ -200,6 +200,7 @@ DEFINE LOOP_TAG (t, states, tag, ctx) = (
     l2jit_dispatch
       _t (tag) (states) (ctx) (L2JIT.find cache2 (tag) (states)))
 
+
     let top_down_run auto tree root states ctx =
       let res_len = StateSet.max_elt auto.states + 1 in
       let empty_slot = Array.create res_len U.NS.empty in
@@ -315,6 +316,15 @@ DEFINE LOOP_TAG (t, states, tag, ctx) = (
       | e1 :: ((e2 :: ll) as l) -> if e1 == e2 then uniq l
 	else e1 :: e2 :: (uniq ll);;
 
+DEFINE BOTTOM_UP_NEXT(node, rest, stop) =
+      (let ___fs = Tree.first_child tree node in
+       let ___res1 =
+	 if ___fs == Tree.nil then nil_res
+	 else full_top_down_run auto states tree ___fs
+       in
+       move_up node ___res1 true rest stop)
+
+
     let bottom_up_run auto tree (query, pat) =
       let array = time ~msg:"Timing text query" (Tree.full_text_query query tree) pat in
       let leaves = Array.to_list array in
@@ -322,43 +332,26 @@ DEFINE LOOP_TAG (t, states, tag, ctx) = (
       let res_len = (StateSet.max_elt states) + 1 in
       let empty_slot = Array.create res_len U.NS.empty in
       let nil_res = auto.bottom_states, empty_slot in
-      let cache = Cache.Lvl3.create 1024 L3JIT.dummy in
-      let rec loop_leaves l acc =
-	match l with
-	    [] -> acc
-	  | node :: ll ->
-	    let res, lll = bottom_up_next node ll Tree.nil in
-	    if (lll <> []) then
-	      begin
-		eprintf "Leftover nodes: %i\n" (List.length lll);
-	      end;
-	    res
-
-      and bottom_up_next node rest stop =
-	let fs = Tree.first_child tree node in
-	let res1 =
-	  if fs == Tree.nil then nil_res
-	  else full_top_down_run auto states tree fs
-	in
-	move_up node res1 true rest stop
-
-      and move_up node res is_left rest stop =
+      let cache = Cache.Lvl3.create 0 L3JIT.dummy in
+      let rec move_up node res is_left rest stop =
 	if node == stop then res, rest
 	else
-	  let prev_sibling = Tree.prev_sibling tree node in
-	  let is_left' = prev_sibling == Tree.nil in
-	  let real_parent = Tree.parent tree node in
-	  let parent =
-	    if is_left' then real_parent else max (Tree.first_child tree real_parent) stop
+	  (*let prev_sibling = Tree.prev_sibling tree node in *)
+	  let is_left' = Tree.is_first_child tree node (*prev_sibling == Tree.nil*) in
+	  (*TODO: unsound in case of following-sibling moves
+	    should replace the else by previous_sibling and walk up the sequence of
+	    right child moves *)
+	  let parent = if is_left' then Tree.parent tree node else
+	      let p = Tree.first_child tree (Tree.parent tree node) in
+	      if p < stop then stop else p
 	  in
-	  (* let parent = if is_left' then Tree.parent tree node else prev_sibling in *)
 	  let (s1, sl1), (s2, sl2), rest' =
 	    if is_left then match rest with
 		[] -> res, nil_res, rest
 	      | next :: rest' ->
 		if Tree.is_right_descendant tree node next
 		then
-		  let res2, rest' = bottom_up_next next rest' node in
+		  let res2, rest' = (*bottom_up_next*) BOTTOM_UP_NEXT(next, rest', node) in
 		  res, res2, rest'
 		else res, nil_res, rest
 	    else
@@ -368,13 +361,13 @@ DEFINE LOOP_TAG (t, states, tag, ctx) = (
 	  let id1 = Uid.to_int s1.StateSet.Node.id in
 	  let id2 = Uid.to_int s2.StateSet.Node.id in
 	  let code =
-	    let code = Cache.Lvl3.find cache tag id1 id2 in
-	    if code == L3JIT.dummy then
+	    let code = Cache.Lvl3.find cache id2 id1 tag in
+	    if code == L3JIT.dummy  then
 	      let trl =
 		StateSet.fold
 		  (fun q acc ->
 		    List.fold_left (fun acc' (labels, tr) ->
-		      if labels == TagSet.any || TagSet.mem tag labels
+		      if TagSet.mem tag labels
 		      then Translist.cons tr acc' else acc')
 		      acc
 		      (Hashtbl.find auto.trans q)
@@ -383,14 +376,24 @@ DEFINE LOOP_TAG (t, states, tag, ctx) = (
 		  Translist.nil
 	      in
 	      let code = L3JIT.gen_code auto trl s1 s2 in
-	      Cache.Lvl3.add cache tag id1 id2 code; code
+	      Cache.Lvl3.add cache id2 id1 tag code; code
 	    else code
 	  in
 	  let res' = code empty_slot sl1 sl2 tree node in
 	  move_up parent res' is_left' rest' stop
       in
-      let _, slot = loop_leaves leaves (nil_res) in
-      slot.(StateSet.min_elt auto.topdown_marking_states)
+      let loop_leaves l =
+	match l with
+	  [] -> nil_res
+	| node :: ll ->
+	  let res, lll = BOTTOM_UP_NEXT( (*bottom_up_next*) node, ll, Tree.nil) in
+	  if lll <> [] then
+	    Logger.print err_formatter "WARNING: Leftover nodes: %i\n" (List.length lll);
+	  res
+      in
+    let _, slot = loop_leaves leaves in
+    slot.(StateSet.min_elt auto.topdown_marking_states)
+
 
 let get_trans g auto tag states =
   StateSet.fold (fun q tr_acc ->
-- 
2.17.1