Section ParameterizedCombiner.
Existing Instance Join_combiner.
Variable S : Type.
Variable JS : Join S.
Variable pa_S : Perm_alg S.
Variable sa_S : Sep_alg S.
Variable ca_S : Canc_alg S.
Variable da_S : Disj_alg S.
Variable T1 : functor.
Variable J1: forall A, Join (T1 A).
Variable Perm1: forall A, Perm_alg (T1 A).
Variable Sep1: forall A, Sep_alg (T1 A).
Variable T2 : functor.
Definition fcombiner (A : Type) : Type :=
@combiner S JS (T1 A) (T2 A).
Definition fcombiner_fmap (A B : Type) (f: A -> B) (g: B -> A)
(fa : fcombiner A) : fcombiner B :=
match fa with
| CEmpty => CEmpty
| CPart sh rs => CPart sh (fmap T1 f g rs)
| CFull trs => CFull (fmap T2 f g trs)
end.
Arguments fcombiner_fmap [A B] _ _ _.
Proof with auto.
constructor; intros;
extensionality pd; unfold fcombiner_fmap.
icase pd; rewrite fmap_id...
icase pd; rewrite <- fmap_comp...
Qed.
Definition f_combiner : functor := Functor ff_combiner.
Variable top_S : S.
Variable topS_full : full top_S.
Variable combjoin : forall A, (T1 A) -> (T1 A) -> (T2 A) -> Prop.
Variable combjoin_eq : forall A v1 v1' v2 v2',
combjoin A v1 v1' v2 ->
combjoin A v1 v1' v2' ->
v2 = v2'.
Variable combjoin_assoc : forall A (v1 v2 v3 v4: T1 A) (v5: T2 A),
join v1 v2 v3 ->
combjoin A v3 v4 v5 ->
{v' : (T1 A) & join v2 v4 v' /\ combjoin A v1 v' v5}.
Variable combjoin_com : forall A v1 v2 v3,
combjoin A v1 v2 v3 ->
combjoin A v2 v1 v3.
Variable combjoin_canc : forall A v1 v1' v2 v3,
combjoin A v1 v2 v3 ->
combjoin A v1' v2 v3 ->
v1 = v1'.
Variable saf_T1 : pafunctor T1 J1.
Instance Join_fcombiner (A: Type) : Join (fcombiner A) :=
Join_combiner top_S (J1 A) (combjoin A).
Instance Perm_fcombiner (A: Type): Perm_alg (fcombiner A).
Definition combjoin_hom (A : Type) (B : Type)
(f : T1 A -> T1 B) (g : T2 A -> T2 B) : Prop :=
forall x y z,
combjoin A x y z ->
combjoin B (f x) (f y) (g z).
Arguments combjoin_hom [A B] _ _.
Variable fmaps_combjoin_hom: forall A B (f : A -> B) (g: B -> A),
combjoin_hom (fmap T1 f g) (fmap T2 f g).
Proof with auto.
repeat intro. hnf in H|-*.
icase x; icase y; icase z.
destruct H.
split; congruence.
simpl in H. subst v0. simpl...
destruct H.
split; congruence.
destruct H.
split...
apply paf_join_hom...
destruct H.
split...
apply fmaps_combjoin_hom...
simpl in H. subst v0. simpl...
Qed.
Definition combjoin_unmap_left (A B : Type)
(f : T1 A -> T1 B) (g : T2 A -> T2 B) : Type :=
forall (x' : T1 B) (y :T1 A) (z : T2 A),
combjoin B x' (f y) (g z) ->
{x : T1 A &  {y0 : T1 A | combjoin A x y0 z /\ f x = x' /\ f y0 = f y}}.
Arguments combjoin_unmap_left [A B] _ _.
Variable combjoin_preserves_unmap_left : forall A B (f : A -> B) (g: B -> A),
combjoin_unmap_left (fmap T1 f g) (fmap T2 f g).
Definition combjoin_unmap_right (A B : Type)
(f : T1 A -> T1 B) (g : T2 A -> T2 B) : Type :=
forall (x y :T1 A) (z' : T2 B),
combjoin B (f x) (f y) z' ->
{y0 : T1 A &  {z : T2 A | combjoin A x y0 z /\ f y0 = f y /\ g z = z'}}.
Arguments combjoin_unmap_right [A B] _ _.
Variable combjoin_preserves_unmap_right : forall A B (f : A -> B) (g: B -> A),
combjoin_unmap_right (fmap T1 f g) (fmap T2 f g).
Proof with auto.
repeat intro. simpl in H|-*. unfold join in H|-*. simpl in H|-*.
icase x'; icase y; icase z.
exists (CEmpty). exists (CEmpty). firstorder.
exists (CEmpty). exists (CPart sh0 v0).
destruct H. simpl.
repeat split; congruence.
exists (CEmpty). exists (CFull v0).
simpl in H. simpl.
repeat split; congruence.
exists (CPart sh v0). exists (CEmpty).
destruct H. simpl.
repeat split; congruence.
destruct H.
generalize (paf_preserves_unmap_left saf_T1 f g v v0 v1 H0); intro X.
destruct X as [x [y0 [? [? ?]]]].
exists (CPart sh x). exists (CPart sh0 y0).
split. split...
simpl. split; congruence.
(* combjoin case *)
destruct H.
specialize ( combjoin_preserves_unmap_left A B f g v v0 v1 H).
destruct combjoin_preserves_unmap_left as [x [y0 [? [? ?]]]].
exists (CPart sh x). exists (CPart sh0 y0).
split. split...
simpl. split; congruence.
(* end combjoin case *)
exists (CFull v0). exists (CEmpty).
simpl in H. simpl.
repeat split; congruence.
Qed.

Lemma fmap_fcombiner_preserves_unmap_right: forall A B (f : A -> B) (g: B -> A),
unmap_right (Join_fcombiner A) (Join_fcombiner B) (fmap f_combiner f g).