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 =
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
| `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
}
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
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
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 =
}
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
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 *)
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 =
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;