End Sound_Upwards.
(*****************************************)
(* For SL extension                      *)
(*****************************************)
(* Definition unique_cancel {worlds: Type} {kiM: KripkeIntuitionisticModel worlds} {J: Join worlds} (P: worlds -> Prop): Prop := forall n, (exists n1 n2, P n1 /\ join n1 n2 n) -> (exists n1 n2, P n1 /\ join n1 n2 n /\ forall n1' n2', (P n1' /\ join n1' n2' n) -> n2 <= n2').  Lemma sound_precise_sepcon {L: Language} {nL: NormalLanguage L} {pL: PropositionalLanguage L} {sL: SeparationLanguage L} {MD: Model} {kMD: KripkeModel MD} (M: Kmodel) {R: Relation (Kworlds M)} {po_R: PreOrder Krelation} {J: Join (Kworlds M)} {nSA: SeparationAlgebra (Kworlds M)} {dSA: UpwardsClosedSeparationAlgebra (Kworlds M)} {SM: Semantics L MD} {kiSM: KripkeIntuitionisticSemantics L MD M SM} {usSM: UpwardsSemantics.SeparatingSemantics L MD M SM}: forall x y, unique_cancel (fun m => KRIPKE: M, m |= x) -> unique_cancel (fun m => KRIPKE: M, m |= y) -> unique_cancel (fun m => KRIPKE: M, m |= x * y). *)
(* (* This is over generalization, i.e. the soundness of pure_fact_andp needs extra restriction on models. *)
Definition join_inv {worlds: Type} {kiM: KripkeIntuitionisticModel worlds} {J: Join worlds} (P: worlds -> Prop): Prop :=
(forall n1 n2 n, join n1 n2 n -> P n ->
exists n1' n2', join n1' n2' n /\ n1' <= n1 /\ n2' <= n2 /\ P n1') /\
(forall n1 n2 n, join n1 n2 n -> P n1 -> P n).

(* Specifications: *)
Lemma sound_andp_sepcon {L: Language} {nL: NormalLanguage L} {pL: PropositionalLanguage L} {sL: SeparationLanguage L} {MD: Model} {kMD: KripkeModel MD} (M: Kmodel) {R: Relation (Kworlds M)} {po_R: PreOrder Krelation} {J: Join (Kworlds M)} {nSA: SeparationAlgebra (Kworlds M)} {dSA: UpwardsClosedSeparationAlgebra (Kworlds M)} {SM: Semantics L MD} {kiSM: KripkeIntuitionisticSemantics L MD M SM} {usSM: UpwardsSemantics.SeparatingSemantics L MD M SM}:
forall x y z,
join_inv (fun m => KRIPKE: M, m |= x) ->
forall m,
KRIPKE: M, m |= (x && (y * z)) <--> ((x && y) * z).