projects
/
tatoo.git
/ commitdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
| commitdiff |
tree
raw
|
patch
|
inline
| side by side (from parent 1:
e56b9fb
)
WIP
author
Kim Nguyễn
<kn@lri.fr>
Mon, 2 Dec 2013 21:30:43 +0000
(22:30 +0100)
committer
Kim Nguyễn
<kn@lri.fr>
Mon, 2 Dec 2013 21:30:43 +0000
(22:30 +0100)
src/ata.ml
patch
|
blob
|
history
src/run.ml
patch
|
blob
|
history
diff --git
a/src/ata.ml
b/src/ata.ml
index
565dfc8
..
8a13705
100644
(file)
--- 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 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 =
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;
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
) 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
(file)
--- a/
src/run.ml
+++ b/
src/run.ml
@@
-248,7
+248,7
@@
DEFINE AND_(t1,t2) =
| `Stay -> false, ss
in
if sum == dummy_status
| `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
|| StateSet.mem q n_sum.todo then
Unknown
else
@@
-354,6
+354,9
@@
DEFINE AND_(t1,t2) =
}
else c
in
}
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
(* 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
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 *)
(* 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
NodeStatus.make { status1.NodeStatus.node with
- rank = i;
+ rank = i
+1
;
todo = bu_todo }
else
status1
todo = bu_todo }
else
status1
@@
-389,10
+395,17
@@
DEFINE AND_(t1,t2) =
status2
end
in
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 () = 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 =
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
}
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
(* 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 *)
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 *)
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
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 =
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;
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;
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;
run.td_cache <- Cache.N5.create dummy_status;
run.bu_cache <- Cache.N5.create dummy_status;
done;