Ltac QpowerSimpl :=
(repeat rewrite inj_S;
 unfold Zsucc;
 repeat rewrite Qpower_plus; try discriminate;
 simpl).Ltac get_hd := match goal with |- ?H -> _ => H end.Ltac get_gl := match goal with |- ?H => H end.Ltac lhs H := 
 match H with 
  | ?a <= _ => a
  | ?a < _ => a 
  | ?a == _ => a
 end.Ltac rhs H := 
 match H with 
  | _ <= ?a => a
  | _ < ?a => a 
  | _ == ?a => a
 end.Ltac step_left t :=  let H := get_gl in let a := lhs H in setoid_replace a with t by (QpowerSimpl;ring).Ltac step_right t :=  let H := get_gl in let a := rhs H in setoid_replace a with t by (QpowerSimpl;ring).Ltac step_left_hd t :=  let H := get_hd in let a := lhs H in setoid_replace a with t by (QpowerSimpl;ring).Ltac step_right_hd t := let H := get_hd in let a := rhs H in setoid_replace a with t by (QpowerSimpl;ring).Ltac step t := let a := lhs t in step_left a; let b := rhs t in step_right b.Ltac step_hd t := let a := lhs t in step_left_hd a; let b := rhs t in step_right_hd b.Local Notation " ' x " := (Zpos x) (at level 20, no associativity) : Z_scope.(**** A quick & dirty implementation of constructive reals. ****)
(****      Based on Pr. Schwichtenberg lecture notes.        ****)
(****      Main objective: sqrt(2) as root of X^2 -2  in [1;2]   ****) 

(* First, the Cauchy property. *)

Definition Is_Cauchy (f : nat -> Q) (mo : nat -> nat) :=
  forall k m n,  (mo k <= m)%nat -> (mo k <= n)%nat ->
  -(1#2)^k <= f m - f n <= (1#2)^k.(* A real is given by a cauchy sequence, a modulus sequence *)
(* and a proof of the Cauchy property of these sequences. *)

Record R : Set := {
  cauchy : nat -> Q; 
  modulus : nat -> nat; 
  is_cauchy : Is_Cauchy cauchy modulus }.(* A real is given by a cauchy sequence, a modulus sequence *)
(* and a proof of the Cauchy property of these sequences. *)

Record R : Set := {
  cauchy : nat -> Q; 
  modulus : nat -> nat; 
  is_cauchy : Is_Cauchy cauchy modulus }.(* A real is given by a cauchy sequence, a modulus sequence *)
(* and a proof of the Cauchy property of these sequences. *)

Record R : Set := {
  cauchy : nat -> Q; 
  modulus : nat -> nat; 
  is_cauchy : Is_Cauchy cauchy modulus }.(* A real is given by a cauchy sequence, a modulus sequence *)
(* and a proof of the Cauchy property of these sequences. *)

Record R : Set := {
  cauchy : nat -> Q; 
  modulus : nat -> nat; 
  is_cauchy : Is_Cauchy cauchy modulus }.(* Recursive Extraction R. *)

(* A rational is injected into R via a constant cauchy sequence. *)

Definition inject_Q : Q -> R.(* Extraction inject_Q. *)

(* The non-computational equality upon R. *)

Definition Req : R -> R -> Prop:= 
    fun x y : R => 
      forall k, let M := modulus x (S k) in 
            let N := modulus y (S k) in 
            -(1#2)^k <= cauchy x M - cauchy y N <= (1#2)^k.(* The informative positivity upon R. *)

Definition Rpos_k : nat -> R -> Prop :=
  fun k x => (1#2)^k <= cauchy x (modulus x (S k)).Definition Rpos : R -> Set := fun x => { k:nat | Rpos_k k x }.(* The logical non-negativity upon R. *)

Definition Rnonneg : R -> Prop := 
 fun x => forall k:nat, -(1#2)^k <= cauchy x (modulus x k).(* The Dirty Part: *)

(**** Beware! Use with caution! Not for kids! ****)
Axiom Falsum: False.Ltac fedup := elim Falsum.(*****************************************************)

Definition test : R -> R -> R.

(* Specifications: *)
Lemma max_le : forall a b c, le (max a b) c -> le a c /\ le b c.
Lemma Qeq_Qle : forall a b:Q, a==b -> a<=b.