Module Clausify := Clausify_Sound VSM. Import Clausify.
Proof with simpl; auto; try solve[congruence].
intros H1 H2 H3.
remember (spatial_resolution c1 c2) as l.
case_eq (M.is_empty l); intros.
rewrite M.is_empty_spec in H.
rewrite (@setd_base_separate state); auto.
split; auto.
unfold setd.
rewrite empty_set_elems' in H. rewrite H. simpl; auto.
assert (exists c, l = M.singleton c).
subst l.
rewrite is_empty_spec' in H.
clear - H.
destruct c1; simpl in *; try (contradiction H; apply M.empty_spec).
destruct c2; simpl in *; try (contradiction H; apply M.empty_spec).
if_tac in H;simpl in *; try (contradiction H; apply M.empty_spec).
econstructor; eauto.
destruct H0 as [c ?].
subst l.
rewrite H0.
clear H.
eapply spatial_resolution_sound in H0; eauto.
unfold setd.
rewrite elements_singleton; simpl; split; auto.
Qed.
Definition Rule_U1 (nc pc : clause) :=
match nc , pc with
PosSpaceClause Gamma Delta ((Next x z)::Sigma) ,
NegSpaceClause Gamma' (Lseg x' z'::Sigma') Delta' =>
match expr_cmp x x', expr_cmp z z' with
Eq, Eq => Some (NegSpaceClause Gamma' (Next x' z'::Sigma')
(Eqv x z :: Delta'))
| _, _ => None
end
| _ , _ => None
end.
(*Lemma SR: forall pc nc , (forall s, clause_denote pc s /\ clause_denote nc s) -> forall s, setd clause_denote inter TT (spatial_resolution pc nc) s. *)
Definition Rule_U2 (nc pc : clause) :=
match nc , pc with
PosSpaceClause Gamma Delta ((Next x y)::Sigma) ,
NegSpaceClause Gamma' (Lseg x' z::Sigma') Delta' =>
match expr_cmp x x' with
Eq => Some (NegSpaceClause Gamma' (Next x y::Lseg y z::Sigma')
(Eqv x z :: Delta'))
|_ => None
end
| _ , _ => None
end.
Definition Rule_U3 (nc pc : clause) :=
match nc , pc with
PosSpaceClause Gamma Delta ((Lseg x y)::Sigma) ,
NegSpaceClause Gamma' (Lseg x' Nil::Sigma') Delta' =>
match expr_cmp x x' with
Eq => Some (NegSpaceClause Gamma' (Lseg x y::Lseg y Nil::Sigma') Delta')
|_ => None
end
| _ , _ => None
end.
intros.
rewrite Space_denote_cons in SD1, SD2.
destruct SD1 as [s1 [s1' [J1 [K1 K1']]]].
destruct SD2 as [s2 [s2' [J2 [K2 K2']]]].
simpl in K1, K2.
repeat rewrite <- (expr_denote_join _ _ _ _ J1) in K1.
repeat rewrite <- (expr_denote_join _ _ _ _ J2) in K2.
assert (s2 = s1 /\ s2' = s1').
assert (hp s2 = hp s1 /\ hp s2' = hp s1').
eapply (lseg_unique _ _ _ K1 _ K2 (hp s1') (hp s)). apply J1. apply J2.
destruct H as [HP1 HP2]. destruct s2. destruct s2'. destruct s1. destruct s1'.
destruct (join_stacks_eq _ _ _ J1).
destruct (join_stacks_eq _ _ _ J2).
simpl in *. subst. subst. split; trivial.
destruct H; subst. clear J2 K2.
rewrite Space_denote_cons in K1', K2'.
destruct K1' as [t1 [t1' [I1 [G1 G1']]]].
destruct K2' as [t2 [t2' [I2 [G2 G2']]]].
simpl in G1.
repeat rewrite <- (expr_denote_join _ _ _ _ I1) in G1.
repeat rewrite <- (expr_denote_join _ _ _ _ (join_comm J1)) in G1.
simpl in G2. remember (val2loc (expr_denote z t2)) as b; destruct b; subst.
destruct (join_assoc (join_comm I1) (join_comm J1)) as [u [JJ KK]].
exists u. exists t1'. split. apply (join_comm KK).
split; try assumption.
eapply lseg_lseg_app. rewrite <- (expr_denote_join _ _ _ _ (join_comm KK)). apply K1.
rewrite <- (expr_denote_join _ _ _ _ (join_comm KK)). apply G1.
apply JJ.
rewrite <- (expr_denote_join _ _ _ _ I2) in Heqb.
rewrite <- (expr_denote_join _ _ _ _ (join_comm J1)) in Heqb.
rewrite <- (expr_denote_join _ _ _ _ (join_comm KK)). rewrite <- Heqb. reflexivity.
assert (emp_at l0 (hp s1)).
destruct G2. apply rawnext2rawnext' in H.
destruct (@rawnext_at1 _ _ _ (hp t2') (hp s1') H). apply I2.
destruct (@rawnext_at1 _ _ _ (hp s1) (hp s) H2). apply join_comm. apply J1. assumption.
eapply (@emp_at_join (hp t1) (hp s1) (hp u)). apply JJ.
split; trivial.
destruct (lseg_end _ _ _ G1).
destruct H0. apply heap_gempty. apply H1.
destruct H0. rewrite <- (expr_denote_join _ _ _ _ I2) in Heqb.
rewrite <- (expr_denote_join _ _ _ _ (join_comm J1)) in Heqb.
rewrite H0 in Heqb. rewrite nil_not_loc in Heqb. inversion Heqb.
destruct H0 as [lc [vlc elc]]. rewrite <- (expr_denote_join _ _ _ _ I2) in Heqb.
rewrite <- (expr_denote_join _ _ _ _ (join_comm J1)) in Heqb.
rewrite vlc in Heqb. inversion Heqb. subst. assumption.
contradiction.
Qed.
Proof with simpl; auto; try solve[congruence].
intro H1. apply setd_fold_left... intros c cls s0 H2 H3; apply setd_add...
unfold setd; rewrite empty_set_elems...
Qed.
Local Notation listd_unfold_state := (@listd_unfold_inter _ state).
Proof with auto.
intros H0 H1 H2. unfold do_unfold'.
rewrite listd_app, listd_unfold_state; split. solve[apply unfolding1_sound;auto].
rewrite listd_app, listd_unfold_state; split. solve[apply unfolding2_sound;auto].
rewrite listd_app, listd_unfold_state; split. solve[apply unfolding3_sound;auto].
rewrite listd_app, listd_unfold_state; split. solve[apply unfolding4_sound;auto].
rewrite listd_app, listd_unfold_state; split. solve[apply unfolding6_sound;auto].
auto.
Qed.
Proof with simpl; auto; try solve[congruence].
revert s s'; induction n... intros s s' H1 H2.
case_eq (add_list_to_set (M.fold (do_unfold' c) s []) s); intros.
apply add_list_to_set_spec1 in H.
rewrite add_list_union in H.
apply (IHn t s'); auto.
eapply setd_cong. apply H.
apply setd_un...
apply clause_setd_listd...
rewrite M.fold_spec.
apply listd_fold_left... intros c' cls H3 H4.
unfold Basics.flip.
apply do_unfold'_sound...
subst s'; auto.
Qed.

Lemma unfolding_sound c1 c2 s :
clause_denote c1 s -> clause_denote c2 s ->
setd clause_denote inter TT (unfolding c1 c2) s.