Section comparisons.
(* Fist a function Qcompare is defined, who takes two diadic numbers	*)
(* and answers SUPERIEUR, EGAL or INFERIEUR.				*)
(* Qcompare is similary to Zcompare from the omega library		*)
(* Then the usual predicates "less or equal", "less than", "greater	*)
(* or equal" and "greater than" are defined. Since these predicates	*)
(* are deterministic, the boolean equivalents are also defined	*)
(* Be careful ! Two diadic numbers x, y are equal iff the predicate	*)
(* (Deq x y) is true, that is (Dcompare x y)=EGAL			*)
(* That's not equivalent to : (eq D x y)				*)
Definition Dcompare (x y : diadic) : Datatypes.comparison :=
let nx := Dnum x in
let ny := Dnum y in
let ex := Dexp x in
let ey := Dexp y in
(two_p (ex - Z.min ex ey) * nx ?= two_p (ey - Z.min ex ey) * ny)%Z.
(* Inductive relation := EGAL | INFERIEUR | SUPERIEUR *)
Definition Deq (x y : diadic) :=
match Dcompare x y with
| Datatypes.Eq => True
| Datatypes.Lt => False
| Datatypes.Gt => False
end.
Definition Dneq (x y : diadic) :=
match Dcompare x y with
| Datatypes.Eq => False
| Datatypes.Lt => True
| Datatypes.Gt => True
end.
Definition Dle (x y : diadic) :=
match Dcompare x y with
| Datatypes.Eq => True
| Datatypes.Lt => True
| Datatypes.Gt => False
end.
Definition Dlt (x y : diadic) :=
match Dcompare x y with
| Datatypes.Eq => False
| Datatypes.Lt => True
| Datatypes.Gt => False
end.
Definition Dge (x y : diadic) :=
match Dcompare x y with
| Datatypes.Eq => True
| Datatypes.Lt => False
| Datatypes.Gt => True
end.
Definition Dgt (x y : diadic) :=
match Dcompare x y with
| Datatypes.Eq => False
| Datatypes.Lt => False
| Datatypes.Gt => True
end.
Definition Deq_bool (x y : diadic) :=
match Dcompare x y with
| Datatypes.Eq => true
| Datatypes.Lt => false
| Datatypes.Gt => false
end.
Definition Dneq_bool (x y : diadic) :=
match Dcompare x y with
| Datatypes.Eq => false
| Datatypes.Lt => true
| Datatypes.Gt => true
end.
Definition Dle_bool (x y : diadic) :=
match Dcompare x y with
| Datatypes.Eq => true
| Datatypes.Lt => true
| Datatypes.Gt => false
end.
Definition Dlt_bool (x y : diadic) :=
match Dcompare x y with
| Datatypes.Eq => false
| Datatypes.Lt => true
| Datatypes.Gt => false
end.
Definition Dge_bool (x y : diadic) :=
match Dcompare x y with
| Datatypes.Eq => true
| Datatypes.Lt => false
| Datatypes.Gt => true
end.
Definition Dgt_bool (x y : diadic) :=
match Dcompare x y with
| Datatypes.Eq => false
| Datatypes.Lt => false
| Datatypes.Gt => true
end.
unfold Dcompare in |- *; simpl in |- *; intros;
rewrite (Zmin.Zmin_plus (Dexp x) (Dexp y) n).
do 2 rewrite BinInt.Zminus_plus_simpl_r.
reflexivity.
Qed.
intros; rewrite H; unfold Deq in |- *; unfold Dcompare in |- *;
apply Zcompare.Zcompare_eq_case; trivial.
Qed.
(* Links between Zcompare and Dcompare, Zle and Dle *)
intros (nx, ex) n.
unfold Dcompare in |- *; simpl in |- *.
symmetry  in |- *.
replace (two_p (n - Z.min ex n) * 0)%Z with (two_p (ex - Z.min ex n) * 0)%Z.
apply Zmult_compare_compat_l.
apply two_p_gt_ZERO.
generalize (Z.le_min_l ex n); generalize (Z.min ex n); intro; omega.
do 2 rewrite Zmult_0_r; reflexivity.
Qed.
unfold Deq in |- *; intros; rewrite (Dcompare_shift x y n); trivial.
Qed.
intros (nx, ex) n Hn; unfold Deq in |- *; unfold Dcompare in |- *;
simpl in |- *.
cut
((two_p (ex - Z.min ex (ex - n)) * nx)%Z =
(two_p (ex - n - Z.min ex (ex - n)) * (nx * two_p n))%Z).
intro H; rewrite H.
generalize (two_p (ex - n - Z.min ex (ex - n)) * (nx * two_p n))%Z.
intros. generalize (Z.compare_refl z).
elim (z ?= z)%Z; discriminate || trivial.
rewrite (Zmult_comm nx (two_p n)).
rewrite <- Zmult_assoc_reverse.
rewrite <- two_p_is_exp.
ring_simplify (ex - n - Z.min ex (ex - n) + n)%Z (ex - Z.min ex (ex - n))%Z.
reflexivity.
generalize (Z.le_min_l ex (ex - n)) (Z.le_min_r ex (ex - n)).
omega.
assumption.
Qed.
intros; unfold Dle in |- *; unfold Dcompare in |- *; simpl in |- *.
rewrite (Zmin_n_n d).
rewrite <- (Zminus_diag_reverse d).
unfold two_p in |- *.
rewrite (Zcompare_mult_compat 1 n1 n2).
apply Zcompare.Zle_compare; assumption.
Qed.

Lemma Dlt_Zlt :
forall n1 n2 d : Z, (n1 < n2)%Z -> Dlt (Diadic n1 d) (Diadic n2 d).