Section CNFAnnot.
(** Records annotations used to optimise the cnf. Those need to be kept when pruning the formula. For efficiency, this is a separate function. *)
Fixpoint radd_term (t : Term' * Annot) (cl : clause) : clause + list Annot :=
match cl with
| nil => (* if t is unsat, the clause is empty BUT t is needed. *)
match deduce (fst t) (fst t) with
| Some u => if unsat u then inr ((snd t)::nil) else inl (t::nil)
| None   => inl (t::nil)
end
| t'::cl => (* if t /\ t' is unsat, the clause is empty BUT t & t' are needed *)
match deduce (fst t) (fst t') with
| Some u => if unsat u then inr ((snd t)::(snd t')::nil)
else match radd_term t cl with
| inl cl' => inl (t'::cl')
| inr l   => inr l
end
| None  => match radd_term t cl  with
| inl cl' => inl (t'::cl')
| inr l   => inr l
end
end
end.
Fixpoint ror_clause cl1 cl2 :=
match cl1 with
| nil => inl cl2
| t::cl => match radd_term t cl2 with
| inl cl' => ror_clause cl cl'
| inr l   => inr l
end
end.
Definition ror_clause_cnf t f :=
List.fold_right (fun e '(acc,tg) =>
match ror_clause t e with
| inl cl => (cl :: acc,tg)
| inr l => (acc,tg++l)
end) (nil,nil) f .
Fixpoint ror_cnf f f' :=
match f with
| nil => (cnf_tt,nil)
| e :: rst =>
let (rst_f',t) := ror_cnf rst f' in
let (e_f', t') := ror_clause_cnf e f' in
(rst_f' ++ e_f', t ++ t')
end.
Fixpoint rxcnf {TX AF: Type}(polarity : bool) (f : TFormula TX AF) :=
match f with
| TT => if polarity then (cnf_tt,nil) else (cnf_ff,nil)
| FF  => if polarity then (cnf_ff,nil) else (cnf_tt,nil)
| X p => if polarity then (cnf_ff,nil) else (cnf_ff,nil)
| A x t  => ((if polarity then normalise x t else negate x t),nil)
| N e  => rxcnf (negb polarity) e
| Cj e1 e2 =>
let (e1,t1) := rxcnf polarity e1 in
let (e2,t2) := rxcnf polarity e2 in
if polarity
then  (e1 ++ e2, t1 ++ t2)
else let (f',t') := ror_cnf e1 e2 in
(f', t1 ++ t2 ++ t')
| D e1 e2  =>
let (e1,t1) := rxcnf polarity e1 in
let (e2,t2) := rxcnf polarity e2 in
if polarity
then let (f',t') := ror_cnf e1 e2 in
(f', t1 ++ t2 ++ t')
else (e1 ++ e2, t1 ++ t2)
| I e1 _ e2 =>
let (e1 , t1) := (rxcnf (negb polarity) e1) in
let (e2 , t2) := (rxcnf polarity e2) in
if polarity
then let (f',t') := ror_cnf e1 e2 in
(f', t1 ++ t2 ++ t')
else (and_cnf e1 e2, t1 ++ t2)
end.
End CNFAnnot.
Variable eval  : Env -> Term -> Prop.
Variable eval'  : Env -> Term' -> Prop.
Variable no_middle_eval' : forall env d, (eval' env d) \/ ~ (eval' env d).
Variable unsat_prop : forall t, unsat t  = true ->
forall env, eval' env t -> False.
Variable deduce_prop : forall env t t' u,
eval' env t -> eval' env t' -> deduce t t' = Some u -> eval' env u.
Definition eval_tt (env : Env) (tt : Term' * Annot) := eval' env (fst tt).
Definition eval_clause (env : Env) (cl : clause) := ~ make_conj  (eval_tt env) cl.
Definition eval_cnf (env : Env) (f:cnf) := make_conj  (eval_clause  env) f.
Definition eval_opt_clause (env : Env) (cl: option clause) :=
match cl with
| None => True
| Some cl => eval_clause env cl
end.
Hint Resolve no_middle_eval_tt : tauto.
Variable normalise_correct : forall env t tg, eval_cnf  env (normalise t tg) -> eval env t.
Variable negate_correct : forall env t tg, eval_cnf env (negate t tg) -> ~ eval env t.
Variable Witness : Type.
Variable checker : list (Term'*Annot) -> Witness -> bool.
Variable checker_sound : forall t  w, checker t w = true -> forall env, make_impl (eval_tt env)  t False.
Fixpoint cnf_checker (f : cnf) (l : list Witness)  {struct f}: bool :=
match f with
| nil => true
| e::f => match l with
| nil => false
| c::l => match checker e c with
| true => cnf_checker f l
|   _  => false
end
end
end.
Definition tauto_checker (f:@GFormula Term Prop Annot unit) (w:list Witness) : bool :=
cnf_checker (xcnf true f) w.

Lemma tauto_checker_sound : forall t  w, tauto_checker t w = true -> forall env, eval_f (fun x => x) (eval env)  t.