Section ClosedPredicates.
Variables S : {pred A}.
Definition divalg_closed := [/\ 1 \in S, linear_closed S & divr_2closed S].
(* Evaluation of a reified formula *)
Fixpoint holds (e : seq R) (f : formula R) {struct f} : Prop :=
match f with
| Bool b => b
| (t1 == t2)%T => eval e t1 = eval e t2
| Unit t1 => eval e t1 \in unit
| (f1 /\ f2)%T => holds e f1 /\ holds e f2
| (f1 \/ f2)%T => holds e f1 \/ holds e f2
| (f1 ==> f2)%T => holds e f1 -> holds e f2
| (~ f1)%T => ~ holds e f1
| ('exists 'X_i, f1)%T => exists x, holds (set_nth 0 e i x) f1
| ('forall 'X_i, f1)%T => forall x, holds (set_nth 0 e i x) f1
end.
(* Boolean test selecting terms in the language of rings *)
Fixpoint rterm (t : term R) :=
match t with
| _^-1 => false
| t1 + t2 | t1 * t2 => rterm t1 && rterm t2
| - t1 | t1 *+ _ | t1 ^+ _ => rterm t1
| _ => true
end%T.
(* Boolean test selecting formulas in the theory of rings *)
Fixpoint rformula (f : formula R) :=
match f with
| Bool _ => true
| t1 == t2 => rterm t1 && rterm t2
| Unit t1 => false
| f1 /\ f2 | f1 \/ f2 | f1 ==> f2 => rformula f1 && rformula f2
| ~ f1 | ('exists 'X__, f1) | ('forall 'X__, f1) => rformula f1
end%T.
(* Upper bound of the names used in a term *)
Fixpoint ub_var (t : term R) :=
match t with
| 'X_i => i.+1
| t1 + t2 | t1 * t2 => maxn (ub_var t1) (ub_var t2)
| - t1 | t1 *+ _ | t1 ^+ _ | t1^-1 => ub_var t1
| _ => 0%N
end%T.
(* Replaces inverses in the term t by fresh variables, accumulating the *)
(* substitution. *)
Fixpoint to_rterm (t : term R) (r : seq (term R)) (n : nat) {struct t} :=
match t with
| t1^-1 =>
let: (t1', r1) := to_rterm t1 r n in
('X_(n + size r1), rcons r1 t1')
| t1 + t2 =>
let: (t1', r1) := to_rterm t1 r n in
let: (t2', r2) := to_rterm t2 r1 n in
(t1' + t2', r2)
| - t1 =>
let: (t1', r1) := to_rterm t1 r n in
(- t1', r1)
| t1 *+ m =>
let: (t1', r1) := to_rterm t1 r n in
(t1' *+ m, r1)
| t1 * t2 =>
let: (t1', r1) := to_rterm t1 r n in
let: (t2', r2) := to_rterm t2 r1 n in
(Mul t1' t2', r2)
| t1 ^+ m =>
let: (t1', r1) := to_rterm t1 r n in
(t1' ^+ m, r1)
| _ => (t, r)
end%T.
(* A ring formula stating that t1 is equal to 0 in the ring theory. *)
(* Also applies to non commutative rings.                           *)
Definition eq0_rform t1 :=
let m := ub_var t1 in
let: (t1', r1) := to_rterm t1 [::] m in
let fix loop r i := match r with
| [::] => t1' == 0
| t :: r' =>
let f := 'X_i * t == 1 /\ t * 'X_i == 1 in
'forall 'X_i, (f \/ 'X_i == t /\ ~ ('exists 'X_i,  f)) ==> loop r' i.+1
end%T
in loop r1 m.
(* Transformation of a formula in the theory of rings with units into an *)
(* equivalent formula in the sub-theory of rings.                        *)
Fixpoint to_rform f :=
match f with
| Bool b => f
| t1 == t2 => eq0_rform (t1 - t2)
| Unit t1 => eq0_rform (t1 * t1^-1 - 1)
| f1 /\ f2 => to_rform f1 /\ to_rform f2
| f1 \/ f2 =>  to_rform f1 \/ to_rform f2
| f1 ==> f2 => to_rform f1 ==> to_rform f2
| ~ f1 => ~ to_rform f1
| ('exists 'X_i, f1) => 'exists 'X_i, to_rform f1
| ('forall 'X_i, f1) => 'forall 'X_i, to_rform f1
end%T.
(* Boolean test selecting formulas which describe a constructible set, *)
(* i.e. formulas without quantifiers.                                  *)
(* The quantifier elimination check. *)
Fixpoint qf_form (f : formula R) :=
match f with
| Bool _ | _ == _ | Unit _ => true
| f1 /\ f2 | f1 \/ f2 | f1 ==> f2 => qf_form f1 && qf_form f2
| ~ f1 => qf_form f1
| _ => false
end%T.
(* Boolean holds predicate for quantifier free formulas *)
Definition qf_eval e := fix loop (f : formula R) : bool :=
match f with
| Bool b => b
| t1 == t2 => (eval e t1 == eval e t2)%bool
| Unit t1 => eval e t1 \in unit
| f1 /\ f2 => loop f1 && loop f2
| f1 \/ f2 => loop f1 || loop f2
| f1 ==> f2 => (loop f1 ==> loop f2)%bool
| ~ f1 => ~~ loop f1
|_ => false
end%T.
Implicit Type bc : seq (term R) * seq (term R).
(* Quantifier-free formula are normalized into DNF. A DNF is *)
(* represented by the type seq (seq (term R) * seq (term R)), where we *)
(* separate positive and negative literals *)
(* DNF preserving conjunction *)
Definition and_dnf bcs1 bcs2 :=
\big[cat/nil]_(bc1 <- bcs1)
map (fun bc2 => (bc1.1 ++ bc2.1, bc1.2 ++ bc2.2)) bcs2.
(* Computes a DNF from a qf ring formula *)
Fixpoint qf_to_dnf (f : formula R) (neg : bool) {struct f} :=
match f with
| Bool b => if b (+) neg then [:: ([::], [::])] else [::]
| t1 == t2 => [:: if neg then ([::], [:: t1 - t2]) else ([:: t1 - t2], [::])]
| f1 /\ f2 => (if neg then cat else and_dnf) [rec f1, neg] [rec f2, neg]
| f1 \/ f2 => (if neg then and_dnf else cat) [rec f1, neg] [rec f2, neg]
| f1 ==> f2 => (if neg then and_dnf else cat) [rec f1, ~~ neg] [rec f2, neg]
| ~ f1 => [rec f1, ~~ neg]
| _ =>  if neg then [:: ([::], [::])] else [::]
end%T where "[ 'rec' f , neg ]" := (qf_to_dnf f neg).
(* Conversely, transforms a DNF into a formula *)
Definition dnf_to_form :=
let pos_lit t := And (t == 0) in let neg_lit t := And (t != 0) in
let cls bc := Or (foldr pos_lit True bc.1 /\ foldr neg_lit True bc.2) in
foldr cls False.
Definition dnf_rterm cl := all rterm cl.1 && all rterm cl.2.

Lemma dnf_to_rform bcs : rformula (dnf_to_form bcs) = all dnf_rterm bcs.