Module CL  := CL_Sound VSM.       Import CL.
(* import theorem prover *)
(* end hide *)
(* proof of soundness of the main loop *)
Local Open Scope nat_scope.
Local Coercion bool2Prop (b: bool) := b = true.
(*begin hide*)
(* NOTE: obsolete stuff related to proving the invariant the clauses fed into unfolding contain no reflexive spatial atoms of the form Lseg x x. *)
(*Lemma pure_nlsegrefl c : is_pure_clause c -> no_refl_Lseg_clause c. Proof with simpl; auto; try solve[congruence]. destruct c... Qed.*)
(*Lemma drop_reflex_lseg_nlsegreflatms sigma : no_refl_Lseg_spaceatom (drop_reflex_lseg sigma). Proof with simpl; auto; try congruence. unfold no_refl_Lseg_spaceatom. intros x H1. induction sigma... simpl in H1. destruct a. inversion H1... destruct e... destruct e0... inversion H1... destruct e0. inversion H1... remember (negb (eq_var v v0)) as b. if_tac in H1... inversion H1... inversion H. inversion H3. subst. unfold eq_var in Heqb. rewrite fresh.var_compare_refl in Heqb; simpl in Heqb... Qed. *)
(*Local Hint Resolve drop_reflex_lseg_nlsegreflatms.*)
(*Lemma norm_nlsegrefl sel nc : no_refl_Lseg_clause (norm sel nc). Proof with simpl; auto; try congruence. destruct nc as [gamma delta|gamma delta sigma|gamma sigma delta]. apply pure_nlsegrefl; apply norm_pure_pure... unfold norm. unfold normalize2_4. remember (fold_right normalize1_3 (PosSpaceClause gamma delta sigma) (rsort_uniq (rev_cmp compare_clause) (M.elements sel))) as c. destruct c... unfold norm. unfold normalize2_4. remember (fold_right normalize1_3 (NegSpaceClause gamma sigma delta) (rsort_uniq (rev_cmp compare_clause) (M.elements sel))) as c. destruct c... Qed. *)
(*end hide*)
Proof with simpl in *; auto; try solve[congruence].
remember (nat_of_P n - 1)%nat as nn.
revert n Heqnn sigma nc s cl; induction nn; intros ? ?.
(* base case *)
apply positive_base_case in Heqnn; subst.
intros; rewrite the_loop_equation in H2; rewrite Coqlib.peq_true in H2.
inversion H2.
(* inductive case *)
assert (Hnnx: nn = nat_of_P (Ppred n) - 1).
rewrite Ppred_minus;
rewrite nat_of_P_minus_morphism by
(clear - Heqnn; destruct n; simpl in *; auto; discriminate);
unfold nat_of_P at 2; simpl; omega.
specialize (IHnn _ Hnnx). clear Hnnx.
intros sigma nc s cl H0 H1 H2; rewrite the_loop_equation.
rewrite if_false by (clear - Heqnn; intro H; subst;  inversion Heqnn).
clear nn Heqnn.
remember (Superposition.check_clauseset s) as S.
destruct S as [res s']; symmetry in HeqS.
destruct res... destruct p... destruct s0... intros H3 _.
apply (check_clauseset_Valid_sound _ _ _ _ HeqS)...
assert (H3: setd clause_denote inter TT t st).
apply (check_clauseset_Cexample_sound _ _ _ _ _ _ HeqS st)...
remember (M.mem empty_clause t) as E; destruct E as [E|E].
assert (H4: In empty_clause (M.elements t)).
clear - HeqE H3. symmetry in HeqE.
rewrite M.mem_spec in HeqE. rewrite <- Melements_spec1 in HeqE. auto.
unfold setd in H3; apply listd_In_inv_pred with (a := empty_clause) in H3...
if_tac... if_tac... if_tac... apply IHnn...
assert (H4: listd clause_denote inter TT
(rsort_uniq (rev_cmp compare_clause) (M.elements t)) st).
rewrite (@listd_sort_uniq_inter _ state)...
intros x y H4; rewrite rev_cmp_eq in H4...
apply comp_eq in H4; auto.
apply simplify_sound...
edestruct (check_clauseset_Cexample_sound _ _ _ _ _ _ HeqS); eauto.
apply simplify_atoms_sound...
edestruct (check_clauseset_Cexample_sound _ _ _ _ _ _ HeqS); eauto.
apply setd_un.
apply setd_filter_pred.
apply unfolding_sound.
apply norm_sound. intro; auto.
apply check_clauseset_Cexample_sound in HeqS.
specialize (HeqS st H2). destruct HeqS...
apply simplify_atoms_sound...
edestruct (check_clauseset_Cexample_sound _ _ _ _ _ _ HeqS); eauto.
autounfold with DEBUG_UNFOLD.
destruct H...
apply norm_sound...
apply check_clauseset_Cexample_sound in HeqS.
specialize (HeqS st H2). destruct HeqS...
apply simplify_sound...
edestruct (check_clauseset_Cexample_sound _ _ _ _ _ _ HeqS)
as [[H4 H5]]; eauto.
apply setd_fold.
intros. apply relim1_sound; auto.
apply incorp_sound... apply do_wellformed_sound... apply norm_sound...
apply check_clauseset_Cexample_sound in HeqS.
specialize (HeqS st H2). destruct HeqS...
intros; apply simplify_atoms_sound...
edestruct (check_clauseset_Cexample_sound _ _ _ _ _ _ HeqS)
as [[H4 H5]]; eauto.
apply setd_filter_pred... apply unfolding_sound...
apply norm_sound...
apply check_clauseset_Cexample_sound in HeqS.
specialize (HeqS st H2). destruct HeqS...
intros; apply simplify_atoms_sound...
edestruct (check_clauseset_Cexample_sound _ _ _ _ _ _ HeqS)
as [[H4 H5]]; eauto.
apply check_clauseset_Cexample_sound in HeqS.
specialize (HeqS st H2). destruct HeqS...
apply norm_sound...
apply simplify_sound... destruct H...
apply IHnn...
assert (H4: listd clause_denote inter TT
(rsort_uniq (rev_cmp compare_clause) (M.elements t)) st).
rewrite (@listd_sort_uniq_inter _ state)...
intros x y H4; rewrite rev_cmp_eq in H4...  apply comp_eq in H4; auto.
apply simplify_sound...
edestruct (check_clauseset_Cexample_sound _ _ _ _ _ _ HeqS); eauto.
apply simplify_atoms_sound...
edestruct (check_clauseset_Cexample_sound _ _ _ _ _ _ HeqS); eauto.
apply setd_un.
apply do_wellformed_sound... apply norm_sound...
apply check_clauseset_Cexample_sound in HeqS.
specialize (HeqS st H2). destruct HeqS...
intros; apply simplify_atoms_sound...
edestruct (check_clauseset_Cexample_sound _ _ _ _ _ _ HeqS)
as [[H4 H5]]; eauto.
apply setd_fold... intros; apply relim1_sound...
apply do_wellformed_sound... apply norm_sound...
apply check_clauseset_Cexample_sound in HeqS.
specialize (HeqS st H2). destruct HeqS...
intros; apply simplify_atoms_sound...
edestruct (check_clauseset_Cexample_sound _ _ _ _ _ _ HeqS)
as [[H4 H5]]; eauto.
Qed.
(** VeriStar main soundness theorem: veristarulate e = "Valid" ==> entailment semantically valid.*)

Theorem check_entailment_sound: forall (e: entailment),
VeriStar.check_entailment e = VeriStar.Valid -> entailment_denote e.