Coq.IntMap.Map

# Module Coq.IntMap.Map

``

Definition of finite sets as trees indexed by adresses

`

`Require` Bool.
`Require` Sumbool.
`Require` ZArith.
`Require` Addr.
`Require` Adist.
`Require` Addec.

`Section` MapDefs.

`

We define maps from ad to A.

`
`Variable` A : Set.

`Inductive` Map : Set :=
M0 : Map
| M1 : ad -> A -> Map
| M2 : Map -> Map -> Map.

`Inductive` option : Set :=
NONE : option
| SOME : A -> option.

`Lemma` option_sum : (o:option) {y:A | o=(SOME y)}+{o=NONE}.
`Proof`.
Induction o. Right . Reflexivity.
Left . Split with a. Reflexivity.
`Qed`.

`

The semantics of maps is given by the function `MapGet`. The semantics of a map `m` is a partial, finite function from `ad` to `A`:

`

`Fixpoint` MapGet [m:Map] : ad -> option :=
Cases m of
M0 => [a:ad] NONE
| (M1 x y) => [a:ad]
if (ad_eq x a)
then (SOME y)
else NONE
| (M2 m1 m2) => [a:ad]
Cases a of
ad_z => (MapGet m1 ad_z)
| (ad_x xH) => (MapGet m2 ad_z)
| (ad_x (xO p)) => (MapGet m1 (ad_x p))
| (ad_x (xI p)) => (MapGet m2 (ad_x p))
end
end.

`Definition` newMap := M0.

`Definition` MapSingleton := M1.

`Definition` eqm := [g,g':ad->option] (a:ad) (g a)=(g' a).

`Lemma` newMap_semantics : (eqm (MapGet newMap) [a:ad] NONE).
`Proof`.
Simpl. Unfold eqm. Trivial.
`Qed`.

`Lemma` MapSingleton_semantics : (a:ad) (y:A)
(eqm (MapGet (MapSingleton a y)) [a':ad] if (ad_eq a a') then (SOME y) else NONE).
`Proof`.
Simpl. Unfold eqm. Trivial.
`Qed`.

`Lemma` M1_semantics_1 : (a:ad) (y:A) (MapGet (M1 a y) a)=(SOME y).
`Proof`.
Unfold MapGet. Intros. Rewrite (ad_eq_correct a). Reflexivity.
`Qed`.

`Lemma` M1_semantics_2 :
(a,a':ad) (y:A) (ad_eq a a')=false -> (MapGet (M1 a y) a')=NONE.
`Proof`.
Intros. Simpl. Rewrite H. Reflexivity.
`Qed`.

`Lemma` Map2_semantics_1 :
(m,m':Map) (eqm (MapGet m) [a:ad] (MapGet (M2 m m') (ad_double a))).
`Proof`.
Unfold eqm. Induction a; Trivial.
`Qed`.

`Lemma` Map2_semantics_1_eq : (m,m':Map) (f:ad->option) (eqm (MapGet (M2 m m')) f)
-> (eqm (MapGet m) [a:ad] (f (ad_double a))).
`Proof`.
Unfold eqm.
Intros.
Rewrite <- (H (ad_double a)).
Exact (Map2_semantics_1 m m' a).
`Qed`.

`Lemma` Map2_semantics_2 :
(m,m':Map) (eqm (MapGet m') [a:ad] (MapGet (M2 m m') (ad_double_plus_un a))).
`Proof`.
Unfold eqm. Induction a; Trivial.
`Qed`.

`Lemma` Map2_semantics_2_eq : (m,m':Map) (f:ad->option) (eqm (MapGet (M2 m m')) f)
-> (eqm (MapGet m') [a:ad] (f (ad_double_plus_un a))).
`Proof`.
Unfold eqm.
Intros.
Rewrite <- (H (ad_double_plus_un a)).
Exact (Map2_semantics_2 m m' a).
`Qed`.

`Lemma` MapGet_M2_bit_0_0 : (a:ad) (ad_bit_0 a)=false
-> (m,m':Map) (MapGet (M2 m m') a)=(MapGet m (ad_div_2 a)).
`Proof`.
Induction a; Trivial. Induction p. Intros. Discriminate H0.
Trivial.
Intros. Discriminate H.
`Qed`.

`Lemma` MapGet_M2_bit_0_1 : (a:ad) (ad_bit_0 a)=true
-> (m,m':Map) (MapGet (M2 m m') a)=(MapGet m' (ad_div_2 a)).
`Proof`.
Induction a. Intros. Discriminate H.
Induction p. Trivial.
Intros. Discriminate H0.
Trivial.
`Qed`.

`Lemma` MapGet_M2_bit_0_if : (m,m':Map) (a:ad) (MapGet (M2 m m') a)=
(if (ad_bit_0 a) then (MapGet m' (ad_div_2 a)) else (MapGet m (ad_div_2 a))).
`Proof`.
Intros. Elim (sumbool_of_bool (ad_bit_0 a)). Intro H. Rewrite H.
Apply MapGet_M2_bit_0_1; Assumption.
Intro H. Rewrite H. Apply MapGet_M2_bit_0_0; Assumption.
`Qed`.

`Lemma` MapGet_M2_bit_0 : (m,m',m'':Map)
(a:ad) (if (ad_bit_0 a) then (MapGet (M2 m' m) a) else (MapGet (M2 m m'') a))=
(MapGet m (ad_div_2 a)).
`Proof`.
Intros. Elim (sumbool_of_bool (ad_bit_0 a)). Intro H. Rewrite H.
Apply MapGet_M2_bit_0_1; Assumption.
Intro H. Rewrite H. Apply MapGet_M2_bit_0_0; Assumption.
`Qed`.

`Lemma` Map2_semantics_3 : (m,m':Map) (eqm (MapGet (M2 m m'))
[a:ad] Cases (ad_bit_0 a) of
false => (MapGet m (ad_div_2 a))
| true => (MapGet m' (ad_div_2 a))
end).
`Proof`.
Unfold eqm.
Induction a; Trivial.
Induction p; Trivial.
`Qed`.

`Lemma` Map2_semantics_3_eq : (m,m':Map) (f,f':ad->option)
(eqm (MapGet m) f) -> (eqm (MapGet m') f') -> (eqm (MapGet (M2 m m'))
[a:ad] Cases (ad_bit_0 a) of
false => (f (ad_div_2 a))
| true => (f' (ad_div_2 a))
end).
`Proof`.
Unfold eqm.
Intros.
Rewrite <- (H (ad_div_2 a)).
Rewrite <- (H0 (ad_div_2 a)).
Exact (Map2_semantics_3 m m' a).
`Qed`.

`Fixpoint` MapPut1 [a:ad; y:A; a':ad; y':A; p:positive] : Map :=
Cases p of
(xO p') => let m = (MapPut1 (ad_div_2 a) y (ad_div_2 a') y' p') in
Cases (ad_bit_0 a) of
false => (M2 m M0)
| true => (M2 M0 m)
end
| _ => Cases (ad_bit_0 a) of
false => (M2 (M1 (ad_div_2 a) y) (M1 (ad_div_2 a') y'))
| true => (M2 (M1 (ad_div_2 a') y') (M1 (ad_div_2 a) y))
end
end.

`Lemma` MapGet_if_commute : (b:bool) (m,m':Map) (a:ad)
(MapGet (if b then m else m') a)=(if b then (MapGet m a) else (MapGet m' a)).
`Proof`.
Intros. Case b; Trivial.
`Qed`.

`Lemma` MapGet_if_same : (m:Map) (b:bool) (a:ad)
(MapGet (if b then m else m) a)=(MapGet m a).
`Proof`.
Induction b;Trivial.
`Qed`.

`Lemma` MapGet_M2_bit_0_2 : (m,m',m'':Map)
(a:ad) (MapGet (if (ad_bit_0 a) then (M2 m m') else (M2 m' m'')) a)=
(MapGet m' (ad_div_2 a)).
`Proof`.
Intros. Rewrite MapGet_if_commute. Apply MapGet_M2_bit_0.
`Qed`.

`Lemma` MapPut1_semantics_1 : (p:positive) (a,a':ad) (y,y':A)
(ad_xor a a')=(ad_x p)
-> (MapGet (MapPut1 a y a' y' p) a)=(SOME y).
`Proof`.
Induction p. Intros. Unfold MapPut1. Rewrite MapGet_M2_bit_0_2. Apply M1_semantics_1.
Intros. Simpl. Rewrite MapGet_M2_bit_0_2. Apply H. Rewrite <- ad_xor_div_2. Rewrite H0.
Reflexivity.
Intros. Unfold MapPut1. Rewrite MapGet_M2_bit_0_2. Apply M1_semantics_1.
`Qed`.

`Lemma` MapPut1_semantics_2 : (p:positive) (a,a':ad) (y,y':A)
(ad_xor a a')=(ad_x p)
-> (MapGet (MapPut1 a y a' y' p) a')=(SOME y').
`Proof`.
Induction p. Intros. Unfold MapPut1. Rewrite (ad_neg_bit_0_2 a a' p0 H0).
Rewrite if_negb. Rewrite MapGet_M2_bit_0_2. Apply M1_semantics_1.
Intros. Simpl. Rewrite (ad_same_bit_0 a a' p0 H0). Rewrite MapGet_M2_bit_0_2.
Apply H. Rewrite <- ad_xor_div_2. Rewrite H0. Reflexivity.
Intros. Unfold MapPut1. Rewrite (ad_neg_bit_0_1 a a' H). Rewrite if_negb.
Rewrite MapGet_M2_bit_0_2. Apply M1_semantics_1.
`Qed`.

`Lemma` MapGet_M2_both_NONE : (m,m':Map) (a:ad)
(MapGet m (ad_div_2 a))=NONE -> (MapGet m' (ad_div_2 a))=NONE ->
(MapGet (M2 m m') a)=NONE.
`Proof`.
Intros. Rewrite (Map2_semantics_3 m m' a).
Case (ad_bit_0 a); Assumption.
`Qed`.
`Lemma` MapPut1_semantics_3 : (p:positive) (a,a',a0:ad) (y,y':A)
(ad_xor a a')=(ad_x p) -> (ad_eq a a0)=false -> (ad_eq a' a0)=false ->
(MapGet (MapPut1 a y a' y' p) a0)=NONE.
`Proof`.
Induction p. Intros. Unfold MapPut1. Elim (ad_neq a a0 H1). Intro. Rewrite H3. Rewrite if_negb.
Rewrite MapGet_M2_bit_0_2. Apply M1_semantics_2. Apply ad_div_bit_neq. Assumption.
Rewrite (ad_neg_bit_0_2 a a' p0 H0) in H3. Rewrite (negb_intro (ad_bit_0 a')).
Rewrite (negb_intro (ad_bit_0 a0)). Rewrite H3. Reflexivity.
Intro. Elim (ad_neq a' a0 H2). Intro. Rewrite (ad_neg_bit_0_2 a a' p0 H0). Rewrite H4.
Rewrite (negb_elim (ad_bit_0 a0)). Rewrite MapGet_M2_bit_0_2.
Apply M1_semantics_2; Assumption.
Intro; Case (ad_bit_0 a); Apply MapGet_M2_both_NONE;
Apply M1_semantics_2; Assumption.
Intros. Simpl. Elim (ad_neq a a0 H1). Intro. Rewrite H3. Rewrite if_negb.
Rewrite MapGet_M2_bit_0_2. Reflexivity.
Intro. Elim (ad_neq a' a0 H2). Intro. Rewrite (ad_same_bit_0 a a' p0 H0). Rewrite H4.
Rewrite if_negb. Rewrite MapGet_M2_bit_0_2. Reflexivity.
Intro. Cut (ad_xor (ad_div_2 a) (ad_div_2 a'))=(ad_x p0). Intro.
Case (ad_bit_0 a); Apply MapGet_M2_both_NONE; Trivial;
Apply H; Assumption.
Rewrite <- ad_xor_div_2. Rewrite H0. Reflexivity.
Intros. Simpl. Elim (ad_neq a a0 H0). Intro. Rewrite H2. Rewrite if_negb.
Rewrite MapGet_M2_bit_0_2. Apply M1_semantics_2. Apply ad_div_bit_neq. Assumption.
Rewrite (ad_neg_bit_0_1 a a' H) in H2. Rewrite (negb_intro (ad_bit_0 a')).
Rewrite (negb_intro (ad_bit_0 a0)). Rewrite H2. Reflexivity.
Intro. Elim (ad_neq a' a0 H1). Intro. Rewrite (ad_neg_bit_0_1 a a' H). Rewrite H3.
Rewrite (negb_elim (ad_bit_0 a0)). Rewrite MapGet_M2_bit_0_2.
Apply M1_semantics_2; Assumption.
Intro. Case (ad_bit_0 a); Apply MapGet_M2_both_NONE; Apply M1_semantics_2; Assumption.
`Qed`.

`Lemma` MapPut1_semantics : (p:positive) (a,a':ad) (y,y':A)
(ad_xor a a')=(ad_x p)
-> (eqm (MapGet (MapPut1 a y a' y' p))
[a0:ad] if (ad_eq a a0) then (SOME y)
else if (ad_eq a' a0) then (SOME y') else NONE).
`Proof`.
Unfold eqm. Intros. Elim (sumbool_of_bool (ad_eq a a0)). Intro H0. Rewrite H0.
Rewrite <- (ad_eq_complete ? ? H0). Exact (MapPut1_semantics_1 p a a' y y' H).
Intro H0. Rewrite H0. Elim (sumbool_of_bool (ad_eq a' a0)). Intro H1.
Rewrite <- (ad_eq_complete ? ? H1). Rewrite (ad_eq_correct a').
Exact (MapPut1_semantics_2 p a a' y y' H).
Intro H1. Rewrite H1. Exact (MapPut1_semantics_3 p a a' a0 y y' H H0 H1).
`Qed`.

`Lemma` MapPut1_semantics' : (p:positive) (a,a':ad) (y,y':A)
(ad_xor a a')=(ad_x p)
-> (eqm (MapGet (MapPut1 a y a' y' p))
[a0:ad] if (ad_eq a' a0) then (SOME y')
else if (ad_eq a a0) then (SOME y) else NONE).
`Proof`.
Unfold eqm. Intros. Rewrite (MapPut1_semantics p a a' y y' H a0).
Elim (sumbool_of_bool (ad_eq a a0)). Intro H0. Rewrite H0.
Rewrite <- (ad_eq_complete a a0 H0). Rewrite (ad_eq_comm a' a).
Rewrite (ad_xor_eq_false a a' p H). Reflexivity.
Intro H0. Rewrite H0. Reflexivity.
`Qed`.

`Fixpoint` MapPut [m:Map] : ad -> A -> Map :=
Cases m of
M0 => M1
| (M1 a y) => [a':ad; y':A]
Cases (ad_xor a a') of
ad_z => (M1 a' y')
| (ad_x p) => (MapPut1 a y a' y' p)
end
| (M2 m1 m2) => [a:ad; y:A]
Cases a of
ad_z => (M2 (MapPut m1 ad_z y) m2)
| (ad_x xH) => (M2 m1 (MapPut m2 ad_z y))
| (ad_x (xO p)) => (M2 (MapPut m1 (ad_x p) y) m2)
| (ad_x (xI p)) => (M2 m1 (MapPut m2 (ad_x p) y))
end
end.

`Lemma` MapPut_semantics_1 : (a:ad) (y:A) (a0:ad)
(MapGet (MapPut M0 a y) a0)=(MapGet (M1 a y) a0).
`Proof`.
Trivial.
`Qed`.

`Lemma` MapPut_semantics_2_1 : (a:ad) (y,y':A) (a0:ad)
(MapGet (MapPut (M1 a y) a y') a0)=(if (ad_eq a a0) then (SOME y') else NONE).
`Proof`.
Simpl. Intros. Rewrite (ad_xor_nilpotent a). Trivial.
`Qed`.

`Lemma` MapPut_semantics_2_2 : (a,a':ad) (y,y':A) (a0:ad) (a'':ad) (ad_xor a a')=a'' ->
(MapGet (MapPut (M1 a y) a' y') a0)=
(if (ad_eq a' a0) then (SOME y') else
if (ad_eq a a0) then (SOME y) else NONE).
`Proof`.
Induction a''. Intro. Rewrite (ad_xor_eq ? ? H). Rewrite MapPut_semantics_2_1.
Case (ad_eq a' a0); Trivial.
Intros. Simpl. Rewrite H. Rewrite (MapPut1_semantics p a a' y y' H a0).
Elim (sumbool_of_bool (ad_eq a a0)). Intro H0. Rewrite H0. Rewrite <- (ad_eq_complete ? ? H0).
Rewrite (ad_eq_comm a' a). Rewrite (ad_xor_eq_false ? ? ? H). Reflexivity.
Intro H0. Rewrite H0. Reflexivity.
`Qed`.

`Lemma` MapPut_semantics_2 : (a,a':ad) (y,y':A) (a0:ad)
(MapGet (MapPut (M1 a y) a' y') a0)=
(if (ad_eq a' a0) then (SOME y') else
if (ad_eq a a0) then (SOME y) else NONE).
`Proof`.
Intros. Apply MapPut_semantics_2_2 with a'':=(ad_xor a a'); Trivial.
`Qed`.

`Lemma` MapPut_semantics_3_1 : (m,m':Map) (a:ad) (y:A)
(MapPut (M2 m m') a y)=(if (ad_bit_0 a) then (M2 m (MapPut m' (ad_div_2 a) y))
else (M2 (MapPut m (ad_div_2 a) y) m')).
`Proof`.
Induction a. Trivial.
Induction p; Trivial.
`Qed`.

`Lemma` MapPut_semantics : (m:Map) (a:ad) (y:A)
(eqm (MapGet (MapPut m a y)) [a':ad] if (ad_eq a a') then (SOME y) else (MapGet m a')).
`Proof`.
Unfold eqm. Induction m. Exact MapPut_semantics_1.
Intros. Unfold 2 MapGet. Apply MapPut_semantics_2; Assumption.
Intros. Rewrite MapPut_semantics_3_1. Rewrite (MapGet_M2_bit_0_if m0 m1 a0).
Elim (sumbool_of_bool (ad_bit_0 a)). Intro H1. Rewrite H1. Rewrite MapGet_M2_bit_0_if.
Elim (sumbool_of_bool (ad_bit_0 a0)). Intro H2. Rewrite H2.
Rewrite (H0 (ad_div_2 a) y (ad_div_2 a0)). Elim (sumbool_of_bool (ad_eq a a0)).
Intro H3. Rewrite H3. Rewrite (ad_div_eq ? ? H3). Reflexivity.
Intro H3. Rewrite H3. Rewrite <- H2 in H1. Rewrite (ad_div_bit_neq ? ? H3 H1). Reflexivity.
Intro H2. Rewrite H2. Rewrite (ad_eq_comm a a0). Rewrite (ad_bit_0_neq a0 a H2 H1).
Reflexivity.
Intro H1. Rewrite H1. Rewrite MapGet_M2_bit_0_if. Elim (sumbool_of_bool (ad_bit_0 a0)).
Intro H2. Rewrite H2. Rewrite (ad_bit_0_neq a a0 H1 H2). Reflexivity.
Intro H2. Rewrite H2. Rewrite (H (ad_div_2 a) y (ad_div_2 a0)).
Elim (sumbool_of_bool (ad_eq a a0)). Intro H3. Rewrite H3.
Rewrite (ad_div_eq a a0 H3). Reflexivity.
Intro H3. Rewrite H3. Rewrite <- H2 in H1. Rewrite (ad_div_bit_neq a a0 H3 H1). Reflexivity.
`Qed`.

`Fixpoint` MapPut_behind [m:Map] : ad -> A -> Map :=
Cases m of
M0 => M1
| (M1 a y) => [a':ad; y':A]
Cases (ad_xor a a') of
ad_z => m
| (ad_x p) => (MapPut1 a y a' y' p)
end
| (M2 m1 m2) => [a:ad; y:A]
Cases a of
ad_z => (M2 (MapPut_behind m1 ad_z y) m2)
| (ad_x xH) => (M2 m1 (MapPut_behind m2 ad_z y))
| (ad_x (xO p)) => (M2 (MapPut_behind m1 (ad_x p) y) m2)
| (ad_x (xI p)) => (M2 m1 (MapPut_behind m2 (ad_x p) y))
end
end.

`Lemma` MapPut_behind_semantics_3_1 : (m,m':Map) (a:ad) (y:A)
(MapPut_behind (M2 m m') a y)=
(if (ad_bit_0 a) then (M2 m (MapPut_behind m' (ad_div_2 a) y))
else (M2 (MapPut_behind m (ad_div_2 a) y) m')).
`Proof`.
Induction a. Trivial.
Induction p; Trivial.
`Qed`.

`Lemma` MapPut_behind_as_before_1 : (a,a',a0:ad) (ad_eq a' a0)=false ->
(y,y':A) (MapGet (MapPut (M1 a y) a' y') a0)
=(MapGet (MapPut_behind (M1 a y) a' y') a0).
`Proof`.
Intros a a' a0. Simpl. Intros H y y'. Elim (ad_sum (ad_xor a a')). Intro H0. Elim H0.
Intros p H1. Rewrite H1. Reflexivity.
Intro H0. Rewrite H0. Rewrite (ad_xor_eq ? ? H0). Rewrite (M1_semantics_2 a' a0 y H).
Exact (M1_semantics_2 a' a0 y' H).
`Qed`.

`Lemma` MapPut_behind_as_before : (m:Map) (a:ad) (y:A)
(a0:ad) (ad_eq a a0)=false ->
(MapGet (MapPut m a y) a0)=(MapGet (MapPut_behind m a y) a0).
`Proof`.
Induction m. Trivial.
Intros a y a' y' a0 H. Exact (MapPut_behind_as_before_1 a a' a0 H y y').
Intros. Rewrite MapPut_semantics_3_1. Rewrite MapPut_behind_semantics_3_1.
Elim (sumbool_of_bool (ad_bit_0 a)). Intro H2. Rewrite H2. Rewrite MapGet_M2_bit_0_if.
Rewrite MapGet_M2_bit_0_if. Elim (sumbool_of_bool (ad_bit_0 a0)). Intro H3.
Rewrite H3. Apply H0. Rewrite <- H3 in H2. Exact (ad_div_bit_neq a a0 H1 H2).
Intro H3. Rewrite H3. Reflexivity.
Intro H2. Rewrite H2. Rewrite MapGet_M2_bit_0_if. Rewrite MapGet_M2_bit_0_if.
Elim (sumbool_of_bool (ad_bit_0 a0)). Intro H3. Rewrite H3. Reflexivity.
Intro H3. Rewrite H3. Apply H. Rewrite <- H3 in H2. Exact (ad_div_bit_neq a a0 H1 H2).
`Qed`.

`Lemma` MapPut_behind_new : (m:Map) (a:ad) (y:A)
(MapGet (MapPut_behind m a y) a)=(Cases (MapGet m a) of
(SOME y') => (SOME y')
| _ => (SOME y)
end).
`Proof`.
Induction m. Simpl. Intros. Rewrite (ad_eq_correct a). Reflexivity.
Intros. Elim (ad_sum (ad_xor a a1)). Intro H. Elim H. Intros p H0. Simpl.
Rewrite H0. Rewrite (ad_xor_eq_false a a1 p). Exact (MapPut1_semantics_2 p a a1 a0 y H0).
Assumption.
Intro H. Simpl. Rewrite H. Rewrite <- (ad_xor_eq ? ? H). Rewrite (ad_eq_correct a).
Exact (M1_semantics_1 a a0).
Intros. Rewrite MapPut_behind_semantics_3_1. Rewrite (MapGet_M2_bit_0_if m0 m1 a).
Elim (sumbool_of_bool (ad_bit_0 a)). Intro H1. Rewrite H1. Rewrite (MapGet_M2_bit_0_1 a H1).
Exact (H0 (ad_div_2 a) y).
Intro H1. Rewrite H1. Rewrite (MapGet_M2_bit_0_0 a H1). Exact (H (ad_div_2 a) y).
`Qed`.

`Lemma` MapPut_behind_semantics : (m:Map) (a:ad) (y:A)
(eqm (MapGet (MapPut_behind m a y))
[a':ad] Cases (MapGet m a') of
(SOME y') => (SOME y')
| _ => if (ad_eq a a') then (SOME y) else NONE
end).
`Proof`.
Unfold eqm. Intros. Elim (sumbool_of_bool (ad_eq a a0)). Intro H. Rewrite H.
Rewrite (ad_eq_complete ? ? H). Apply MapPut_behind_new.
Intro H. Rewrite H. Rewrite <- (MapPut_behind_as_before m a y a0 H).
Rewrite (MapPut_semantics m a y a0). Rewrite H. Case (MapGet m a0); Trivial.
`Qed`.

`Definition` makeM2 := [m,m':Map] Cases m m' of
M0 M0 => M0
| M0 (M1 a y) => (M1 (ad_double_plus_un a) y)
| (M1 a y) M0 => (M1 (ad_double a) y)
| _ _ => (M2 m m')
end.

`Lemma` makeM2_M2 : (m,m':Map) (eqm (MapGet (makeM2 m m')) (MapGet (M2 m m'))).
`Proof`.
Unfold eqm. Intros. Elim (sumbool_of_bool (ad_bit_0 a)). Intro H.
Rewrite (MapGet_M2_bit_0_1 a H m m'). Case m'. Case m. Reflexivity.
Intros a0 y. Simpl. Rewrite (ad_bit_0_1_not_double a H a0). Reflexivity.
Intros m1 m2. Unfold makeM2. Rewrite MapGet_M2_bit_0_1. Reflexivity.
Assumption.
Case m. Intros a0 y. Simpl. Elim (sumbool_of_bool (ad_eq a0 (ad_div_2 a))).
Intro H0. Rewrite H0. Rewrite (ad_eq_complete ? ? H0). Rewrite (ad_div_2_double_plus_un a H).
Rewrite (ad_eq_correct a). Reflexivity.
Intro H0. Rewrite H0. Rewrite (ad_eq_comm a0 (ad_div_2 a)) in H0.
Rewrite (ad_not_div_2_not_double_plus_un a a0 H0). Reflexivity.
Intros a0 y0 a1 y1. Unfold makeM2. Rewrite MapGet_M2_bit_0_1. Reflexivity.
Assumption.
Intros m1 m2 a0 y. Unfold makeM2. Rewrite MapGet_M2_bit_0_1. Reflexivity.
Assumption.
Intros m1 m2. Unfold makeM2.
Cut (MapGet (M2 m (M2 m1 m2)) a)=(MapGet (M2 m1 m2) (ad_div_2 a)).
Case m; Trivial.
Exact (MapGet_M2_bit_0_1 a H m (M2 m1 m2)).
Intro H. Rewrite (MapGet_M2_bit_0_0 a H m m'). Case m. Case m'. Reflexivity.
Intros a0 y. Simpl. Rewrite (ad_bit_0_0_not_double_plus_un a H a0). Reflexivity.
Intros m1 m2. Unfold makeM2. Rewrite MapGet_M2_bit_0_0. Reflexivity.
Assumption.
Case m'. Intros a0 y. Simpl. Elim (sumbool_of_bool (ad_eq a0 (ad_div_2 a))). Intro H0.
Rewrite H0. Rewrite (ad_eq_complete ? ? H0). Rewrite (ad_div_2_double a H).
Rewrite (ad_eq_correct a). Reflexivity.
Intro H0. Rewrite H0. Rewrite (ad_eq_comm (ad_double a0) a).
Rewrite (ad_eq_comm a0 (ad_div_2 a)) in H0. Rewrite (ad_not_div_2_not_double a a0 H0).
Reflexivity.
Intros a0 y0 a1 y1. Unfold makeM2. Rewrite MapGet_M2_bit_0_0. Reflexivity.
Assumption.
Intros m1 m2 a0 y. Unfold makeM2. Rewrite MapGet_M2_bit_0_0. Reflexivity.
Assumption.
Intros m1 m2. Unfold makeM2. Exact (MapGet_M2_bit_0_0 a H (M2 m1 m2) m').
`Qed`.

`Fixpoint` MapRemove [m:Map] : ad -> Map :=
Cases m of
M0 => [_:ad] M0
| (M1 a y) => [a':ad]
Cases (ad_eq a a') of
true => M0
| false => m
end
| (M2 m1 m2) => [a:ad]
if (ad_bit_0 a)
then (makeM2 m1 (MapRemove m2 (ad_div_2 a)))
else (makeM2 (MapRemove m1 (ad_div_2 a)) m2)
end.

`Lemma` MapRemove_semantics : (m:Map) (a:ad)
(eqm (MapGet (MapRemove m a)) [a':ad] if (ad_eq a a') then NONE else (MapGet m a')).
`Proof`.
Unfold eqm. Induction m. Simpl. Intros. Case (ad_eq a a0); Trivial.
Intros. Simpl. Elim (sumbool_of_bool (ad_eq a1 a2)). Intro H. Rewrite H.
Elim (sumbool_of_bool (ad_eq a a1)). Intro H0. Rewrite H0. Reflexivity.
Intro H0. Rewrite H0. Rewrite (ad_eq_complete ? ? H) in H0. Exact (M1_semantics_2 a a2 a0 H0).
Intro H. Elim (sumbool_of_bool (ad_eq a a1)). Intro H0. Rewrite H0. Rewrite H.
Rewrite <- (ad_eq_complete ? ? H0) in H. Rewrite H. Reflexivity.
Intro H0. Rewrite H0. Rewrite H. Reflexivity.
Intros. Change (MapGet (if (ad_bit_0 a)
then (makeM2 m0 (MapRemove m1 (ad_div_2 a)))
else (makeM2 (MapRemove m0 (ad_div_2 a)) m1))
a0)
=(if (ad_eq a a0) then NONE else (MapGet (M2 m0 m1) a0)).
Elim (sumbool_of_bool (ad_bit_0 a)). Intro H1. Rewrite H1.
Rewrite (makeM2_M2 m0 (MapRemove m1 (ad_div_2 a)) a0). Elim (sumbool_of_bool (ad_bit_0 a0)).
Intro H2. Rewrite MapGet_M2_bit_0_1. Rewrite (H0 (ad_div_2 a) (ad_div_2 a0)).
Elim (sumbool_of_bool (ad_eq a a0)). Intro H3. Rewrite H3. Rewrite (ad_div_eq ? ? H3).
Reflexivity.
Intro H3. Rewrite H3. Rewrite <- H2 in H1. Rewrite (ad_div_bit_neq ? ? H3 H1).
Rewrite (MapGet_M2_bit_0_1 a0 H2 m0 m1). Reflexivity.
Assumption.
Intro H2. Rewrite (MapGet_M2_bit_0_0 a0 H2 m0 (MapRemove m1 (ad_div_2 a))).
Rewrite (ad_eq_comm a a0). Rewrite (ad_bit_0_neq ? ? H2 H1).
Rewrite (MapGet_M2_bit_0_0 a0 H2 m0 m1). Reflexivity.
Intro H1. Rewrite H1. Rewrite (makeM2_M2 (MapRemove m0 (ad_div_2 a)) m1 a0).
Elim (sumbool_of_bool (ad_bit_0 a0)). Intro H2. Rewrite MapGet_M2_bit_0_1.
Rewrite (MapGet_M2_bit_0_1 a0 H2 m0 m1). Rewrite (ad_bit_0_neq a a0 H1 H2). Reflexivity.
Assumption.
Intro H2. Rewrite MapGet_M2_bit_0_0. Rewrite (H (ad_div_2 a) (ad_div_2 a0)).
Rewrite (MapGet_M2_bit_0_0 a0 H2 m0 m1). Elim (sumbool_of_bool (ad_eq a a0)). Intro H3.
Rewrite H3. Rewrite (ad_div_eq ? ? H3). Reflexivity.
Intro H3. Rewrite H3. Rewrite <- H2 in H1. Rewrite (ad_div_bit_neq ? ? H3 H1). Reflexivity.
Assumption.
`Qed`.

`Fixpoint` MapCard [m:Map] : nat :=
Cases m of
M0 => O
| (M1 _ _) => (S O)
| (M2 m m') => (plus (MapCard m) (MapCard m'))
end.

`Fixpoint` MapMerge [m:Map] : Map -> Map :=
Cases m of
M0 => [m':Map] m'
| (M1 a y) => [m':Map] (MapPut_behind m' a y)
| (M2 m1 m2) => [m':Map] Cases m' of
M0 => m
| (M1 a' y') => (MapPut m a' y')
| (M2 m'1 m'2) => (M2 (MapMerge m1 m'1)
(MapMerge m2 m'2))
end
end.

`Lemma` MapMerge_semantics : (m,m':Map)
(eqm (MapGet (MapMerge m m'))
[a0:ad] Cases (MapGet m' a0) of
(SOME y') => (SOME y')
| NONE => (MapGet m a0)
end).
`Proof`.
Unfold eqm. Induction m. Intros. Simpl. Case (MapGet m' a); Trivial.
Intros. Simpl. Rewrite (MapPut_behind_semantics m' a a0 a1). Reflexivity.
Induction m'. Trivial.
Intros. Unfold MapMerge. Rewrite (MapPut_semantics (M2 m0 m1) a a0 a1).
Elim (sumbool_of_bool (ad_eq a a1)). Intro H1. Rewrite H1. Rewrite (ad_eq_complete ? ? H1).
Rewrite (M1_semantics_1 a1 a0). Reflexivity.
Intro H1. Rewrite H1. Rewrite (M1_semantics_2 a a1 a0 H1). Reflexivity.
Intros. Cut (MapMerge (M2 m0 m1) (M2 m2 m3))=(M2 (MapMerge m0 m2) (MapMerge m1 m3)).
Intro. Rewrite H3. Rewrite MapGet_M2_bit_0_if. Rewrite (H0 m3 (ad_div_2 a)).
Rewrite (H m2 (ad_div_2 a)). Rewrite (MapGet_M2_bit_0_if m2 m3 a).
Rewrite (MapGet_M2_bit_0_if m0 m1 a). Case (ad_bit_0 a); Trivial.
Reflexivity.
`Qed`.

`

