(* 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 BDD_config_1.
Definition BDDzero := N0.
Definition BDDone := Npos 1.
Definition BDDstate := Map (BDDvar * (ad * ad)).
Definition BDDsharing_map := Map (Map (Map ad)).
Definition BDDfree_list := list ad.
Definition BDDneg_memo := Map ad.
Definition BDDor_memo := Map (Map ad).
Definition BDDuniv_memo := Map (Map ad).
Definition BDDconfig :=
(BDDstate *
(BDDsharing_map *
(BDDfree_list * (ad * (BDDneg_memo * (BDDor_memo * BDDuniv_memo))))))%type.
Definition initBDDstate := newMap (BDDvar * (ad * ad)).
Definition initBDDsharing_map := newMap (Map (Map ad)).
Definition initBDDfree_list := nil (A:=ad).
Definition initBDDneg_memo := newMap ad.
Definition initBDDor_memo := newMap (Map ad).
Definition initBDDuniv_memo := newMap (Map ad).
Definition initBDDconfig :=
(initBDDstate,
(initBDDsharing_map,
(initBDDfree_list,
(Npos 2, (initBDDneg_memo, (initBDDor_memo, initBDDuniv_memo)))))).
Definition bs_node_height (bs : BDDstate) (node : ad) :=
match MapGet _ bs node with
| None => N0
| Some (x, (l, r)) => ad_S x
end.
Definition node_height (cfg : BDDconfig) (node : ad) :=
bs_node_height (fst cfg) node.
Fixpoint bool_fun_of_BDD_1 (bs : BDDstate) (node : ad)
(bound : nat) {struct bound} : bool_fun :=
match bound with
| O => (* Error *)  bool_fun_zero
| S bound' =>
match MapGet _ bs node with
| None => if Neqb node BDDzero then bool_fun_zero else bool_fun_one
| Some (x, (l, r)) =>
bool_fun_if x (bool_fun_of_BDD_1 bs r bound')
(bool_fun_of_BDD_1 bs l bound')
end
end.
Definition bool_fun_of_BDD_bs (bs : BDDstate) (node : ad) :=
bool_fun_of_BDD_1 bs node (S (nat_of_N (bs_node_height bs node))).
Definition bool_fun_of_BDD (cfg : BDDconfig) := bool_fun_of_BDD_bs (fst cfg).
Definition nodes_preserved_bs (bs bs' : BDDstate) :=
forall (x : BDDvar) (l r node : ad),
MapGet _ bs node = Some (x, (l, r)) ->
MapGet _ bs' node = Some (x, (l, r)).
Definition nodes_preserved (cfg cfg' : BDDconfig) :=
nodes_preserved_bs (fst cfg) (fst cfg').
Inductive nodes_reachable (bs : BDDstate) : ad -> ad -> Prop :=
| nodes_reachable_0 : forall node : ad, nodes_reachable bs node node
| nodes_reachable_1 :
forall (node node' l r : ad) (x : BDDvar),
MapGet _ bs node = Some (x, (l, r)) ->
nodes_reachable bs l node' -> nodes_reachable bs node node'
| nodes_reachable_2 :
forall (node node' l r : ad) (x : BDDvar),
MapGet _ bs node = Some (x, (l, r)) ->
nodes_reachable bs r node' -> nodes_reachable bs node node'.
Definition node_preserved_bs (bs bs' : BDDstate) (node : ad) :=
forall (x : BDDvar) (l r node' : ad),
nodes_reachable bs node node' ->
MapGet _ bs node' = Some (x, (l, r)) ->
MapGet _ bs' node' = Some (x, (l, r)).
Definition node_preserved (cfg cfg' : BDDconfig) :=
node_preserved_bs (fst cfg) (fst cfg').
Definition used_node_bs (bs : BDDstate) (ul : list ad)
(node : ad) :=
exists node' : ad, In node' ul /\ nodes_reachable bs node' node.
Definition used_node'_bs (bs : BDDstate) (ul : list ad)
(node : ad) := node = BDDzero \/ node = BDDone \/ used_node_bs bs ul node.
Definition used_node (cfg : BDDconfig) := used_node_bs (fst cfg).
Definition used_node' (cfg : BDDconfig) := used_node'_bs (fst cfg).
Definition node_OK (bs : BDDstate) (node : ad) :=
node = BDDzero \/ node = BDDone \/ in_dom _ node bs = true.
Definition config_node_OK (cfg : BDDconfig) := node_OK (fst cfg).
Definition no_new_node_bs (bs bs' : BDDstate) :=
forall (x : BDDvar) (l r node : ad),
MapGet _ bs' node = Some (x, (l, r)) ->
MapGet _ bs node = Some (x, (l, r)).
Definition no_new_node (cfg cfg' : BDDconfig) :=
no_new_node_bs (fst cfg) (fst cfg').
Inductive BDDbounded (bs : BDDstate) : ad -> BDDvar -> Prop :=
| BDDbounded_0 : forall n : BDDvar, BDDbounded bs BDDzero n
| BDDbounded_1 : forall n : BDDvar, BDDbounded bs BDDone n
| BDDbounded_2 :
forall (node : ad) (n x : BDDvar) (l r : ad),
MapGet _ bs node = Some (x, (l, r)) ->
BDDcompare x n = Datatypes.Lt ->
Neqb l r = false ->
BDDbounded bs l x -> BDDbounded bs r x -> BDDbounded bs node n.
Definition BDD_OK (bs : BDDstate) (node : ad) :=
match MapGet _ bs node with
| None => node = BDDzero \/ node = BDDone
| Some (n, _) => BDDbounded bs node (ad_S n)
end.
Definition BDDstate_OK (bs : BDDstate) :=
MapGet _ bs BDDzero = None /\
MapGet _ bs BDDone = None /\
(forall a : ad, in_dom _ a bs = true -> BDD_OK bs a).
Definition BDDsharing_OK (bs : BDDstate) (share : BDDsharing_map) :=
forall (x : BDDvar) (l r a : ad),
MapGet3 _ share l r x = Some a <-> MapGet _ bs a = Some (x, (l, r)).
Definition BDDfree_list_OK (bs : BDDstate) (fl : BDDfree_list)
(cnt : ad) :=
no_dup_list _ fl /\
(forall node : ad,
In node fl <->
Nleb (Npos 2) node = true /\
Nleb (ad_S node) cnt = true /\ MapGet _ bs node = None).
Definition cnt_OK (bs : BDDstate) (cnt : ad) :=
Nleb (Npos 2) cnt = true /\
(forall a : ad, Nleb cnt a = true -> MapGet _ bs a = None).
Definition BDDneg_memo_OK (bs : BDDstate) (negm : BDDneg_memo) :=
forall node node' : ad,
MapGet _ negm node = Some node' ->
node_OK bs node /\
node_OK bs node' /\
Neqb (bs_node_height bs node') (bs_node_height bs node) = true /\
bool_fun_eq (bool_fun_of_BDD_bs bs node')
(bool_fun_neg (bool_fun_of_BDD_bs bs node)).
Definition BDDor_memo_OK (bs : BDDstate) (orm : BDDor_memo) :=
forall node1 node2 node : ad,
MapGet2 _ orm node1 node2 = Some node ->
node_OK bs node1 /\
node_OK bs node2 /\
node_OK bs node /\
Nleb (bs_node_height bs node)
(BDDvar_max (bs_node_height bs node1) (bs_node_height bs node2)) = true /\
bool_fun_eq (bool_fun_of_BDD_bs bs node)
(bool_fun_or (bool_fun_of_BDD_bs bs node1) (bool_fun_of_BDD_bs bs node2)).
Definition BDDuniv_memo_OK (bs : BDDstate) (um : BDDuniv_memo) :=
forall (x : BDDvar) (node node' : ad),
MapGet2 _ um node x = Some node' ->
node_OK bs node /\
node_OK bs node' /\
Nleb (bs_node_height bs node') (bs_node_height bs node) = true /\
bool_fun_eq (bool_fun_of_BDD_bs bs node')
(bool_fun_forall x (bool_fun_of_BDD_bs bs node)).
Definition BDDconfig_OK (cfg : BDDconfig) :=
BDDstate_OK (fst cfg) /\
BDDsharing_OK (fst cfg) (fst (snd cfg)) /\
BDDfree_list_OK (fst cfg) (fst (snd (snd cfg))) (fst (snd (snd (snd cfg)))) /\
cnt_OK (fst cfg) (fst (snd (snd (snd cfg)))) /\
BDDneg_memo_OK (fst cfg) (fst (snd (snd (snd (snd cfg))))) /\
BDDor_memo_OK (fst cfg) (fst (snd (snd (snd (snd (snd cfg)))))) /\
BDDuniv_memo_OK (fst cfg) (snd (snd (snd (snd (snd (snd cfg)))))).
Definition used_list_OK_bs (bs : BDDstate) (ul : list ad) :=
forall node : ad, In node ul -> node_OK bs node.
Definition used_list_OK (cfg : BDDconfig) := used_list_OK_bs (fst cfg).
Definition used_nodes_preserved_bs (bs bs' : BDDstate)
(ul : list ad) :=
forall node : ad, In node ul -> node_preserved_bs bs bs' node.
Definition used_nodes_preserved (cfg cfg' : BDDconfig) :=
used_nodes_preserved_bs (fst cfg) (fst cfg').
Definition gc_OK (gc : BDDconfig -> list ad -> BDDconfig) :=
forall (cfg : BDDconfig) (ul : list ad),
BDDconfig_OK cfg ->
used_list_OK cfg ul ->
BDDconfig_OK (gc cfg ul) /\
used_nodes_preserved cfg (gc cfg ul) ul /\ no_new_node cfg (gc cfg ul).

Lemma nodes_preserved_node_height_eq :
forall (cfg1 cfg2 : BDDconfig) (node : ad),
BDDconfig_OK cfg1 ->
BDDconfig_OK cfg2 ->
nodes_preserved cfg1 cfg2 ->
config_node_OK cfg1 node ->
Neqb (node_height cfg2 node) (node_height cfg1 node) = true.