Require Import Axioms.
Require Import Coqlib.
Require Import Maps.
Set Implicit Arguments.
The abstract signatures of trees
Module MakeProdTree (
M1:
TREE) (
M2:
TREE) <:
TREE.
Definition elt:
Type := (
M1.elt *
M2.elt)%
type.
Definition elt_eq:
forall (
a b:
elt), {
a =
b} + {
a <>
b}.
Proof.
Definition t (
A:
Type) :
Type :=
M1.t (
M2.t A).
Definition eq:
forall (
A:
Type), (
forall (
x y:
A), {
x=
y} + {
x<>
y}) ->
forall (
a b:
t A), {
a =
b} + {
a <>
b} :=
fun A eq =>
M1.eq (
M2.eq eq).
Definition empty (
A:
Type) :
t A :=
M1.empty _.
Definition get (
A:
Type) (
a:
elt) (
m:
t A) :
option A :=
let (
a1,
a2) :=
a in
match M1.get a1 m with
|
None =>
None
|
Some m =>
M2.get a2 m
end.
Definition set (
A:
Type) (
a:
elt) (
v:
A) (
m:
t A) :
t A :=
let (
a1,
a2) :=
a in
let m1 :=
match M1.get a1 m with
|
None =>
M2.set a2 v (
M2.empty _)
|
Some m1 =>
M2.set a2 v m1
end in
M1.set a1 m1 m.
Definition remove (
A:
Type) (
a:
elt) (
m:
t A) :
t A :=
let (
a1,
a2) :=
a in
let m1 :=
match M1.get a1 m with
|
None =>
M2.empty _
|
Some m1 =>
m1
end in
M1.set a1 (
M2.remove a2 m1)
m.
The ``good variables'' properties for trees, expressing
commutations between get, set and remove.
Lemma gempty:
forall (
A:
Type) (
i:
elt),
get i (
empty A) =
None.
Proof.
intros A [
i1 i2];
unfold get,
empty.
rewrite M1.gempty;
auto.
Qed.
Lemma gss:
forall (
A:
Type) (
i:
elt) (
x:
A) (
m:
t A),
get i (
set i x m) =
Some x.
Proof.
intros A [
i1 i2]
x m;
unfold get,
set.
rewrite M1.gss;
auto.
destruct (
M1.get i1 m).
rewrite M2.gss;
auto.
rewrite M2.gss;
auto.
Qed.
Lemma gso:
forall (
A:
Type) (
i j:
elt) (
x:
A) (
m:
t A),
i <>
j ->
get i (
set j x m) =
get i m.
Proof.
intros A [
i1 i2] [
j1 j2]
x m H;
unfold get,
set.
destruct (
M1.elt_eq i1 j1);
subst.
rewrite M1.gss;
auto.
destruct (
M1.get j1 m).
rewrite M2.gso;
intuition congruence.
rewrite M2.gso;
try intuition congruence.
rewrite M2.gempty;
auto.
rewrite M1.gso;
auto.
Qed.
Lemma gsspec:
forall (
A:
Type) (
i j:
elt) (
x:
A) (
m:
t A),
get i (
set j x m) =
if elt_eq i j then Some x else get i m.
Proof.
intros A i j x m.
destruct (
elt_eq i j);
subst.
apply gss.
apply gso;
auto.
Qed.
Lemma gsident:
forall (
A:
Type) (
i:
elt) (
m:
t A) (
v:
A),
get i m =
Some v ->
set i v m =
m.
Proof.
intros A [
i1 i2]
m v;
unfold get,
set.
case_eq (
M1.get i1 m); [
intros m2 H2 H|
intros H2 H].
apply M1.gsident.
rewrite M2.gsident;
auto.
congruence.
Qed.
Lemma grs:
forall (
A:
Type) (
i:
elt) (
m:
t A),
get i (
remove i m) =
None.
Proof.
intros A [
i1 i2]
m;
unfold get,
remove.
rewrite M1.gss.
rewrite M2.grs;
auto.
Qed.
Lemma gro:
forall (
A:
Type) (
i j:
elt) (
m:
t A),
i <>
j ->
get i (
remove j m) =
get i m.
Proof.
intros A [
i1 i2] [
j1 j2]
m H;
unfold get,
remove.
destruct (
M1.elt_eq i1 j1);
subst.
rewrite M1.gss.
rewrite M2.gro.
destruct (
M1.get j1 m);
auto.
rewrite M2.gempty;
auto.
congruence.
rewrite M1.gso;
auto.
Qed.
Lemma grspec:
forall (
A:
Type) (
i j:
elt) (
m:
t A),
get i (
remove j m) =
if elt_eq i j then None else get i m.
Proof.
intros A i j m.
destruct (
elt_eq i j);
subst.
apply grs.
apply gro;
auto.
Qed.
Extensional equality between trees.
Definition beq (
A:
Type) (
f:
A ->
A ->
bool) (
m1 m2:
t A) :
bool :=
M1.beq (
M2.beq f)
m1 m2.
Lemma beq_correct:
forall (
A:
Type) (
P:
A ->
A ->
Prop) (
cmp:
A ->
A ->
bool),
(
forall (
x y:
A),
cmp x y =
true ->
P x y) ->
forall (
t1 t2:
t A),
beq cmp t1 t2 =
true ->
forall (
x:
elt),
match get x t1,
get x t2 with
|
None,
None =>
True
|
Some y1,
Some y2 =>
P y1 y2
|
_,
_ =>
False
end.
Proof.
intros A P cmp H t1 t2 H1 [
x1 x2];
unfold get,
beq in *.
case_eq (
M1.get x1 t1); [
intros m1 Hm1|
intros Hm1].
case_eq (
M1.get x1 t2); [
intros m2 Hm2|
intros Hm2].
case_eq (
M2.get x2 m1); [
intros mm1 Hmm1|
intros Hmm1].
case_eq (
M2.get x2 m2); [
intros mm2 Hmm2|
intros Hmm2].
assert (
Hd: (
forall x y :
M2.t A,
M2.beq cmp x y =
true ->
M2.beq cmp x y =
true))
by auto.
generalize (
M1.beq_correct (
fun m1 m2 =>
M2.beq cmp m1 m2 =
true)
Hd H1 x1).
rewrite Hm1;
rewrite Hm2.
intros He.
generalize (
M2.beq_correct P H He x2).
rewrite Hmm1;
rewrite Hmm2;
auto.
assert (
Hd: (
forall x y :
M2.t A,
M2.beq cmp x y =
true ->
M2.beq cmp x y =
true))
by auto.
generalize (
M1.beq_correct (
fun m1 m2 =>
M2.beq cmp m1 m2 =
true)
Hd H1 x1).
rewrite Hm1;
rewrite Hm2.
intros He.
generalize (
M2.beq_correct P H He x2).
rewrite Hmm1;
rewrite Hmm2;
auto.
assert (
Hd: (
forall x y :
M2.t A,
M2.beq cmp x y =
true ->
M2.beq cmp x y =
true))
by auto.
generalize (
M1.beq_correct (
fun m1 m2 =>
M2.beq cmp m1 m2 =
true)
Hd H1 x1).
rewrite Hm1;
rewrite Hm2.
intros He.
generalize (
M2.beq_correct P H He x2).
rewrite Hmm1;
auto.
assert (
Hd: (
forall x y :
M2.t A,
M2.beq cmp x y =
true ->
M2.beq cmp x y =
true))
by auto.
generalize (
M1.beq_correct (
fun m1 m2 =>
M2.beq cmp m1 m2 =
true)
Hd H1 x1).
rewrite Hm1;
rewrite Hm2.
intuition.
case_eq (
M1.get x1 t2); [
intros m2 Hm2|
intros Hm2].
case_eq (
M2.get x2 m2); [
intros mm2 Hmm2|
intros Hmm2].
assert (
Hd: (
forall x y :
M2.t A,
M2.beq cmp x y =
true ->
M2.beq cmp x y =
true))
by auto.
generalize (
M1.beq_correct (
fun m1 m2 =>
M2.beq cmp m1 m2 =
true)
Hd H1 x1).
rewrite Hm1;
rewrite Hm2.
auto.
auto.
auto.
Qed.
Applying a function to all data of a tree.
Definition map (
A B:
Type) (
f:
elt ->
A ->
B) (
m:
t A) :
t B :=
M1.map (
fun a1 =>
M2.map (
fun a2 =>
f (
a1,
a2)))
m.
Lemma gmap:
forall (
A B:
Type) (
f:
elt ->
A ->
B) (
i:
elt) (
m:
t A),
get i (
map f m) =
option_map (
f i) (
get i m).
Proof.
intros A B f [
i1 i2]
m;
unfold get,
map.
rewrite M1.gmap.
case_eq (
M1.get i1 m);
intros;
simpl;
auto.
rewrite M2.gmap;
auto.
Qed.
Same as map, but the function does not receive the elt argument.
Definition map1 (
A B:
Type) (
f:
A ->
B) (
m:
t A) :
t B :=
M1.map1 (
M2.map1 f)
m.
Lemma gmap1:
forall (
A B:
Type) (
f:
A ->
B) (
i:
elt) (
m:
t A),
get i (
map1 f m) =
option_map f (
get i m).
Proof.
intros A B f [
i1 i2]
m;
unfold get,
map1.
rewrite M1.gmap1.
case_eq (
M1.get i1 m);
intros;
simpl;
auto.
rewrite M2.gmap1;
auto.
Qed.
Applying a function pairwise to all data of two trees.
Definition combine (
A B:
Type) (
f:
option A ->
option A ->
option B) (
m1 m2:
t A) :
t B :=
M1.combine (
fun om1 om2 =>
match om1,
om2 with
|
None,
None =>
None
|
None,
Some m2 =>
Some (
M2.combine f (@
M2.empty _)
m2)
|
Some m2,
None =>
Some (
M2.combine f m2 (@
M2.empty _))
|
Some m1,
Some m2 =>
Some (
M2.combine f m1 m2)
end)
m1 m2.
Lemma gcombine:
forall (
A B:
Type) (
f:
option A ->
option A ->
option B),
f None None =
None ->
forall (
m1 m2:
t A) (
i:
elt),
get i (
combine f m1 m2) =
f (
get i m1) (
get i m2).
Proof.
Lemma combine_commut:
forall (
A B:
Type) (
f g:
option A ->
option A ->
option B),
(
forall (
i j:
option A),
f i j =
g j i) ->
forall (
m1 m2:
t A),
combine f m1 m2 =
combine g m2 m1.
Proof.
Enumerating the bindings of a tree.
Definition elements (
A:
Type) (
m:
t A) :
list (
elt *
A) :=
M1.fold (
fun l x1 m1 =>
M2.fold (
fun l x2 a => ((
x1,
x2),
a)::
l)
m1 l)
m (@
nil _).
Module P1 :=
Tree_Properties(
M1).
Module P2 :=
Tree_Properties(
M2).
Definition xf1 {
A:
Type} (
x1:
M1.elt)
l (
p:
M2.elt*
A) :=
let (
x2,
a) :=
p in ((
x1,
x2),
a)::
l.
Definition xf2 {
A:
Type}
l (
p:(
M1.elt* (
list (
M2.elt*
A)))) :=
let (
x1,
m1) :=
p in
List.fold_left (
xf1 x1)
m1 l.
Definition xelements (
A:
Type) (
m:
t A) :
list (
elt *
A) :=
List.fold_left xf2 (
List.map (
fun p => (
fst p,
M2.elements (
snd p))) (
M1.elements m)) (@
nil _).
Lemma xelements_eq :
forall A (
m:
t A),
xelements m =
elements m.
Proof.
Lemma elements_correct:
forall (
A:
Type) (
m:
t A) (
i:
elt) (
v:
A),
get i m =
Some v ->
In (
i,
v) (
elements m).
Proof.
unfold get,
elements;
intros A m [
i1 i2]
v.
case_eq (
M1.get i1 m); [
idtac|
intros H1 H;
discriminate].
apply (
P1.fold_rec _
(
fun m l =>
forall i1 i2 v m2,
M1.get i1 m =
Some m2 ->
M2.get i2 m2 =
Some v ->
In (
i1,
i2,
v)
l));
clear i1 i2 v.
intros m'
m''
l H1 H2 i1 i2 v m2 Heq1 Heq2.
eapply H2;
eauto.
rewrite H1;
auto.
intros i1 i2 v m2 Heq1 Heq2.
rewrite M1.gempty in *;
congruence.
assert (
forall i x m2 l,
In x l ->
In x (
M2.fold
(
fun (
l0 :
list (
M1.elt *
M2.elt *
A)) (
x2 :
M2.elt) (
a :
A) =>
(
i,
x2,
a) ::
l0)
m2 l)).
intros i x m2 l Hl.
apply (
P2.fold_rec
(
fun l0 x2 a => (
i,
x2,
a) ::
l0)
(
fun m2 l' =>
In x l'));
auto with datatypes.
intros m'
l i m2 H1 H2 H3 i1 i2 v m0 Heq1 Heq2.
rewrite M1.gsspec in Heq1;
destruct M1.elt_eq;
subst;
eauto.
inv Heq1.
clear dependent m'.
generalize i2 v Heq2;
clear i2 v Heq2.
apply (
P2.fold_rec (
fun l0 x2 a => (
i,
x2,
a) ::
l0)
(
fun m2 l =>
forall i2 v,
M2.get i2 m2 =
Some v ->
In (
i,
i2,
v)
l)
l);
eauto.
intros m2 m2'
l1 H1 H3 i2 v.
rewrite <-
H1;
auto.
intros i2 v;
rewrite M2.gempty;
congruence.
intros m1 a i2 v Heq1 Heq2 Heq3 i2'
v'.
rewrite M2.gsspec;
destruct M2.elt_eq;
intros T.
inv T;
left;
auto.
right;
eauto.
Qed.
Lemma elements_complete:
forall (
A:
Type) (
m:
t A) (
i:
elt) (
v:
A),
In (
i,
v) (
elements m) ->
get i m =
Some v.
Proof.
unfold elements;
intros A m.
apply (
P1.fold_rec _
(
fun m l =>
(
forall i v,
In (
i,
v)
l ->
get i m =
Some v))).
intros m''
m'
a Hyp1 Hyp0;
auto.
intros [
i1 i2]
Hv;
unfold get.
rewrite <-
Hyp1 in *;
apply (
Hyp0 (
i1,
i2)).
simpl;
intuition.
intros m1 l i v1 H1 H2 H3.
apply (
P2.fold_rec _
(
fun m l =>
(
forall i0 v,
In (
i0,
v)
l ->
get i0 (
M1.set i v1 m1) =
Some v)));
auto.
intros [
i1 i2]
v Hv.
unfold get.
rewrite M1.gsspec;
destruct M1.elt_eq;
subst;
auto.
generalize (
H3 _ _ Hv);
unfold get.
rewrite H1;
congruence.
generalize (
H3 _ _ Hv);
unfold get;
auto.
intros m0 a k v0 H H0 H4 [
i1 i2]
v;
unfold get in *.
simpl;
destruct 1.
inv H5.
rewrite M1.gss;
auto.
rewrite M1.gsspec;
destruct M1.elt_eq;
subst.
generalize (
H4 _ _ H5);
rewrite M1.gss;
auto.
generalize (
H4 _ _ H5);
rewrite M1.gso;
auto.
Qed.
Lemma xelements_keys_norepet_aux :
forall A a1 l1 acc,
list_norepet (
List.map (@
fst (
M1.elt*
M2.elt)
A)
acc) ->
(
forall a3 x y,
In (
a3,
x)
l1 ->
In (
a1,
a3,
y)
acc ->
False) ->
list_norepet (
List.map (@
fst M2.elt A)
l1) ->
list_norepet (
List.map (@
fst (
M1.elt*
M2.elt)
A) (
fold_left (
xf1 a1)
l1 acc)).
Proof.
induction l1;
simpl;
auto.
intros acc H1 H2 H3.
apply IHl1;
clear IHl1.
destruct a as [
a2 x];
simpl;
constructor.
intros H4.
elim list_in_map_inv with (1:=
H4);
clear H4;
intros b [
B1 B2].
destruct b;
simpl in *;
inv B1;
eauto.
inv H3;
auto.
destruct a as [
a2 x];
simpl.
intros a3 z y H5 H4;
simpl in H3.
destruct H4 as [
H4|
H4].
inv H4.
inv H3.
elim H4;
apply in_map with (1:=
H5) (
f:= (@
fst M2.elt A)).
eauto.
inv H3;
auto.
Qed.
Lemma xelements_keys_norepet:
forall (
A:
Type) (
l:
list (
M1.elt* (
list (
M2.elt*
A))))
acc,
list_norepet (
List.map (@
fst (
M1.elt*
M2.elt)
A)
acc) ->
list_norepet (
List.map (@
fst M1.elt (
list (
M2.elt*
A)))
l) ->
(
forall a1 l1 a2 x,
In (
a1,
l1)
l ->
In ((
a1,
a2),
x)
acc ->
False) ->
(
forall a1 l1,
In (
a1,
l1)
l ->
list_norepet (
List.map (@
fst M2.elt A)
l1)) ->
list_norepet (
List.map (@
fst (
M1.elt*
M2.elt)
A) (
fold_left xf2 l acc)).
Proof.
induction l;
simpl;
auto.
intros acc H1 H4 H2 H3;
apply IHl;
clear IHl.
destruct a as [
a1 l1].
unfold xf2.
apply xelements_keys_norepet_aux;
eauto.
inv H4;
auto.
destruct a as [
a1 l1];
simpl in *.
inv H4.
assert (
forall (
a2 :
M1.elt) (
l2 :
list (
M2.elt *
A)) (
a3 :
M2.elt) (
x :
A),
In (
a2,
l2)
l ->
In (
a2,
a3,
x)
acc ->
False)
by eauto.
clear H3 H2 H1 H6.
intros a3 l3;
generalize dependent acc.
induction l1;
simpl;
eauto.
intros.
elim IHl1 with (2:=
H0) (3:=
H1).
destruct a;
simpl;
intros.
destruct H3;
eauto.
inv H3.
elim H5;
apply in_map with (1:=
H2) (
f:=@
fst M1.elt (
list (
M2.elt *
A))).
eauto.
Qed.
Lemma map_map :
forall (
A B C:
Type) (
g:
A->
B) (
f:
B->
C)
l,
List.map f (
List.map g l) =
List.map (
fun x =>
f (
g x))
l.
Proof.
induction l; simpl; try f_equal; auto.
Qed.
Lemma elements_keys_norepet:
forall (
A:
Type) (
m:
t A),
list_norepet (
List.map (@
fst elt A) (
elements m)).
Proof.
Lemma elements_canonical_order_aux1:
forall (
A B:
Type)
R (
l1:
list (
M1.elt *
list (
M2.elt *
A))) (
l2:
list (
M1.elt *
list (
M2.elt *
B)))
acc1 acc2,
list_forall2 (
fun x1 x2 =>
list_forall2 (
fun b1 b2 =>
R (
fst x1,
fst b1,
snd b1) (
fst x2,
fst b2,
snd b2)) (
snd x1) (
snd x2))
l1 l2 ->
list_forall2 R acc1 acc2 ->
list_forall2 R (
fold_left xf2 l1 acc1) (
fold_left xf2 l2 acc2).
Proof.
induction l1; destruct l2; simpl; intros; try constructor; auto.
inv H.
inv H.
apply IHl1; auto; clear IHl1.
inv H; auto.
destruct a; destruct p; simpl.
inv H.
clear H6; simpl in *.
generalize dependent acc1; generalize acc2; clear acc2.
induction H4; simpl; auto.
intros; apply IHlist_forall2; clear IHlist_forall2.
destruct a1; destruct b1; simpl in *.
constructor; auto.
Qed.
Lemma list_forall2_map:
forall (
A B C D:
Type) (
R:
C->
D->
Prop)
f g (
l1:
list A) (
l2:
list B),
list_forall2 (
fun x y =>
R (
f x) (
g y))
l1 l2 ->
list_forall2 R (
List.map f l1) (
List.map g l2).
Proof.
induction 1; constructor; auto.
Qed.
Lemma list_forall2_monotone :
forall (
A B:
Type) (
R1 R2:
A->
B->
Prop)
l1 l2,
(
forall x y,
R1 x y ->
R2 x y) ->
list_forall2 R1 l1 l2 ->
list_forall2 R2 l1 l2.
Proof.
induction 2; constructor; auto.
Qed.
Definition fold (
A B:
Type) (
f:
B ->
elt ->
A ->
B) (
m:
t A) (
b:
B) :
B :=
List.fold_left (
fun a p =>
f a (
fst p) (
snd p)) (
elements m)
b.
Lemma fold_left_extensionnal :
forall (
A B:
Type) (
f1 f2:
A->
B->
A)
l x,
(
forall b a,
f1 a b =
f2 a b) ->
fold_left f1 l x =
fold_left f2 l x.
Proof.
induction l; simpl; auto.
intros; rewrite IHl; auto.
rewrite H; auto.
Qed.
Lemma fold_left_map :
forall (
A B C:
Type) (
f:
A->
B->
A) (
g:
C->
B)
l x,
fold_left f (
List.map g l)
x =
fold_left (
fun x y =>
f x (
g y))
l x.
Proof.
induction l; simpl; auto.
Qed.
Lemma fold_spec:
forall (
A B:
Type) (
f:
B ->
elt ->
A ->
B) (
v:
B) (
m:
t A),
fold f m v =
List.fold_left (
fun a p =>
f a (
fst p) (
snd p)) (
elements m)
v.
Proof.
unfold fold; auto.
Qed.
End MakeProdTree.
Module MakeProdMap (
M1:
MAP) (
M2:
MAP) <:
MAP.
Definition elt:
Type := (
M1.elt *
M2.elt)%
type.
Lemma elt_eq:
forall (
a b:
elt), {
a =
b} + {
a <>
b}.
Proof.
Definition t (
A:
Type) :
Type :=
M1.t (
M2.t A).
Definition init (
A:
Type) (
a:
A) :
t A :=
M1.init (
M2.init a).
Definition get (
A:
Type) (
x:
elt) (
m:
t A) :
A :=
let (
x1,
x2) :=
x in
M2.get x2 (
M1.get x1 m).
Definition set (
A:
Type) (
x:
elt) (
v:
A) (
m:
t A) :
t A :=
let (
x1,
x2) :=
x in
M1.set x1 (
M2.set x2 v (
M1.get x1 m))
m.
Lemma gi:
forall (
A:
Type) (
i:
elt) (
x:
A),
get i (
init x) =
x.
Proof.
intros A [
i1 i2]
x;
unfold get,
init.
rewrite M1.gi.
rewrite M2.gi;
auto.
Qed.
Lemma gss:
forall (
A:
Type) (
i:
elt) (
x:
A) (
m:
t A),
get i (
set i x m) =
x.
Proof.
intros A [
i1 i2]
x m;
unfold get,
set.
rewrite M1.gss;
rewrite M2.gss;
auto.
Qed.
Lemma gso:
forall (
A:
Type) (
i j:
elt) (
x:
A) (
m:
t A),
i <>
j ->
get i (
set j x m) =
get i m.
Proof.
intros A [
i1 i2] [
j1 j2]
x m H;
unfold get,
set.
destruct (
M1.elt_eq i1 j1);
subst.
rewrite M1.gss;
rewrite M2.gso;
congruence.
rewrite M1.gso;
auto.
Qed.
Lemma gsspec:
forall (
A:
Type) (
i j:
elt) (
x:
A) (
m:
t A),
get i (
set j x m) =
if elt_eq i j then x else get i m.
Proof.
intros A i j x m.
destruct (
elt_eq i j);
subst.
apply gss.
apply gso;
auto.
Qed.
Lemma gsident:
forall (
A:
Type) (
i j:
elt) (
m:
t A),
get j (
set i (
get i m)
m) =
get j m.
Proof.
intros A i j m.
destruct (
elt_eq i j);
subst.
rewrite gss;
auto.
rewrite gso;
auto.
Qed.
Definition map (
A B:
Type) (
f:
A ->
B) (
m:
t A) :
t B :=
M1.map (
M2.map f)
m.
Lemma gmap:
forall (
A B:
Type) (
f:
A ->
B) (
i:
elt) (
m:
t A),
get i (
map f m) =
f(
get i m).
Proof.
intros A B f [
i1 i2]
m;
unfold get,
map.
rewrite M1.gmap;
rewrite M2.gmap;
auto.
Qed.
End MakeProdMap.