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).

(* Specifications: *)
Lemma redivp_rec_loopTP (k : nat * polyF * polyF -> fF) :
(forall c qq r e,  qf_eval e (k (c,qq,r))
= qf_eval e (k (c, lift (eval_poly e qq), lift (eval_poly e r))))
-> forall q sq cq c qq r n e
(d := redivp_rec_loop (eval_poly e q) sq (eval e cq)
c (eval_poly e qq) (eval_poly e r) n),
qf_eval e (redivp_rec_loopT q sq cq c qq r n k)
= qf_eval e (k (d.1.1, lift d.1.2, lift d.2)).
Lemma redivp_rec_loopT_qf (q : polyF) (sq : nat) (cq : tF)
(c : nat) (qq r : polyF) (n : nat) :
rpoly q -> rterm cq -> rpoly qq -> rpoly r ->
qf_cps (fun x => [&& rpoly x.1.2 & rpoly x.2])
(redivp_rec_loopT q sq cq c qq r n).