From be682346caf089e95dc3254f89119f93797813f4 Mon Sep 17 00:00:00 2001
From: =?utf8?q?Kim=20Nguy=E1=BB=85n?= <kn@lri.fr>
Date: Mon, 2 Dec 2013 22:30:43 +0100
Subject: [PATCH] WIP

---
 src/ata.ml |  9 ++++++---
 src/run.ml | 39 ++++++++++++++++++++++++++++++++-------
 2 files changed, 38 insertions(+), 10 deletions(-)

diff --git a/src/ata.ml b/src/ata.ml
index 565dfc8..8a13705 100644
--- a/src/ata.ml
+++ b/src/ata.ml
@@ -451,8 +451,11 @@ let compute_rank auto =
   let upward = [ `Stay ; `Parent ; `Previous_sibling ] in
   let downward = [ `Stay; `First_child; `Next_sibling ] in
   let swap dir = if dir == upward then downward else upward in
-  let is_satisfied q t =
-    Move.for_all (fun _ set -> StateSet.(is_empty (remove q set))) t
+  let is_satisfied dir q t =
+    Move.for_all (fun d set ->
+      if List.mem d dir then
+        StateSet.(is_empty (remove q set))
+      else StateSet.is_empty set) t
   in
   let update_dependencies dir initacc =
     let rec loop acc =
@@ -464,7 +467,7 @@ let compute_rank auto =
               Move.set deps m (StateSet.diff (Move.get deps m) to_remove)
             )
             dir;
-          if is_satisfied q deps then StateSet.add q acc else acc
+          if is_satisfied dir q deps then StateSet.add q acc else acc
         ) dependencies acc
       in
       if acc == new_acc then new_acc else loop new_acc
diff --git a/src/run.ml b/src/run.ml
index 1f59ef8..0e4e0b3 100644
--- a/src/run.ml
+++ b/src/run.ml
@@ -248,7 +248,7 @@ DEFINE AND_(t1,t2) =
                            | `Stay -> false, ss
                          in
                          if sum == dummy_status
-                           || (down && n_sum.rank < ss.NodeStatus.node.rank)
+                           (*|| (down && n_sum.rank < ss.NodeStatus.node.rank) *)
                            || StateSet.mem q n_sum.todo then
                            Unknown
                          else
@@ -354,6 +354,9 @@ DEFINE AND_(t1,t2) =
               }
           else c
         in
+        let () = Logger.msg `STATS "Run %i, Node %a, %a@\n"
+          i QName.print tag NodeStatus.print status0
+        in
         (* get the node_statuses for the first child, next sibling and parent *)
         let ps = unsafe_get_status status (T.preorder tree parent) in
         let fcs = unsafe_get_status status fc_id in
@@ -368,15 +371,18 @@ DEFINE AND_(t1,t2) =
             status1
           end
         in
+        let () = Logger.msg `STATS "Run %i, Node %a, %a@\n"
+          i QName.print tag NodeStatus.print status1
+        in
         (* recursively traverse the first child *)
         let () = loop_td_and_bu fc in
         (* here we re-enter the node from its first child,
            get the new status of the first child *)
         let fcs1 = unsafe_get_status status fc_id in
         (* update the status *)
-        let status1 = if status1.NodeStatus.node.rank < i then
+        let status1 = if status1.NodeStatus.node.rank < i+1 then
             NodeStatus.make { status1.NodeStatus.node with
-              rank = i;
+              rank = i+1;
               todo = bu_todo }
           else
             status1
@@ -389,10 +395,17 @@ DEFINE AND_(t1,t2) =
             status2
           end
         in
+        let () = Logger.msg `STATS "Run %i, Node %a, %a@\n"
+          (i+1) QName.print tag NodeStatus.print status2
+        in
         let () = loop_td_and_bu ns in
         let nss1 = unsafe_get_status status ns_id in
         if status2.NodeStatus.node.todo != StateSet.empty then
           let status3 = eval_trans auto fetch_trans_cache bu_cache tag fcs1 nss1 ps status2 in
+          let () = Logger.msg `STATS "Run %i, Node %a, %a@\n"
+            (i+1) QName.print tag NodeStatus.print status3
+          in
+
           if status3 != status2 then status.(node_id) <- status3
       end
     and loop_td_only node =
@@ -425,6 +438,10 @@ DEFINE AND_(t1,t2) =
               }
           else c
         in
+        let () = Logger.msg `STATS "Run %i, Node %a, %a@\n"
+          (i) QName.print tag NodeStatus.print status0
+        in
+
         (* get the node_statuses for the first child, next sibling and parent *)
         let ps = unsafe_get_status status (T.preorder tree parent) in
         let fcs = unsafe_get_status status fc_id in
@@ -433,6 +450,10 @@ DEFINE AND_(t1,t2) =
         if status0.NodeStatus.node.todo != StateSet.empty then begin
           let status1 = eval_trans auto fetch_trans_cache td_cache tag fcs nss ps status0 in
           (* update the cache if the status of the node changed *)
+          let () = Logger.msg `STATS "Run %i, Node %a, %a@\n"
+            (i) QName.print tag NodeStatus.print status1
+          in
+
           if status1 != status0 then status.(node_id) <- status1;
         end;
         (* recursively traverse the first child *)
@@ -440,8 +461,12 @@ DEFINE AND_(t1,t2) =
         loop_td_only ns
       end
     in
-    if bu_todo == StateSet.empty then loop_td_only (T.root tree)
-    else loop_td_and_bu (T.root tree)
+    if bu_todo == StateSet.empty then
+      let () = loop_td_only (T.root tree) in
+      run.pass <- run.pass + 1
+    else
+      let () = loop_td_and_bu (T.root tree) in
+      run.pass <- run.pass + 2
 
 
   let get_results run =
@@ -529,9 +554,9 @@ DEFINE AND_(t1,t2) =
     tree_size := T.size tree;
     let run = make auto tree in
     prepare_run run nodes;
-    for i = 0 to Ata.get_max_rank auto do
+    let rank = Ata.get_max_rank auto in
+    while run.pass <= rank do
       top_down run;
-      run.pass <- run.pass + 1;
       run.td_cache <- Cache.N5.create dummy_status;
       run.bu_cache <- Cache.N5.create dummy_status;
     done;
-- 
2.17.1