Section CombineJoin.
Variable A : Type.
Variable JA: Join A.
Variable pa_A : Perm_alg A.
Variable sa_A : Sep_alg A.
Variable ca_A : Canc_alg A.
Variable da_A : Disj_alg A.
(* We either need an explicit top witness or some kind of axiom of choice (if not here, then in sa_fun or somesuch).  It is a little ugly this way but I don't see any other way around. Aquinas *)
Variable A_top : A.
Variable A_top_full : full A_top.
Variable T1 : Type.
Variable T2 : Type.
Variable J1: Join T1.
Variable pa_T1: Perm_alg T1.
Variable sa_T1: Sep_alg T1.
Variable combjoin : T1 -> T1 -> T2 -> Prop.
Variable combjoin_eq : forall v1 v1' v2 v2',
combjoin v1 v1' v2 ->
combjoin v1 v1' v2' ->
v2 = v2'.
Variable combjoin_assoc : forall v1 v2 v3 v4 v5,
join v1 v2 v3 ->
combjoin v3 v4 v5 ->
{v' : T1 & join v2 v4 v' /\ combjoin v1 v' v5}.
Variable combjoin_com : forall v1 v2 v3,
combjoin v1 v2 v3 ->
combjoin v2 v1 v3.
Variable combjoin_canc : forall v1 v1' v2 v3,
combjoin v1 v2 v3 ->
combjoin v1' v2 v3 ->
v1 = v1'.
(* We would really prefer this to be: exists top, join (projT1 j1) (projT1 j2) top /\ full top but, again, we run into Type/Prop problems and wind up needing some form of the axiom of choice somewhere or other. *)
Definition covers (j1 j2 : ijoinable A) : Prop :=
join (projT1 j1) (projT1 j2) A_top.
Inductive combiner : Type :=
| CEmpty
| CPart : forall (sh : ijoinable A) (v : T1), combiner
| CFull : forall (v : T2), combiner.
Instance Join_combiner : Join combiner :=
fun c1 c2 c3 =>
match (c1,c2,c3) with
| (CEmpty, CEmpty, CEmpty) => True
| (CEmpty, CPart a v, CPart a' v') => a = a' /\ v = v'
| (CPart a v, CEmpty, CPart a' v')  => a = a' /\ v = v'
| (CEmpty, CFull v, CFull v') => v = v'
| (CFull v, CEmpty, CFull v') => v = v'
| (CPart a v, CPart a' v', CPart a'' v'') => ijoin a a' a'' /\ join v v' v''
| (CPart a v, CPart a' v', CFull v'') => combjoin v v' v'' /\ covers a a'
| _ => False
end.
Proof with auto.
intros.
icase x;icase y;icase z;icase z';try inversion H;try inversion H0;try congruence.
f_equal.
eapply ijoin_eq; eauto.
eapply join_eq; eauto.
elimtype False; clear - pa_A sa_A H1 H4 A_top_full.
destruct sh; destruct sh0; destruct sh1.
red in H1; red in H4; simpl in H4.
generalize (join_eq H1 H4); intro; subst x1.
unfold midObj in *.
tauto.
elimtype False; clear - pa_A sa_A H2 H3 A_top_full.
destruct sh;destruct sh0;destruct sh1.
red in H3; red in H2; simpl in H2.
generalize (join_eq H2 H3);intro;subst x1.
unfold midObj in *.
tauto.
rewrite (combjoin_eq _ _ _ _ H1 H3)...
Qed.
Proof with auto.
intros. red in H, H0. unfold join.
icase a;icase b;icase c;icase d;icase e;inv H;inv H0.
exists CEmpty;split;red...
exists (CPart sh0 v0);split;red...
exists (CFull v0);split;red...
exists (CPart sh1 v1);split;red...
exists (CPart sh2 v2);split;red...
exists (CFull v2);split;red...
exists (CFull v1);split;red...
exists CEmpty;split;red...
exists (CPart sh0 v0);split;red...
exists (CPart sh0 v0);split;red...
exists (CPart sh0 v0);split;red...
exists (CPart sh0 v0);split;red...
3: exists (CEmpty);split;red...
destruct (ijoin_assoc _ _ _ _ _ H1 H) as [sh' [? ?]].
destruct (join_assoc H2 H3) as [fv [? ?]].
exists (CPart sh' fv); split; red...
icase sh; icase sh0; icase sh1; icase sh2.
red in H1, H3. simpl in H1, H3.
destruct (join_assoc H1 H3) as [sh' [? ?]].
assert ((~identity sh') /\ (~full sh')).
split; intro.
generalize (split_identity _ _ H0 H5); intro.
unfold midObj in *.
tauto.
specialize ( H5 x).
spec H5. exists A_top...
specialize ( H5 sh' A_top H4).
subst sh'.
apply unit_identity in H4.
unfold midObj in *.
tauto.
destruct (combjoin_assoc _ _ _ _ _ H2 H) as [v' [? ?]].
exists (CPart (existT _ sh' H5) v').
split; split...
Qed.
Proof with auto.
intros. unfold join in H|-*.
icase a; icase b.
icase c; red in H; red; destruct H;
split...
apply ijoin_com...
apply join_comm...
Qed.

Lemma combineJ_canc {C1: Canc_alg T1}: forall a1 a2 b c : combiner,
join a1 b c -> join a2 b c -> a1=a2.