summaryrefslogtreecommitdiff
path: root/theories/QArith/QOrderedType.v
blob: fa0b920919abf9960d0b08a09c02ce034a9ef40a (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
(************************************************************************)
(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015     *)
(*   \VV/  **************************************************************)
(*    //   *      This file is distributed under the terms of the       *)
(*         *       GNU Lesser General Public License Version 2.1        *)
(************************************************************************)

Require Import QArith_base Equalities Orders OrdersTac.

Local Open Scope Q_scope.

(** * DecidableType structure for rational numbers *)

Module Q_as_DT <: DecidableTypeFull.
 Definition t := Q.
 Definition eq := Qeq.
 Definition eq_equiv := Q_Setoid.
 Definition eqb := Qeq_bool.
 Definition eqb_eq := Qeq_bool_iff.

 Include BackportEq. (** eq_refl, eq_sym, eq_trans *)
 Include HasEqBool2Dec. (** eq_dec *)

End Q_as_DT.

(** Note that the last module fulfills by subtyping many other
    interfaces, such as [DecidableType] or [EqualityType]. *)



(** * OrderedType structure for rational numbers *)

Module Q_as_OT <: OrderedTypeFull.
 Include Q_as_DT.
 Definition lt := Qlt.
 Definition le := Qle.
 Definition compare := Qcompare.

 Instance lt_strorder : StrictOrder Qlt.
 Proof. split; [ exact Qlt_irrefl | exact Qlt_trans ]. Qed.

 Instance lt_compat : Proper (Qeq==>Qeq==>iff) Qlt.
 Proof. auto with *. Qed.

 Definition le_lteq := Qle_lteq.
 Definition compare_spec := Qcompare_spec.

End Q_as_OT.


(** * An [order] tactic for [Q] numbers *)

Module QOrder := OTF_to_OrderTac Q_as_OT.
Ltac q_order := QOrder.order.

(** Note that [q_order] is domain-agnostic: it will not prove
    [1<=2] or [x<=x+x], but rather things like [x<=y -> y<=x -> x==y]. *)