(** Another version, dedicated to extraction *)
Definition Qred_extr (q : Q) :=
let (q1, q2) := Qfactor_twos q in
let (p,_) := Zggcd_spec_pos (Zpos q2) (Zle_0_pos q2) q1 in
let (r2,r1) := snd p in r1#(Z2P r2).

(* Specifications: *)
Lemma Qred_extr_Qred : forall q, Qred_extr q = Qred q.
Add Morphism Qred_extr : Qred_extr_comp.