`MapInter`, `MapRngRestrTo`, `MapRngRestrBy`, `MapInverse` not implemented: need a decidable equality on `A`.

`

`Fixpoint` MapDelta [m:Map] : Map -> Map :=
Cases m of
M0 => [m':Map] m'
| (M1 a y) => [m':Map] Cases (MapGet m' a) of
NONE => (MapPut m' a y)
| _ => (MapRemove m' a)
end
| (M2 m1 m2) => [m':Map] Cases m' of
M0 => m
| (M1 a' y') => Cases (MapGet m a') of
NONE => (MapPut m a' y')
| _ => (MapRemove m a')
end
| (M2 m'1 m'2) => (makeM2 (MapDelta m1 m'1)
(MapDelta m2 m'2))
end
end.

`Lemma` MapDelta_semantics_comm : (m,m':Map)
(eqm (MapGet (MapDelta m m')) (MapGet (MapDelta m' m))).
`Proof`.
Unfold eqm. Induction m. Induction m'; Reflexivity.
Induction m'. Reflexivity.
Unfold MapDelta. Intros. Elim (sumbool_of_bool (ad_eq a a1)). Intro H.
Rewrite <- (ad_eq_complete ? ? H). Rewrite (M1_semantics_1 a a2).
Rewrite (M1_semantics_1 a a0). Simpl. Rewrite (ad_eq_correct a). Reflexivity.
Intro H. Rewrite (M1_semantics_2 a a1 a0 H). Rewrite (ad_eq_comm a a1) in H.
Rewrite (M1_semantics_2 a1 a a2 H). Rewrite (MapPut_semantics (M1 a a0) a1 a2 a3).
Rewrite (MapPut_semantics (M1 a1 a2) a a0 a3). Elim (sumbool_of_bool (ad_eq a a3)).
Intro H0. Rewrite H0. Rewrite (ad_eq_complete ? ? H0) in H. Rewrite H.
Rewrite (ad_eq_complete ? ? H0). Rewrite (M1_semantics_1 a3 a0). Reflexivity.
Intro H0. Rewrite H0. Rewrite (M1_semantics_2 a a3 a0 H0).
Elim (sumbool_of_bool (ad_eq a1 a3)). Intro H1. Rewrite H1.
Rewrite (ad_eq_complete ? ? H1). Exact (M1_semantics_1 a3 a2).
Intro H1. Rewrite H1. Exact (M1_semantics_2 a1 a3 a2 H1).
Intros. Reflexivity.
Induction m'. Reflexivity.
Reflexivity.
Intros. Simpl. Rewrite (makeM2_M2 (MapDelta m0 m2) (MapDelta m1 m3) a).
Rewrite (makeM2_M2 (MapDelta m2 m0) (MapDelta m3 m1) a).
Rewrite (MapGet_M2_bit_0_if (MapDelta m0 m2) (MapDelta m1 m3) a).
Rewrite (MapGet_M2_bit_0_if (MapDelta m2 m0) (MapDelta m3 m1) a).
Rewrite (H0 m3 (ad_div_2 a)). Rewrite (H m2 (ad_div_2 a)). Reflexivity.
`Qed`.

`Lemma` MapDelta_semantics_1_1 : (a:ad) (y:A) (m':Map) (a0:ad)
(MapGet (M1 a y) a0)=NONE -> (MapGet m' a0)=NONE ->
(MapGet (MapDelta (M1 a y) m') a0)=NONE.
`Proof`.
Intros. Unfold MapDelta. Elim (sumbool_of_bool (ad_eq a a0)). Intro H1.
Rewrite (ad_eq_complete ? ? H1) in H. Rewrite (M1_semantics_1 a0 y) in H. Discriminate H.
Intro H1. Case (MapGet m' a). Rewrite (MapPut_semantics m' a y a0). Rewrite H1. Assumption.
Rewrite (MapRemove_semantics m' a a0). Rewrite H1. Trivial.
`Qed`.

`Lemma` MapDelta_semantics_1 : (m,m':Map) (a:ad)
(MapGet m a)=NONE -> (MapGet m' a)=NONE ->
(MapGet (MapDelta m m') a)=NONE.
`Proof`.
Induction m. Trivial.
Exact MapDelta_semantics_1_1.
Induction m'. Trivial.
Intros. Rewrite (MapDelta_semantics_comm (M2 m0 m1) (M1 a a0) a1).
Apply MapDelta_semantics_1_1; Trivial.
Intros. Simpl. Rewrite (makeM2_M2 (MapDelta m0 m2) (MapDelta m1 m3) a).
Rewrite MapGet_M2_bit_0_if. Elim (sumbool_of_bool (ad_bit_0 a)). Intro H5. Rewrite H5.
Apply H0. Rewrite (MapGet_M2_bit_0_1 a H5 m0 m1) in H3. Exact H3.
Rewrite (MapGet_M2_bit_0_1 a H5 m2 m3) in H4. Exact H4.
Intro H5. Rewrite H5. Apply H. Rewrite (MapGet_M2_bit_0_0 a H5 m0 m1) in H3. Exact H3.
Rewrite (MapGet_M2_bit_0_0 a H5 m2 m3) in H4. Exact H4.
`Qed`.

`Lemma` MapDelta_semantics_2_1 : (a:ad) (y:A) (m':Map) (a0:ad) (y0:A)
(MapGet (M1 a y) a0)=NONE -> (MapGet m' a0)=(SOME y0) ->
(MapGet (MapDelta (M1 a y) m') a0)=(SOME y0).
`Proof`.
Intros. Unfold MapDelta. Elim (sumbool_of_bool (ad_eq a a0)). Intro H1.
Rewrite (ad_eq_complete ? ? H1) in H. Rewrite (M1_semantics_1 a0 y) in H. Discriminate H.
Intro H1. Case (MapGet m' a). Rewrite (MapPut_semantics m' a y a0). Rewrite H1. Assumption.
Rewrite (MapRemove_semantics m' a a0). Rewrite H1. Trivial.
`Qed`.

`Lemma` MapDelta_semantics_2_2 : (a:ad) (y:A) (m':Map) (a0:ad) (y0:A)
(MapGet (M1 a y) a0)=(SOME y0) -> (MapGet m' a0)=NONE ->
(MapGet (MapDelta (M1 a y) m') a0)=(SOME y0).
`Proof`.
Intros. Unfold MapDelta. Elim (sumbool_of_bool (ad_eq a a0)). Intro H1.
Rewrite (ad_eq_complete ? ? H1) in H. Rewrite (ad_eq_complete ? ? H1).
Rewrite H0. Rewrite (MapPut_semantics m' a0 y a0). Rewrite (ad_eq_correct a0).
Rewrite (M1_semantics_1 a0 y) in H. Simple Inversion H. Assumption.
Intro H1. Rewrite (M1_semantics_2 a a0 y H1) in H. Discriminate H.
`Qed`.

`Lemma` MapDelta_semantics_2 : (m,m':Map) (a:ad) (y:A)
(MapGet m a)=NONE -> (MapGet m' a)=(SOME y) ->
(MapGet (MapDelta m m') a)=(SOME y).
`Proof`.
Induction m. Trivial.
Exact MapDelta_semantics_2_1.
Induction m'. Intros. Discriminate H2.
Intros. Rewrite (MapDelta_semantics_comm (M2 m0 m1) (M1 a a0) a1).
Apply MapDelta_semantics_2_2; Assumption.
Intros. Simpl. Rewrite (makeM2_M2 (MapDelta m0 m2) (MapDelta m1 m3) a).
Rewrite MapGet_M2_bit_0_if. Elim (sumbool_of_bool (ad_bit_0 a)). Intro H5. Rewrite H5.
Apply H0. Rewrite <- (MapGet_M2_bit_0_1 a H5 m0 m1). Assumption.
Rewrite <- (MapGet_M2_bit_0_1 a H5 m2 m3). Assumption.
Intro H5. Rewrite H5. Apply H. Rewrite <- (MapGet_M2_bit_0_0 a H5 m0 m1). Assumption.
Rewrite <- (MapGet_M2_bit_0_0 a H5 m2 m3). Assumption.
`Qed`.

`Lemma` MapDelta_semantics_3_1 : (a0:ad) (y0:A) (m':Map) (a:ad) (y,y':A)
(MapGet (M1 a0 y0) a)=(SOME y) -> (MapGet m' a)=(SOME y') ->
(MapGet (MapDelta (M1 a0 y0) m') a)=NONE.
`Proof`.
Intros. Unfold MapDelta. Elim (sumbool_of_bool (ad_eq a0 a)). Intro H1.
Rewrite (ad_eq_complete a0 a H1). Rewrite H0. Rewrite (MapRemove_semantics m' a a).
Rewrite (ad_eq_correct a). Reflexivity.
Intro H1. Rewrite (M1_semantics_2 a0 a y0 H1) in H. Discriminate H.
`Qed`.

`Lemma` MapDelta_semantics_3 : (m,m':Map) (a:ad) (y,y':A)
(MapGet m a)=(SOME y) -> (MapGet m' a)=(SOME y') ->
(MapGet (MapDelta m m') a)=NONE.
`Proof`.
Induction m. Intros. Discriminate H.
Exact MapDelta_semantics_3_1.
Induction m'. Intros. Discriminate H2.
Intros. Rewrite (MapDelta_semantics_comm (M2 m0 m1) (M1 a a0) a1).
Exact (MapDelta_semantics_3_1 a a0 (M2 m0 m1) a1 y' y H2 H1).
Intros. Simpl. Rewrite (makeM2_M2 (MapDelta m0 m2) (MapDelta m1 m3) a).
Rewrite MapGet_M2_bit_0_if. Elim (sumbool_of_bool (ad_bit_0 a)). Intro H5. Rewrite H5.
Apply (H0 m3 (ad_div_2 a) y y'). Rewrite <- (MapGet_M2_bit_0_1 a H5 m0 m1). Assumption.
Rewrite <- (MapGet_M2_bit_0_1 a H5 m2 m3). Assumption.
Intro H5. Rewrite H5. Apply (H m2 (ad_div_2 a) y y').
Rewrite <- (MapGet_M2_bit_0_0 a H5 m0 m1). Assumption.
Rewrite <- (MapGet_M2_bit_0_0 a H5 m2 m3). Assumption.
`Qed`.

`Lemma` MapDelta_semantics : (m,m':Map)
(eqm (MapGet (MapDelta m m'))
[a0:ad] Cases (MapGet m a0) (MapGet m' a0) of
NONE (SOME y') => (SOME y')
| (SOME y) NONE => (SOME y)
| _ _ => NONE
end).
`Proof`.
Unfold eqm. Intros. Elim (option_sum (MapGet m' a)). Intro H. Elim H. Intros a0 H0.
Rewrite H0. Elim (option_sum (MapGet m a)). Intro H1. Elim H1. Intros a1 H2. Rewrite H2.
Exact (MapDelta_semantics_3 m m' a a1 a0 H2 H0).
Intro H1. Rewrite H1. Exact (MapDelta_semantics_2 m m' a a0 H1 H0).
Intro H. Rewrite H. Elim (option_sum (MapGet m a)). Intro H0. Elim H0. Intros a0 H1.
Rewrite H1. Rewrite (MapDelta_semantics_comm m m' a).
Exact (MapDelta_semantics_2 m' m a a0 H H1).
Intro H0. Rewrite H0. Exact (MapDelta_semantics_1 m m' a H0 H).
`Qed`.

`Definition` MapEmptyp := [m:Map]
Cases m of
M0 => true
| _ => false
end.

`Lemma` MapEmptyp_correct : (MapEmptyp M0)=true.
`Proof`.
Reflexivity.
`Qed`.

`Lemma` MapEmptyp_complete : (m:Map) (MapEmptyp m)=true -> m=M0.
`Proof`.
Induction m; Trivial. Intros. Discriminate H.
Intros. Discriminate H1.
`Qed`.

`

`MapSplit` not implemented: not the preferred way of recursing over Maps (use `MapSweep`, `MapCollect`, or `MapFold` in Mapiter.v.

`

`End` MapDefs.

`

Index