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.
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... simpl; intros s [x [y [A [B C]]]].
remember a as b; destruct b... remember e as c; destruct c...
remember (next_in_dom v sigma) as d. if_tac... split...
exfalso. symmetry in Heqd. eapply nn_njoin; eauto.
Qed.
Proof with try solve [simpl; auto; try congruence; try inversion A
| destruct (join_assoc B (join_comm C)) as [q1 [q2 Q]];
apply listd_pure_atomdi with (s0 := q1); [ | eexists; eauto ];
solve [apply IHsigma with (s2 := w2); auto] ].
intros A B C. revert s s2 B C; induction sigma... intros s s2 B C.
simpl in B; destruct B as [w1 [w2 [B [D E]]]]. destruct a...
destruct e... unfold lseg_in_dom_atoms. if_tac...
try unfold Ident.eq in H.
subst x. split...
rewrite <- order_eqv_sound. simpl in A, D.
inversion D; subst. simpl. destruct (join_assoc B (join_comm C)) as [q [Q1 Q2]].
solve [eapply state_join_var_eq; eauto].
cut (stk w1 = stk s1); [ intro Heq; rewrite Heq in * | ].
rewrite H0 in A; destruct A as [A _].
exfalso. destruct B as [_ B]. destruct (join_assoc H3 B) as [q [Q1 Q2]].
eapply next_next_join_False with
(s0 := h0) (s0' := hp s2) (s2 := hp s1) (s1 := hp s1); eauto.
econstructor; eauto.
apply join_sub_refl.
destruct (join_assoc (join_comm B) (join_comm C)) as [q [Q1 Q2]].
destruct (join_stacks_eq _ _ _ Q1)...
Qed.

Lemma ll_spooky x y z s1 s2 s1' s2' s :
lseg (env_get (stk s1) x) (expr_denote y s1) (hp s1) ->
lseg (env_get (stk s1') x) (expr_denote z s1') (hp s1') ->
join_sub s1 s2 -> join_sub s1' s2' -> join s2 s2' s ->
(pure_atom_denote (Eqv (Var x) y) || pure_atom_denote (Eqv (Var x) z))%pred s.