Module CL := CL_Sound VSM. Import CL.
(* rule w2 *)
Ltac dsepcon :=
match goal with
[ H : sepcon _ _ _ |- _ ] =>
let s1 := fresh "s" in
let s2 := fresh "s" in
let JOIN := fresh "JOIN" in
let H1 := fresh "H" in
let H2 := fresh "H" in
destruct H as [s1 [s2 [JOIN [H1 H2]]]]
end.
Hint Resolve nil_or_loc_full.
Proof with auto; try congruence; try solve [
destruct B as [x' [y' [C [D E]]]]; destruct (IHsigma A y' E) as [s0 [z [F G]]];
subst; exists s0; exists z; split; simpl; auto;
apply join_sub_trans with (b := y'); simpl; auto;
eapply join_join_sub'; eauto].
intros A B; revert s B; induction sigma; intros s B. simpl in A...
simpl in A. remember a as b; destruct b... remember e as b'; destruct b'...
destruct (Ident.eq_dec x v)... destruct B as [x' [y' [C [D E]]]].
subst; exists x'; exists e0; split... solve [eapply join_join_sub'; eauto].
Qed.
Proof with try congruence.
intros A B C D; destruct (next_in_dom_rawnext _ _ _ A B) as [s' [z' [F G]]].
simpl in F, C. cut (stk s2 = stk s'). intro Heq; rewrite Heq in *; clear Heq.
destruct (val2loc (env_get (stk s') x))...
destruct F as [H I]; destruct C as [J K].
assert (L : join_sub (hp s') (hp s1)).
destruct G as [x0 [G1 G2]]; exists (hp x0)...
assert (M : joins (hp s1) (hp s2)).
destruct D as [x0 [D1 D2]]; exists (hp x0)...
generalize (next_next_join_False _ _ (hp s2) _ _ _ _ H L J)... intro N.
apply N... apply join_sub_refl.
destruct G as [? [[G0 G1] G']]; destruct D as [? [[D0 D1] D']].
solve [rewrite G0, G1, D0; auto].
Qed.
Local Notation "'inter'" := (@andp _).
Local Notation "'un'" := (@orp _).
Proof with try solve [simpl; auto | congruence].
intros A B. destruct atm as [e e0]... destruct B as [s1 B]. simpl.
solve [eapply state_join_var_eq; eauto].
Qed.
Proof with simpl; auto.
induction atms... intros [A B] C. split... solve [eapply pure_atomd_pure; eauto].
Qed.
Proof with simpl; auto.
induction atms... intros [A | A] B.
left; eapply pure_atomd_pure; eauto. right...
Qed.
Proof with simpl; auto.
induction atms... intros [A B] C. split... eapply listd_pure_atomdi; eauto.
Qed.
Proof with simpl; auto.
induction atms... intros [A B] C. split... eapply listd_pure_atomdu; eauto.
Qed.
Proof with try solve [simpl; auto | congruence | inversion 1
| apply listd_pure_atomd_pureu with (s0 := y);
[ | exists x; apply join_comm; auto ]; solve [apply IHsigma; auto]].
revert s; induction sigma... intros s H.
remember a as b; destruct b as [e e0 | ]; simpl.
remember e as b1; destruct b1.
generalize (w_next_nil e0 sigma s H)... generalize H; intros [x [y [A [B C]]]]...
remember e as b; destruct b... generalize (w_lseg_nil e0 sigma s H) as A...
intro. inversion A as [B | B]; [ | inversion B ]. split...
generalize H; intros [x [y [C [D E]]]]...
generalize H; intros [x [y [C [D E]]]]...
Qed.

Lemma do_well3_sound sigma s :
space_denote sigma s ->
listd (fun atms => listd pure_atom_denote un FF atms) inter TT
(do_well3 sigma) s.