Section S.
(** A cnf tracking annotations of atoms. *)
(** Type parameters *)
Variable Env   : Type.
Variable Term  : Type.
Variable Term' : Type.
Variable Annot : Type.
Local Notation Trace := (Trace Annot).
Variable unsat : Term'  -> bool. (* see [unsat_prop] *)
Variable deduce : Term' -> Term' -> option Term'. (* see [deduce_prop] *)
Local Notation null := (@null Annot).
Local Notation push := (@push Annot).
Local Notation merge := (@merge Annot).
Definition clause := list  (Term' * Annot).
Definition cnf := list clause.
Variable normalise : Term -> Annot -> cnf.
Variable negate : Term -> Annot -> cnf.
Definition cnf_tt : cnf := @nil clause.
Definition cnf_ff : cnf :=  cons (@nil (Term' * Annot)) nil.
(** Our cnf is optimised and detects contradictions on the fly. *)
Fixpoint add_term (t: Term' * Annot) (cl : clause) : option clause :=
match cl with
| nil =>
match deduce (fst t) (fst t) with
| None =>  Some (t ::nil)
| Some u => if unsat u then None else Some (t::nil)
end
| t'::cl =>
match deduce (fst t) (fst t') with
| None =>
match add_term t cl with
| None => None
| Some cl' => Some (t' :: cl')
end
| Some u =>
if unsat u then None else
match add_term t cl with
| None => None
| Some cl' => Some (t' :: cl')
end
end
end.
Fixpoint or_clause (cl1 cl2 : clause) : option clause :=
match cl1 with
| nil => Some cl2
| t::cl => match add_term t cl2 with
| None => None
| Some cl' => or_clause cl cl'
end
end.
Definition xor_clause_cnf (t:clause) (f:cnf) : cnf :=
List.fold_left (fun acc e =>
match or_clause t e with
| None => acc
| Some cl => cl :: acc
end) f nil .
Definition or_clause_cnf (t: clause) (f:cnf) : cnf :=
match t with
| nil => f
| _   => xor_clause_cnf t f
end.
Fixpoint or_cnf (f : cnf) (f' : cnf) {struct f}: cnf :=
match f with
| nil => cnf_tt
| e :: rst => (or_cnf rst f') +++ (or_clause_cnf e f')
end.
Definition and_cnf (f1 : cnf) (f2 : cnf) : cnf :=
f1 +++ f2.
(** TX is Prop in Coq and EConstr.constr in Ocaml. AF is unit in Coq and Names.Id.t in Ocaml *)
Definition TFormula (TX: kind -> Type) (AF: Type) := @GFormula Term TX Annot AF.
Definition is_cnf_tt (c : cnf) : bool :=
match c with
| nil => true
| _  => false
end.
Definition is_cnf_ff (c : cnf) : bool :=
match c with
| nil::nil => true
| _        => false
end.
Definition and_cnf_opt (f1 : cnf) (f2 : cnf) : cnf :=
if is_cnf_ff f1 || is_cnf_ff f2
then cnf_ff
else
if is_cnf_tt f2
then f1
else and_cnf f1 f2.
Definition or_cnf_opt (f1 : cnf) (f2 : cnf) : cnf :=
if is_cnf_tt f1 || is_cnf_tt f2
then cnf_tt
else if is_cnf_ff f2
then f1 else or_cnf f1 f2.
Section REC.
Context {TX : kind -> Type}.
Context {AF : Type}.
Variable REC : forall (pol : bool) (k: kind) (f : TFormula TX AF k), cnf.
Definition mk_and (k: kind) (pol:bool) (f1 f2 : TFormula TX AF k):=
(if pol then and_cnf_opt else or_cnf_opt) (REC pol f1) (REC pol f2).
Definition mk_or (k: kind) (pol:bool) (f1 f2 : TFormula TX AF k):=
(if pol then or_cnf_opt else and_cnf_opt) (REC pol f1) (REC pol f2).
Definition mk_impl (k: kind) (pol:bool) (f1 f2 : TFormula TX AF k):=
(if pol then or_cnf_opt else and_cnf_opt) (REC (negb pol) f1) (REC pol f2).
Definition mk_iff (k: kind) (pol:bool) (f1 f2: TFormula TX AF k):=
or_cnf_opt (and_cnf_opt (REC (negb pol) f1) (REC false f2))
(and_cnf_opt (REC pol f1) (REC true f2)).
End REC.
Definition is_bool {TX : kind -> Type} {AF: Type} (k: kind) (f : TFormula TX AF k) :=
match f with
| TT _ => Some true
| FF _ => Some false
| _    => None
end.

Lemma is_bool_inv : forall {TX : kind -> Type} {AF: Type} (k: kind) (f : TFormula  TX AF k) res,
is_bool f = Some res -> f = if res then TT _ else FF _.