WIP

[tatoo.git] / src / ata.ml

diff --git a/src/ata.ml b/src/ata.ml
index 80843e6..8a13705 100644 (file)
--- a/src/ata.ml
+++ b/src/ata.ml
@@ -206,7 +206,10 @@ end =
     let print ppf ?(sep="\n") l =
       iter (fun t ->
         let q, lab, f = Transition.node t in
-        fprintf ppf "%a, %a -> %a%s" State.print q QNameSet.print lab Formula.print f sep) l
+        fprintf ppf "%a, %a → %a%s"
+          State.print q
+          QNameSet.print lab
+          Formula.print f sep) l
   end
 
 
@@ -258,18 +261,19 @@ let print fmt a =
       []
   in
   let sorted_trs = List.stable_sort (fun (q1, s1, _) (q2, s2, _) ->
-    let c = State.compare q1 q2 in - (if c == 0 then QNameSet.compare s1 s2 else c))
+    let c = State.compare q2 q1 in if c == 0 then QNameSet.compare s2 s1 else c)
     trs
   in
   let _ = _flush_str_fmt () in
-  let strs_strings, max_pre, max_all = List.fold_left (fun (accl, accp, acca) (q, s, f) ->
-    let s1 = State.print _str_fmt q; _flush_str_fmt () in
-    let s2 = QNameSet.print _str_fmt s;  _flush_str_fmt () in
-    let s3 = Formula.print _str_fmt f;  _flush_str_fmt () in
-    let pre = Pretty.length s1 + Pretty.length s2 in
-    let all = Pretty.length s3 in
-    ( (q, s1, s2, s3) :: accl, max accp pre, max acca all)
-  ) ([], 0, 0) sorted_trs
+  let strs_strings, max_pre, max_all =
+    List.fold_left (fun (accl, accp, acca) (q, s, f) ->
+      let s1 = State.print _str_fmt q; _flush_str_fmt () in
+      let s2 = QNameSet.print _str_fmt s;  _flush_str_fmt () in
+      let s3 = Formula.print _str_fmt f;  _flush_str_fmt () in
+      let pre = Pretty.length s1 + Pretty.length s2 in
+      let all = Pretty.length s3 in
+      ( (q, s1, s2, s3) :: accl, max accp pre, max acca all)
+    ) ([], 0, 0) sorted_trs
   in
   let line = Pretty.line (max_all + max_pre + 6) in
   let prev_q = ref State.dummy in
@@ -278,7 +282,8 @@ let print fmt a =
     if !prev_q != q && !prev_q != State.dummy then fprintf fmt "%s@\n"  line;
     prev_q := q;
     fprintf fmt "%s, %s" s1 s2;
-    fprintf fmt "%s" (Pretty.padding (max_pre - Pretty.length s1 - Pretty.length s2));
+    fprintf fmt "%s"
+      (Pretty.padding (max_pre - Pretty.length s1 - Pretty.length s2));
     fprintf fmt " %s  %s@\n" Pretty.right_arrow s3;
   ) strs_strings;
   fprintf fmt "%s@\n" line
@@ -357,8 +362,10 @@ let normalize_negations auto =
   let rec flip b f =
     match Formula.expr f with
       Boolean.True | Boolean.False -> if b then f else Formula.not_ f
-    | Boolean.Or(f1, f2) -> (if b then Formula.or_ else Formula.and_)(flip b f1) (flip b f2)
-    | Boolean.And(f1, f2) -> (if b then Formula.and_ else Formula.or_)(flip b f1) (flip b f2)
+    | Boolean.Or(f1, f2) ->
+      (if b then Formula.or_ else Formula.and_)(flip b f1) (flip b f2)
+    | Boolean.And(f1, f2) ->
+      (if b then Formula.and_ else Formula.or_)(flip b f1) (flip b f2)
     | Boolean.Atom(a, b') -> begin
       match a.Atom.node with
       | Move (m,  q) ->
@@ -444,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 =
@@ -457,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
@@ -483,7 +493,6 @@ let compute_rank auto =
   done;
   let by_rank = Hashtbl.create 17 in
   List.iter (fun (r,s) ->
-    let r = r/2 in
     let set = try Hashtbl.find by_rank r with Not_found -> StateSet.empty in
     Hashtbl.replace by_rank r (StateSet.union s set)) !rank_list;
   auto.ranked_states <-