Module CCS := CCSound VSM. Import CCS.
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 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 positive_superposition (c d : clause) l0 : list clause :=
match c, d with
(* positive (right) superposition *)
| PureClause neg (Eqv (Var s0 as s) t :: pos) _ _,
PureClause neg' (Eqv (Var s'0 as 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 t) (Eqv s' v) &&
greater_than_all s0 neg && greater_than_all s'0 neg'
then mkPureClause
(merge pure_atom_cmp neg neg')
(insu_atm (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
(* negative (left) superposition *)
| PureClause (Eqv s' v :: neg') pos' _ _,
PureClause neg (Eqv (Var s0 as s) t :: pos) _ _ =>
if expr_eq s s' && expr_lt t s && expr_lt v s' &&
pure_atom_gt1 (Eqv s t) pos && greater_than_all s0 neg
then mkPureClause
(insu_atm (norm_pure_atom (Eqv t v)) (merge pure_atom_cmp neg neg'))
(merge pure_atom_cmp pos 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: destruct e...
2: destruct p0... 2: destruct e...
2: simpl; destruct gamma, delta... 2: destruct p... 2: destruct e...
2: destruct p0... 2: destruct e...
destruct delta... destruct p... destruct e...
destruct delta'... destruct p... destruct e...
remember (expr_eq (Var v) (Var v0)) as b; destruct b... if_tac...
rewrite <-(expr_eq_eq' _ _ Heqb) in *. intros H. split... intros H1.
simpl in A, B. apply listd_merge_inter' in H1. destruct H1 as [H2 H3].
2: intros; rewrite pure_atom_cmp_eq...
specialize (A H2); specialize (B H3); rewrite (@listd_insert_uniq_un _ state).
2: intros x y; rewrite <-pure_atom_cmp_eq... destruct A, B.
assert (C: (e0 === e1) s) by (eapply var_eq_trans; apply var_eq_sym in H0; eauto).
left. if_tac... apply var_eq_sym...
right; apply listd_merge_un2... solve[apply pure_atom_cmp_eq; auto].
right; apply listd_merge_un1... solve[apply pure_atom_cmp_eq; auto].
right; apply listd_merge_un1... solve[apply pure_atom_cmp_eq; auto].
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: destruct p...
2: simpl; destruct gamma, delta... 2: destruct p... 2: destruct p...
destruct gamma... destruct p... destruct delta'... destruct p...
destruct e1... remember (expr_eq (Var v) e) as b; destruct b...
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...
apply listd_merge_inter' in H2. destruct H2 as [H4 H5]. simpl in B; spec B...
2: intros x y; rewrite <-pure_atom_cmp_eq...
destruct B.
assert ((e === e0) s). apply var_eq_trans with (y:=e2)...
solve[apply expr_eq_eq' in Heqb; rewrite Heqb in H0; auto].
simpl in A; spec A... split...
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.
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.
specialize (H4 H1 H2 H3); specialize (H5 H1 H2 H3).
rewrite (@listd_unfold_inter _ state). split...
unfold sp. destruct ce...
Qed.
Proof with auto.
intros H1 H2 (*H3*) H4. revert pos0 H1 H2. induction pos... simpl. destruct a...
remember (expr_eq e u) as b; destruct b... intros pos0 H1 H2. if_tac...
rewrite (@listd_unfold_inter _ state). split...
assert (H5 :
listd pure_atom_denote inter TT (Eqv v e0 :: neg) s ->
listd pure_atom_denote un FF
(merge pure_atom_cmp (List.rev pos0) (Eqv u e0 :: pos)) s).
simpl. intros [H5 H6]. specialize (H1 H6). apply expr_eq_eq' in Heqb. subst.
apply listd_merge_un' in H1. destruct H1.
apply listd_merge_un1. apply pure_atom_cmp_eq. auto.
apply listd_merge_un2. apply pure_atom_cmp_eq. auto.
simpl in H. destruct H.
left. apply var_eq_trans with (y:= v)... apply var_eq_trans with (y:=Var u0)...
apply var_eq_sym...
destruct H. left... right...
intros; rewrite pure_atom_cmp_eq; auto.
simpl; split...
simpl. rewrite (@listd_insert_uniq_inter _ state). intros [H6 H7].
2: apply pure_atom_cmp_eq.
rewrite (@listd_insert_uniq_un _ state). 2: apply pure_atom_cmp_eq.
spec H5. simpl; split... if_tac in H6... apply var_eq_sym...
apply listd_merge_un' in H5. destruct H5 as [H5|H5].
right. apply listd_merge_un1. apply pure_atom_cmp_eq. auto.
simpl in H5; destruct H5 as [H|H]. left. if_tac... apply var_eq_sym...
right. apply listd_merge_un2. apply pure_atom_cmp_eq. simpl. right...
apply expr_eq_eq' in Heqb; subst.
intros; rewrite pure_atom_cmp_eq; auto.
apply IHpos. intros H6. specialize (H1 H6).
apply listd_merge_un' in H1. destruct H1.
apply listd_merge_un1. apply pure_atom_cmp_eq.
rewrite (@listd_un_rev _ state), (@listd_insert_uniq_un _ state).
2: apply pure_atom_cmp_eq.
rewrite (@listd_un_rev _ state) in H. solve[right; apply H].
simpl in H; destruct H.
apply listd_merge_un2. apply pure_atom_cmp_eq. simpl; left...
destruct H.
apply listd_merge_un1. apply pure_atom_cmp_eq.
rewrite (@listd_un_rev _ state), (@listd_insert_uniq_un _ state).
left. auto. apply pure_atom_cmp_eq.
apply listd_merge_un2. apply pure_atom_cmp_eq. simpl; right; auto.
intros; rewrite pure_atom_cmp_eq; auto.
auto.
Qed.
Proof with auto.
intros H1 H2. unfold ef. destruct ce... destruct c... destruct delta...
destruct p... destruct e... if_tac...
apply ef_aux_sound... simpl; auto. apply var_eq_refl.
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.

Lemma rewrite_by_sound s t atm st :
(s === t) st -> pure_atom_denote atm st ->
pure_atom_denote (rewrite_by s t atm) st.