+(* [compute_dependencies auto] returns a hash table storing for each
+ states [q] a Move.table containing the set of states on which [q]
+ depends (loosely). [q] depends on [q'] if there is a transition
+ [q, {...} -> phi], where [q'] occurs in [phi].
+*)
+let compute_dependencies auto =
+ let edges = Hashtbl.create 17 in
+ StateSet.iter
+ (fun q -> Hashtbl.add edges q (Move.create_table StateSet.empty))
+ auto.starting_states;
+ Hashtbl.iter (fun q trans ->
+ let moves = try Hashtbl.find edges q with Not_found ->
+ let m = Move.create_table StateSet.empty in
+ Hashtbl.add edges q m;
+ m
+ in
+ List.iter (fun (_, phi) ->
+ let m_phi = Formula.get_states_by_move phi in
+ Move.iter (fun m set ->
+ Move.set moves m (StateSet.union set (Move.get moves m)))
+ m_phi) trans) auto.transitions;
+
+ edges
+
+
+let compute_rank auto =
+ let dependencies = compute_dependencies auto 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
+ in
+ let update_dependencies dir initacc =
+ let rec loop acc =
+ let new_acc =
+ Hashtbl.fold (fun q deps acc ->
+ let to_remove = StateSet.union acc initacc in
+ List.iter
+ (fun m ->
+ 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
+ ) dependencies acc
+ in
+ if acc == new_acc then new_acc else loop new_acc
+ in
+ let satisfied = loop StateSet.empty in
+ StateSet.iter (fun q ->
+ Hashtbl.remove dependencies q) satisfied;
+ satisfied
+ in
+ let current_states = ref StateSet.empty in
+ let rank_list = ref [] in
+ let rank = ref 0 in
+ let current_dir = ref upward in
+ let detect_cycle = ref 0 in
+ while Hashtbl.length dependencies != 0 do
+ let new_sat = update_dependencies !current_dir !current_states in
+ if StateSet.is_empty new_sat then incr detect_cycle;
+ if !detect_cycle > 2 then assert false;
+ rank_list := (!rank, new_sat) :: !rank_list;
+ rank := !rank + 1;
+ current_dir := swap !current_dir;
+ current_states := StateSet.union new_sat !current_states;
+ 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 <-
+ Array.init (Hashtbl.length by_rank) (fun i -> Hashtbl.find by_rank i)