Add Morphism Qred : Qred_comp.(** 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).

Lemma Qred_extr_Qred : forall q, Qred_extr q = Qred q.