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.

Lemma rgdcopTP (k : polyF -> fF) :
(forall p e, qf_eval e (k p) = qf_eval e (k (lift (eval_poly e p)))) ->
forall p q e, qf_eval e (rgdcopT p q k) =
qf_eval e (k (lift (rgdcop (eval_poly e p) (eval_poly e q)))).