Module Type complete_mod (X: base_mod) (Y: sound_mod X).
(*First we transform a formula to its Negation Normal Form (NNF) by expanding all implications, and pushing Negations to the atomic formulas.*)
Inductive NNF : Set :=
| NPos : PropVars -> NNF
| NNeg : PropVars -> NNF
| NBot : NNF
| NTop : NNF
| NConj : NNF -> NNF -> NNF
| NDisj : NNF -> NNF -> NNF
.
(*MakeNNF A pushes all negations in A to the literals and removes implications. MakeNNFN A does the same for ¬A*)
Fixpoint MakeNNF (A:PropF) : NNF := match A with
| # P   => NPos P
| ⊥     => NBot
| B ∨ C => NDisj (MakeNNF B) (MakeNNF C)
| B ∧ C => NConj (MakeNNF B) (MakeNNF C)
| B → C => NDisj (MakeNNFN B) (MakeNNF C)
end
with MakeNNFN (A:PropF) : NNF := match A with
| # P   => NNeg P
| ⊥     => NTop
| B ∨ C => NConj (MakeNNFN B) (MakeNNFN C)
| B ∧ C => NDisj (MakeNNFN B) (MakeNNFN C)
| B → C => NConj (MakeNNF B) (MakeNNFN C)
end.
(** The inclusion from NNF to formulas*)
Fixpoint NNFtoPropF (A:NNF) : PropF := match A with
| NPos P    => #P
| NNeg P    => ¬ #P
| NBot      => ⊥
| NTop      => ¬⊥
| NConj B C => NNFtoPropF B ∧ NNFtoPropF C
| NDisj B C => NNFtoPropF B ∨ NNFtoPropF C
end.
(** I'm going to model clauses as list of literals and formulas in Conjuntive Normal Form (CNF) as lists of clauses*)
Inductive Literal :=
| LPos : PropVars -> Literal
| LNeg : PropVars -> Literal
| LBot : Literal
| LTop : Literal
.
Fixpoint Bar P := match P with
| LPos Q => LNeg Q
| LNeg Q => LPos Q
| LBot   => LTop
| LTop   => LBot
end.
Fixpoint LiteraltoPropF (P:Literal) : PropF := match P with
| LPos Q => #Q
| LNeg Q => ¬#Q
| LBot   => ⊥
| LTop   => ¬⊥
end.
Definition Clause := list Literal.
(** A clause is the disjunction of literals. As an artifact of this encoding, there is always an ⊥ at the end of a clause). The alternative was to use non-empty lists, i.e. a new inductive type List' defined as Inductive List' (A:Type) : Type := | Singleton : A -> List' | Cons' : A -> List' A -> List' A. I decided against this, since then I have to re-prove basic facts about lists, and I thought that the meta-theoretical proofs would be longer, since parts of the Cons'-case must (perhaps) also be proven for the Singleton-case. *)
Definition ClausetoPropF := map_fold_right LiteraltoPropF Disj ⊥.
Definition CNF := list Clause.
Definition CNFtoPropF := map_fold_right ClausetoPropF Conj ⊤.
(** Definition of the disjunction of - A clause and a formula in CNF - Two formulas in CNF*)
Definition AddClause (l:Clause) (ll:CNF) : CNF := map (fun l2 => l++l2) ll.
Definition Disjunct (ll ll2:CNF) : CNF := flat_map (fun l => AddClause l ll2) ll.
(**MakeCNF A transforms A to CNF*)
Fixpoint MakeCNF (A:NNF) : CNF := match A with
| NPos P    => [[LPos P]]
| NNeg P    => [[LNeg P]]
| NBot      => [[LBot]]
| NTop      => [[LTop]]
| NConj B C => MakeCNF B ++ MakeCNF C
| NDisj B C => Disjunct (MakeCNF B) (MakeCNF C)
end.
(** Syntactical requirement for validity of a clause*)
Definition Valid_Clause (l:Clause) := In LTop l\/exists A,(In (LPos A) l/\In (LNeg A) l).
Definition Valid_CNF ll := forall l, In l ll->Valid_Clause l.
(** * Theorems  We start with the decidability for literals*)
intros;destruct x;destruct y;try (right;discriminate);try (left;reflexivity);
destruct (Varseq_dec p p0);
(left;f_equal;assumption)||(right;intro HH;injection HH;contradiction).
Qed.
(** Proof that A is valid iff NNF A is valid*)
intros v A;induction A;try destruct IHA;try destruct IHA1;try destruct IHA2;split;simpl in *;
try trivial;try rewrite H;try rewrite H0;try rewrite H1;try rewrite H2;try trivial;
repeat rewrite orb_false_r;repeat rewrite orb_false_l;
try rewrite negb_andb;try rewrite negb_orb;try rewrite negb_involutive;reflexivity.
Qed.
(** Proof that NNF A is valid iff CNF A is valid*)
intros;induction ll1;simpl.
reflexivity.
unfold CNFtoPropF in IHll1 at 1;rewrite IHll1.
apply andb_assoc.
Qed.
intros;induction l1;simpl.
reflexivity.
unfold ClausetoPropF in IHl1 at 1;rewrite IHl1.
apply orb_assoc.
Qed.
intros;induction ll;simpl.
rewrite orb_true_r;reflexivity.
unfold CNFtoPropF in IHll at 1;rewrite IHll.
rewrite CNF_or_clause_valid.
rewrite orb_andb_distrib_r.
reflexivity.
Qed.
intros;induction ll1;simpl.
reflexivity.
rewrite CNF_and_valid;rewrite IHll1;rewrite CNF_add_clause_valid.
rewrite orb_andb_distrib_l;reflexivity.
Qed.
intros;induction A;simpl;try reflexivity;try (destruct (v p);simpl;reflexivity;fail);
[rewrite CNF_and_valid|rewrite CNF_or_valid];rewrite IHA1;rewrite IHA2;reflexivity.
Qed.
(** Proof that if a formula in CNF is valid then it is syntactically valid*)
Definition Countervaluation l P := if (in_dec Literal_eqdec (LNeg P) l) then true else false.
Definition Validates v Δ := exists A, In A Δ /\ Is_true (TrueQ v A).
intros;induction m.
contradiction.
simpl in H;case_bool v (LiteraltoPropF a).
exists (LiteraltoPropF a);split;[in_solve|rewrite H0;trivial].
destruct (IHm H) as (?&?&?);exists x;split;[in_solve|assumption].
Qed.
intros l (A&H&K). apply in_map_iff in H as (p&?&H);subst;destruct p;unfold Countervaluation in K;simpl in K.
destruct (in_dec Literal_eqdec (LNeg p) l).
right;eauto.
contradiction.
destruct (in_dec Literal_eqdec (LNeg p) l);contradiction.
contradiction.
left;assumption.
Qed.
intros;apply Validated_valid;apply TrueQ_impl_Validates;apply H;intros ? Q;destruct Q.
Qed.
induction ll;intros ? ? H0;destruct H0;subst.
apply Clause_valid;intros v K;remember (H v K) as i eqn:x;clear x;
simpl in i;case_bool v (ClausetoPropF l).
apply IHll.
intros v K. remember (H v K). eapply proj2. apply andb_prop_elim.
rewrite <- CNF_and_valid. change (a::ll) with ([a]++ll) in H. eapply H;assumption.
assumption.
Qed.
(** Proof that if a formula in CNF is syntactically valid then it's provable*)
intros;induction l1.
apply OrI1;is_ass.
apply OrI2;assumption.
Qed.
intros;induction l1.
apply BotC;mp;[is_ass|destruct a;simpl;apply OrI1];
try (apply ImpI;mp;[is_ass|apply OrI2;apply Clause_provable_3;in_solve]);
(apply BotC;mp;[constructor;constructor 2;in_solve|apply OrI2;apply Clause_provable_3;in_solve]).
apply OrI2;assumption.
Qed.

Theorem Clause_provable : forall l, Valid_Clause l -> Provable (ClausetoPropF l).