(* This program is free software; you can redistribute it and/or      *)
(* modify it under the terms of the GNU Lesser General Public License *)
(* as published by the Free Software Foundation; either version 2.1   *)
(* of the License, or (at your option) any later version.             *)
(*                                                                    *)
(* This program is distributed in the hope that it will be useful,    *)
(* but WITHOUT ANY WARRANTY; without even the implied warranty of     *)
(* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the      *)
(* GNU General Public License for more details.                       *)
(*                                                                    *)
(* You should have received a copy of the GNU Lesser General Public   *)
(* License along with this program; if not, write to the Free         *)
(* Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA *)
(* 02110-1301 USA                                                     *)
Section BDDgc.
Definition set_closed (bs : BDDstate) (marked : Map unit) :=
forall node node' : ad,
in_dom _ node marked = true ->
nodes_reachable bs node node' ->
in_dom _ node' bs = true -> in_dom _ node' marked = true.
Fixpoint add_used_nodes_1 (bs : BDDstate) (node : ad)
(marked : Map unit) (bound : nat) {struct bound} :
Map unit :=
match bound with
| O => (* Error *)  M0 unit
| S bound' =>
match MapGet _ marked node with
| None =>
match MapGet _ bs node with
| None => marked
| Some (x, (l, r)) =>
MapPut _
(add_used_nodes_1 bs r (add_used_nodes_1 bs l marked bound')
bound') node tt
end
| Some tt => marked
end
end.
Definition add_used_nodes (bs : BDDstate) (node : ad)
(marked : Map unit) :=
add_used_nodes_1 bs node marked (S (nat_of_N (bs_node_height bs node))).
Definition mark (bs : BDDstate) (used : list ad) :=
fold_right (add_used_nodes bs) (M0 unit) used.
Definition new_bs (bs : BDDstate) (used : list ad) :=
MapDomRestrTo _ _ bs (mark bs used).
Definition new_fl (bs : BDDstate) (used : list ad)
(fl : BDDfree_list) :=
MapDomRestrByApp1 _ _ (fun a0 : ad => a0) fl bs (mark bs used).
Definition used_node_bs_1 (marked : Map unit) (node : ad) :=
match MapGet _ marked node with
| Some _ => true
| None => Neqb node BDDzero || Neqb node BDDone
end.
Fixpoint clean'1_1 (pf : ad -> ad) (m' : Map unit)
(m : Map ad) {struct m} : Map ad :=
match m with
| M0 => m
| M1 a a' =>
if used_node_bs_1 m' (pf a) && used_node_bs_1 m' a' then m else M0 _
| M2 m1 m2 =>
makeM2 _ (clean'1_1 (fun a0 : ad => pf (Ndouble a0)) m' m1)
(clean'1_1 (fun a0 : ad => pf (Ndouble_plus_one a0)) m' m2)
end.
Definition clean'1 (m : Map ad) (m' : Map unit) :=
clean'1_1 (fun a : ad => a) m' m.
(* Cleans memoization table  for negation *)
Fixpoint clean'2_1 (pf : ad -> ad) (m' : Map unit)
(m : Map (Map ad)) {struct m} : Map (Map ad) :=
match m with
| M0 => m
| M1 a y =>
if used_node_bs_1 m' (pf a) then M1 _ a (clean'1 y m') else M0 _
| M2 m1 m2 =>
makeM2 _ (clean'2_1 (fun a0 : ad => pf (Ndouble a0)) m' m1)
(clean'2_1 (fun a0 : ad => pf (Ndouble_plus_one a0)) m' m2)
end.
Definition clean'2 (m : Map (Map ad)) (m' : Map unit) :=
clean'2_1 (fun a : ad => a) m' m.
(* Cleans memoization table for disjunction *)
Fixpoint clean1 (m' : Map unit) (m : Map ad) {struct m} :
Map ad :=
match m with
| M0 => m
| M1 a a' => if used_node_bs_1 m' a' then m else M0 _
| M2 m1 m2 => makeM2 _ (clean1 m' m1) (clean1 m' m2)
end.
Fixpoint clean2_1 (pf : ad -> ad) (m' : Map unit) (m : Map (Map ad))
{struct m} : Map (Map ad) :=
match m with
| M0 => m
| M1 a y => if used_node_bs_1 m' (pf a) then M1 _ a (clean1 m' y) else M0 _
| M2 m1 m2 =>
makeM2 _ (clean2_1 (fun a0 : ad => pf (Ndouble a0)) m' m1)
(clean2_1 (fun a0 : ad => pf (Ndouble_plus_one a0)) m' m2)
end.
Definition clean2 (m : Map (Map ad)) (m' : Map unit) :=
clean2_1 (fun a : ad => a) m' m.
Fixpoint clean3_1 (pf : ad -> ad) (m' : Map unit) (m : Map (Map (Map ad)))
{struct m} : Map (Map (Map ad)) :=
match m with
| M0 => m
| M1 a y => if used_node_bs_1 m' (pf a) then M1 _ a (clean2 y m') else M0 _
| M2 m1 m2 =>
makeM2 _ (clean3_1 (fun a0 : ad => pf (Ndouble a0)) m' m1)
(clean3_1 (fun a0 : ad => pf (Ndouble_plus_one a0)) m' m2)
end.
Definition clean3 (m : Map (Map (Map ad))) (m' : Map unit) :=
clean3_1 (fun a : ad => a) m' m.
(* Cleans sharing map *)
Inductive dummy_mark : Set :=
DM : Map unit -> dummy_mark.
Definition gc_0 (cfg : BDDconfig) (used : list ad) :=
match cfg with
| (bs, (share, (fl, (cnt, (negm, (orm, um)))))) =>
match DM (mark bs used) with
| DM marked =>
let bs' := MapDomRestrTo _ _ bs marked in
let fl' :=
MapDomRestrByApp1 _ _ (fun a0 : ad => a0) fl bs marked in
let share' := clean3 share marked in
let negm' := clean'1 negm marked in
let orm' := clean'2 orm marked in
let um' := clean2 um marked in
(bs', (share', (fl', (cnt, (negm', (orm', um'))))))
end
end.
Definition gc_inf (cfg : BDDconfig) (used : list ad) := cfg.
(* Temporary *)
Definition is_nil (A : Set) (l : list A) :=
match l with
| nil => true
| _ => false
end.
(* inefficient because Nleb works by converting from ad to nat *)
Definition gc_x (x : ad) (cfg : BDDconfig) :=
if is_nil _ (fst (snd (snd cfg))) && Nleb x (fst (snd (snd (snd cfg))))
then gc_0 cfg
else gc_inf cfg.
(* efficient version of gc_x *)
Definition gc_x_opt (x : ad) (cfg : BDDconfig) :=
match fl_of_cfg cfg with
| nil =>
match BDDcompare x (cnt_of_cfg cfg) with
| Datatypes.Lt => gc_0 cfg
| _ => gc_inf cfg
end
| _ => gc_inf cfg
end.

Lemma new_univm_OK :
forall (bs : BDDstate) (used : list ad) (univm : BDDuniv_memo),
BDDstate_OK bs ->
BDDuniv_memo_OK bs univm ->
BDDuniv_memo_OK (new_bs bs used) (clean2 univm (mark bs used)).