Module VSM := VSM.
Implicit Arguments list_denote [A T].
Local Notation "'listd'" := list_denote.
Implicit Arguments andp [A].
Local Notation "'inter'" := (@andp _). (*implicit arguments acting weird*)
(* the following five rules (barring reflexivity resolution, which is performed during the simplification phase) are collected in rule "sp" *)
Definition positive_superposition (c d : clause) l0 : list clause :=
match c , d with
| PureClause nil (Eqv s t :: pos) _ _ ,
PureClause nil (Eqv s' v :: pos') _ _ =>
if expr_eq s s' && expr_lt t s && expr_lt v s' &&
pure_atom_gt1 (Eqv s t) pos && pure_atom_gt1 (Eqv s' v) pos' &&
pure_atom_gt (Eqv s' v) (Eqv s t)
then mkPureClause nil (insert_uniq pure_atom_cmp (norm_pure_atom (Eqv t v))
(merge pure_atom_cmp pos pos')) :: l0
else l0
| _ , _ => l0
end.
Definition negative_superposition (c d : clause) l0 : list clause :=
match c , d with
| PureClause nil (Eqv s t :: pos) _ _,
PureClause (Eqv s' v :: neg') pos' _ _ =>
if expr_eq s s' && expr_lt t s && expr_lt v s'
then mkPureClause (insert_uniq pure_atom_cmp (norm_pure_atom (Eqv t v)) neg')
(merge pure_atom_cmp pos pos') :: l0
else l0
| _ , _ => l0
end.
Definition reflexivity_resolution (d : clause) l0 : list clause :=
match d with
| PureClause (Eqv u v :: neg) pos _ _ =>
if expr_eq u v then mkPureClause neg pos :: l0 else l0
| _ => l0
end.
Definition ordered_factoring (c : clause) l0 : list clause :=
match c with
| PureClause nil (Eqv s t :: Eqv u v :: pos) _ _ =>
if pure_atom_eq (Eqv s t) (Eqv u v)
then mkPureClause nil
(insert_uniq pure_atom_cmp (norm_pure_atom (Eqv s t)) pos)
:: l0
else l0
| _ => l0
end.
Definition equality_factoring (c : clause) l0 : list clause :=
match c with
| PureClause nil (Eqv u v :: Eqv s t :: pos) _ _ =>
if expr_eq s u && pure_atom_gt (Eqv u v) (Eqv s t)
then mkPureClause [norm_pure_atom (Eqv v t)]
(insert_uniq pure_atom_cmp (norm_pure_atom (Eqv u t)) pos) :: l0
else l0
| _ => l0
end.
Proof with simpl; auto.
intros A B; destruct c as [gamma delta| |]; destruct d as [gamma' delta'| |]...
2: simpl; destruct gamma, delta... 2: destruct p...
2: simpl; destruct gamma, delta... 2: destruct p...
destruct gamma, delta as [|atm delta]...
destruct atm as [e1 e2], delta'... (*destruct p...*) simpl in A; spec A...
destruct gamma'... destruct gamma'... destruct p...
remember (expr_eq e1 e) as b; destruct b. 2: simpl; auto.
if_tac... split... intro H1. specialize (B H1). simpl in B.
rewrite (@listd_insert_uniq_un _ state)... 2: apply pure_atom_cmp_eq.
destruct A as [A|A];destruct B as [B|B]... rewrite <-(expr_eq_eq' _ _ Heqb) in B.
assert (C: (e0 === e2) s) by (eapply var_eq_trans; apply var_eq_sym in B; eauto).
left; if_tac... solve[apply var_eq_sym; auto].
right; apply listd_merge_un2... solve[apply pure_atom_cmp_eq].
right; apply listd_merge_un1... solve[apply pure_atom_cmp_eq].
right; apply listd_merge_un2... solve[apply pure_atom_cmp_eq].
Qed.
Proof with simpl; auto.
intros A B; destruct c as [gamma delta| |]; destruct d as [gamma' delta'| |]...
2: simpl; destruct gamma, delta... 2: destruct p...
2: simpl; destruct gamma, delta... 2: destruct p...
destruct gamma, delta... destruct p... destruct gamma'... destruct p...
remember (expr_eq e e1) as b; destruct b. 2: simpl; auto.
if_tac; [simpl|simpl; auto]; rewrite interS; simpl. intro H3. split...
rewrite (@listd_insert_uniq_inter _ state)... 2: apply pure_atom_cmp_eq.
intros [H1 H2].
assert ((e2 === e0) s). if_tac in H1; simpl in H1... apply var_eq_sym...
simpl in A; spec A... inversion A.
simpl in B; spec B. split... apply expr_eq_eq' in Heqb; subst e1.
eapply var_eq_trans; eapply var_eq_sym in H; eauto.
apply listd_merge_un2... solve[apply pure_atom_cmp_eq].
apply listd_merge_un1... solve[apply pure_atom_cmp_eq].
Qed.
Proof with
try solve [simpl; destruct delta as [|p]; simpl; auto; destruct p; simpl; auto].
intros A; destruct c as [gamma delta| |]...
simpl; destruct gamma as [|p]; simpl; auto; destruct p...
remember (expr_eq e e0) as b; destruct b; simpl; try split; auto.
intro Hyp; apply A; rewrite (expr_eq_eq' _ _ Heqb); simpl; split; auto.
solve[apply var_eq_refl].
Qed.
Proof with
simpl; auto;
try solve [simpl; destruct delta as [|p]; simpl; auto; destruct p; simpl; auto].
intros A; destruct c as [gamma delta| |]...
destruct gamma... destruct delta... destruct p... destruct delta... destruct p...
(*simpl; destruct delta as [|p]; simpl; auto; destruct p... destruct delta as [|p]; simpl; auto; destruct p...*)
remember (expr_eq e e1) as b1; remember (expr_eq e0 e2) as b2.
destruct b1, b2...
if_tac... simpl; split; auto. intro Hyp.
rewrite (listd_insert_uniq_un pure_atom_denote FF). 2: apply pure_atom_cmp_eq.
rewrite (expr_eq_eq' _ _ Heqb1), (expr_eq_eq' _ _ Heqb2) in A |- *.
simpl in A; destruct A as [A|[A|A]]; [auto| | |right; auto].
solve [left; if_tac; simpl; solve[auto | apply var_eq_sym; auto]].
solve [left; if_tac; simpl; solve[auto | apply var_eq_sym; auto]].
replace (pure_atom_eq (Eqv e e0) (Eqv e1 e2)) with false; auto.
unfold pure_atom_eq; simpl.
unfold expr_eq in Heqb1. destruct (expr_cmp e e1); simpl; try congruence.
unfold expr_eq in Heqb2. destruct (expr_cmp e0 e2);simpl; try congruence.
replace (pure_atom_eq (Eqv e e0) (Eqv e1 e2)) with false; auto.
unfold pure_atom_eq; simpl.
unfold expr_eq in Heqb1. destruct (expr_cmp e e1); simpl; try congruence.
replace (pure_atom_eq (Eqv e e0) (Eqv e1 e2) ) with false; auto.
unfold pure_atom_eq; simpl.
unfold expr_eq in Heqb1. destruct (expr_cmp e e1); simpl; try congruence.
Qed.
Proof with
simpl; auto;
try solve [simpl; destruct gamma as [|p]; simpl; auto; destruct p; simpl; auto].
intros A; destruct c as [gamma delta| |]... simpl.
destruct gamma... destruct delta... destruct p... destruct delta... destruct p...
remember (expr_eq e1 e) as b; destruct b...
if_tac... simpl; split; auto. intro Hyp.
rewrite (listd_insert_uniq_un pure_atom_denote FF). 2: apply pure_atom_cmp_eq.
destruct Hyp as [B C].
simpl in A; destruct A as [A|[A|A]]; [auto| | |right; auto].
assert (D : (e === e2) s).
if_tac in B; simpl in B;
apply (var_eq_trans _ _ _ _ A); [apply var_eq_sym; auto | auto].
solve[left; if_tac; simpl; [apply var_eq_sym; auto | auto]].
assert (D : (e === e2) s).
rewrite <- (expr_eq_eq' _ _ Heqb) .
if_tac in B; simpl in B;
apply (var_eq_trans _ _ _ _ A); [apply var_eq_sym; auto | auto];
apply var_eq_refl.
solve[left; if_tac; simpl; [apply var_eq_sym; auto | auto]].
Qed.
Proof with simpl; auto.
intros H1 H2 H3.
generalize (negative_superposition_sound c d l0 s) as H4; intro.
generalize (positive_superposition_sound c d l0 s) as H5; intro.
generalize (equality_factoring_sound c l0 s) as H6; intro.
generalize (ordered_factoring_sound c l0 s) as H7; intro.
specialize (H4 H1 H2 H3); specialize (H5 H1 H2 H3).
specialize (H6 H1 H3); specialize (H7 H1 H3).
rewrite (@listd_unfold_inter _ state). split...
destruct c, d... simpl in H4, H5, H6.
destruct gamma, delta... destruct p...
destruct gamma0, delta0... destruct p... if_tac... split... intros _.
destruct H5 as [H5 _].
rewrite (@listd_unfold_un _ state). left. apply H5...
Qed.
Proof with simpl; auto.
intros H1 H2 H3. unfold superpose. apply sp_sound... apply sp_sound...
Qed.
Proof with simpl; auto.
intro H1. destruct c... intros H2.
2: intros; left; unfold var_eq; auto.
2: intros; left; unfold var_eq; auto.
rewrite (@listd_sort_uniq_inter _ state), remove_trivial_atoms_equiv in H2.
rewrite (@listd_sort_uniq_un _ state). apply (H1 H2).
intros x y; rewrite <-pure_atom_cmp_eq; auto.
intros x y; rewrite <-pure_atom_cmp_eq; auto.
Qed.
Proof with simpl; auto.
intro H1. apply prop_ext; split. intro H2.
destruct atm as [e1 e2]. simpl.
remember (expr_eq s e1) as b1; remember (expr_eq s e2) as b2.
destruct b1. destruct b2...
assert (H3: (t === t) st) by (apply var_eq_refl). if_tac...
assert (H3: (t === e2) st).
apply var_eq_trans with (y := s). apply var_eq_sym...
apply expr_eq_eq' in Heqb1; subst s.
apply var_eq_trans with (y := e1)... apply var_eq_refl.
if_tac... apply var_eq_sym...
destruct b2...
assert (H3: (e1 === t) st).
apply var_eq_trans with (y := e2)...
apply var_eq_trans with (y := s)...
apply expr_eq_eq' in Heqb2; subst s. apply var_eq_refl.
if_tac... apply var_eq_sym...
(* <-- *)
intro H2; destruct atm as [e1 e2]. simpl.
simpl in H2. remember (expr_eq s e1) as b1; remember (expr_eq s e2) as b2.
destruct b1. destruct b2... if_tac in H2.
apply expr_eq_eq' in Heqb1. apply expr_eq_eq' in Heqb2.
subst. subst e1. apply var_eq_refl.
apply expr_eq_eq' in Heqb1. apply expr_eq_eq' in Heqb2.
subst. subst e1. apply var_eq_refl.
apply expr_eq_eq' in Heqb1. subst s. simpl in H2. if_tac in H2.
simpl in H2. apply var_eq_trans with (y := t)... apply var_eq_sym...
simpl in H2.  apply var_eq_trans with (y := t)... apply var_eq_sym...
simpl in H2. destruct b2. apply expr_eq_eq' in Heqb2. subst s.
if_tac in H2; simpl in H2.
apply var_eq_trans with (y := t)...
apply var_eq_trans with (y := t)... apply var_eq_sym...
simpl in H2. apply var_eq_sym...
Qed.
Proof with simpl; auto.
intro H1; rewrite <-rewrite_by_eqv...
Qed.
Proof with simpl; auto.
intro H1; rewrite <-rewrite_by_eqv...
Qed.
Proof with simpl; auto.
intros H1 H2. destruct c... destruct gamma, delta...
destruct p... destruct delta... destruct d... intro H3.
simpl in H1; spec H1; auto.
inversion H1. 2: inversion H. clear H1.
subst priority0.
induction gamma. simpl in H2; spec H2; auto. induction delta...
inversion H2. left. apply rewrite_by_sound... right. apply IHdelta...
destruct H3 as [H3 H4]. apply IHgamma... intro H5. simpl in H2; spec H2.
split... rewrite <-rewrite_by_eqv in H3... auto.
Qed.
Proof with simpl; auto.
intros H1 H2 H3. revert c0 H2. induction l... intros c0 H2.
inversion H1; apply IHl...
Qed.
Proof with simpl; auto.
intros H1 H2. unfold simplify. apply delete_resolved_sound.
apply clause_denote_foldl...
intros c0 d H3 H4; apply demodulate_sound...
Qed.
Proof with simpl; auto.
intros A B; unfold infer_list. autounfold with DEBUG_UNFOLD.
apply listd_filter_pred.
apply listd_map_pred with (f := clause_denote).
solve[intros d H1; apply simplify_sound; auto].
apply listd_fold_left... intros d cls H1 H2.
apply superpose_sound...
Qed.
Proof with auto.
revert a'; induction l... intro a'. simpl. destruct (cmp a a0)...
simpl; intros [B | B]... specialize (IHl a' B). destruct IHl...
Qed.
Proof with simpl; auto.
revert a; induction l; intro a'... intro B.
cut (a = a' \/ In a' (rsort_uniq cmp l)); [intro C|].
destruct C... eapply insert_uniq_In; eauto.
Qed.
Proof with try inversion 1; auto.
unfold setd.
remember (M.min_elt cls) as b. destruct b... symmetry in Heqb.
apply M.min_elt_spec1 in Heqb; rewrite <- M.elements_spec1 in Heqb.
rewrite SetoidList.InA_alt in Heqb. destruct Heqb as [y [B C]].
subst. subst. auto.
Qed.
Proof with try inversion 1; auto.
intro A. remember (M.min_elt cls) as b. destruct b...
eapply listd_In_inv_pred; eauto. solve[rewrite Heqb in H; eapply pick_In; eauto].
Qed.
Proof with simpl; auto.
unfold one_inference_step; intros A B C.
(*DEBUGGING*)
autounfold with DEBUG_UNFOLD in *.
(*DEBUGGING*)
remember (M.delete_min unselected) as b. destruct b as [[c unselected'']| ].
2: inversion C; subst; split; auto.
symmetry in Heqb.
apply M.delete_min_spec1 in Heqb.
destruct Heqb as [Heqb ?]. subst unselected''.
remember (mem_add (simplify (M.elements given) c) given) as q.
destruct q as [new_given|].
if_tac in C. inversion C; subst. split. clear C.
symmetry in Heqq; eapply setd_mem_add with (cls := given); eauto.
apply simplify_sound; auto. eapply pick_sound; eauto.
apply setd_fold_left...
clear C. intros until s0. intros H1 H2. if_tac... solve[apply setd_add; auto].
apply infer_list_sound... apply simplify_sound... eapply pick_sound; eauto.
apply setd_remove; auto.
inversion C; subst; split; auto. apply setd_remove; auto.
if_tac in C; inversion C; subst. split; auto. apply setd_remove; auto.
split; auto. apply setd_remove; auto.
Qed.

Lemma simple_loop_induction (P : M.t*M.t -> Prop)
given unselected r given' unselected' :
(forall g u g' u',
P (g, u) ->
one_inference_step (g, u) = (g', u') -> P (g', u')) ->
P (given, unselected) ->
loop (given, unselected) = (r, given', unselected') -> P (given', unselected').