Section ClosedFieldQE.
Variables (F : fieldType) (F_closed : GRing.ClosedField.axiom F).
Notation fF := (@GRing.formula F).
Notation tF := (@GRing.term F).
Notation qf f := (GRing.qf_form f && GRing.rformula f).
Definition polyF := seq tF.
Definition isnull (p : polyF) : cps bool :=
'let n <- sizeT p; ret (n == 0%N).
Definition lt_sizeT (p q : polyF) : cps bool :=
'let n <- sizeT p; 'let m <- sizeT q; ret (n < m).
Definition lift (p : {poly F}) := map GRing.Const p.
Fixpoint lead_coefT p : cps tF :=
if p is c :: q then
'let l <- lead_coefT q; 'if (l == 0) then c else l
else ret 0%T.
Fixpoint amulXnT (a : tF) (n : nat) : polyF :=
if n is n'.+1 then 0%T :: (amulXnT a n') else [:: a].
Fixpoint mulpT (p q : polyF) :=
if p isn't a :: p then [::]
else sumpT [seq (a * x)%T | x <- q] (0%T :: mulpT p q).
Definition opppT : polyF -> polyF := map (GRing.Mul (- 1%T)%T).
Definition natmulpT n : polyF -> polyF := map (GRing.Mul n%:R%T).
Fixpoint redivp_rec_loopT (q : polyF) sq cq (c : nat) (qq r : polyF)
(n : nat) {struct n} : cps (nat * polyF * polyF) :=
'let sr <- sizeT r;
if sr < sq then ret (c, qq, r) else
'let lr <- lead_coefT r;
let m := amulXnT lr (sr - sq) in
let qq1 := sumpT (mulpT qq [::cq]) m in
let r1 := sumpT (mulpT r ([::cq])) (opppT (mulpT m q)) in
if n is n1.+1 then redivp_rec_loopT q sq cq c.+1 qq1 r1 n1
else ret (c.+1, qq1, r1).
Fixpoint redivp_rec_loop (q : {poly F}) sq cq
(k : nat) (qq r : {poly F}) (n : nat) {struct n} :=
if size r < sq then (k, qq, r) else
let m := (lead_coef r) *: 'X^(size r - sq) in
let qq1 := qq * cq%:P + m in
let r1 := r * cq%:P - m * q in
if n is n1.+1 then redivp_rec_loop q sq cq k.+1 qq1 r1 n1 else
(k.+1, qq1, r1).
Definition redivpT (p : polyF) (q : polyF) : cps (nat * polyF * polyF) :=
'let b <- isnull q;
if b then ret (0%N, [::0%T], p) else
'let sq <- sizeT q; 'let sp <- sizeT p;
'let lq <- lead_coefT q;
redivp_rec_loopT q sq lq 0 [::0%T] p sp.
Definition rmodpT (p : polyF) (q : polyF) : cps polyF :=
'let d <- redivpT p q; ret d.2.
Definition rdivpT (p : polyF) (q : polyF) : cps polyF :=
'let d <- redivpT p q; ret d.1.2.
Definition rscalpT (p : polyF) (q : polyF) : cps nat :=
'let d <- redivpT p q; ret d.1.1.
Definition rdvdpT (p : polyF) (q : polyF) : cps bool :=
'let d <- rmodpT p q; isnull d.
Fixpoint rgcdp_loop n (pp qq : {poly F}) {struct n} :=
let rr := rmodp pp qq in if rr == 0 then qq
else if n is n1.+1 then rgcdp_loop n1 qq rr else rr.
Fixpoint rgcdp_loopT n (pp : polyF) (qq : polyF) : cps polyF :=
'let rr <- rmodpT pp qq; 'let nrr <- isnull rr; if nrr then ret qq
else if n is n1.+1 then rgcdp_loopT n1 qq rr else ret rr.
Definition rgcdpT (p : polyF) (q : polyF) : cps polyF :=
let aux p1 q1 : cps polyF :=
'let b <- isnull p1; if b then ret q1
else 'let n <- sizeT p1; rgcdp_loopT n p1 q1 in
'let b <- lt_sizeT p q; if b then aux q p else aux p q.
Fixpoint rgcdpTs (ps : seq polyF) : cps polyF :=
if ps is p :: pr then 'let pr <- rgcdpTs pr; rgcdpT p pr else ret [::0%T].
Fixpoint rgdcop_recT n (q : polyF) (p : polyF) :=
if n is m.+1 then
'let g <- rgcdpT p q; 'let sg <- sizeT g;
if sg == 1%N then ret p
else 'let r <- rdivpT p g;
rgdcop_recT m q r
else 'let b <- isnull q; ret [::b%:R%T].
Definition rgdcopT q p := 'let sp <- sizeT p; rgdcop_recT sp q p.
Definition ex_elim_seq (ps : seq polyF) (q : polyF) : fF :=
('let g <- rgcdpTs ps; 'let d <- rgdcopT q g;
'let n <- sizeT d; ret (n != 1%N)) GRing.Bool.
Fixpoint abstrX (i : nat) (t : tF) :=
match t with
| 'X_n => if n == i then [::0; 1] else [::t]
| - x => opppT (abstrX i x)
| x + y => sumpT (abstrX i x) (abstrX i y)
| x * y => mulpT (abstrX i x) (abstrX i y)
| x *+ n => natmulpT n (abstrX i x)
| x ^+ n => let ax := (abstrX i x) in iter n (mulpT ax) [::1]
| _ => [::t]
end%T.
Implicit Types tx ty : tF.
Definition ex_elim (x : nat) (pqs : seq tF * seq tF) :=
ex_elim_seq (map (abstrX x) pqs.1)
(abstrX x (\big[GRing.Mul/1%T]_(q <- pqs.2) q)).
case: pqs => ps qs; case/andP=> /= rps rqs.
apply: ex_elim_seq_qf; first exact: rseq_poly_map.
apply: rabstrX=> /=.
elim: qs rqs=> [|t ts iht] //=; first by rewrite big_nil.
by case/andP=> rt rts; rewrite big_cons /= rt /= iht.
Qed.

Lemma wf_ex_elim : GRing.wf_QE_proj ex_elim.