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.

Lemma reflexivity_resolution_sound c l0 s :
clause_denote c s -> listd clause_denote inter TT l0 s ->
listd clause_denote inter TT (reflexivity_resolution c l0) s.