(* 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                                                     *)
Definition BDDstate := Map (BDDvar * (ad * ad)).
(* BDDstates are maps from (node) addresses to actual nodes. These nodes contain a variable, the address of the left subBDD, and the address of the right subBDD. BDDstates should obey a few invariants: *)
Definition initBDDstate := newMap (BDDvar * (ad * ad)).
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 ->
N.eqb l r = false ->
BDDbounded bs l x -> BDDbounded bs r x -> BDDbounded bs node n.
Definition BDDordered (bs : BDDstate) (node : ad) :=
match MapGet _ bs node with
| None => True
| Some (n, _) => BDDbounded bs node (ad_S n)
end.
Definition BDD_OK (bs : BDDstate) (node : ad) := BDDordered bs node.
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_map := Map (Map (Map ad)).
(* These are maps from left-hand sides l to maps from right-hand sides r to maps from BDD variables x to the address of the unique node in the given BDDstate that contains (x, (l, r)). *)
Definition initBDDsharing_map := newMap (Map (Map ad)).
Definition BDDshare_lookup (share : BDDsharing_map)
(x : BDDvar) (l r : ad) : option ad :=
match MapGet _ share l with
| None => None
| Some m1 =>
match MapGet _ m1 r with
| None => None
| Some m2 =>
match MapGet _ m2 x with
| None => None
| Some y => Some y
end
end
end.
Definition BDDshare_put (share : BDDsharing_map)
(x : BDDvar) (l r counter : ad) : BDDsharing_map :=
let m1 :=
match MapGet _ share l with
| Some y => y
| None => newMap (Map ad)
end in
let m2 :=
match MapGet _ m1 r with
| Some y => y
| None => newMap ad
end in
let m2' := MapPut _ m2 x counter in
let m1' := MapPut _ m1 r m2' in MapPut _ share l m1'.
Definition BDDsharing_OK (bs : BDDstate) (share : BDDsharing_map) :=
forall (x : BDDvar) (l r a : ad),
BDDshare_lookup share x l r = Some a <->
MapGet _ bs a = Some (x, (l, r)).
Definition BDDconfig := (BDDstate * (BDDsharing_map * ad))%type.
Definition initBDDconfig :=
(initBDDstate, (initBDDsharing_map, ad_S (ad_S N0))).
Definition BDDconfig_OK (cfg : BDDconfig) :=
match cfg return Prop with
| (bs, (share, counter)) =>
BDDstate_OK bs /\
BDDsharing_OK bs share /\
(forall a : ad, Nleb counter a = true -> MapGet _ bs a = None) /\
Nleb (ad_S (ad_S N0)) counter = true
end.
Definition BDDalloc (cfg : BDDconfig) (x : BDDvar)
(l r : ad) :=
match cfg with
| (bs, (share, counter)) =>
let share' := BDDshare_put share x l r counter in
let bs' := MapPut _ bs counter (x, (l, r)) in
let counter' := ad_S counter in (bs', (share', counter'), counter)
end.
Definition node_OK (bs : BDDstate) (node : ad) :=
node = BDDzero \/ node = BDDone \/ in_dom _ node bs = true.

Lemma BDDalloc_keeps_sharing_OK :
forall (cfg : BDDconfig) (l r : ad) (x : BDDvar),
BDDconfig_OK cfg ->
node_OK (fst cfg) l ->
node_OK (fst cfg) r ->
(forall (x' : BDDvar) (l' r' a : ad),
MapGet _ (fst cfg) a = Some (x', (l', r')) ->
(x, (l, r)) <> (x', (l', r'))) ->
BDDsharing_OK (fst (fst (BDDalloc cfg x l r)))
(fst (snd (fst (BDDalloc cfg x l r)))).