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
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
|
{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE NoImplicitPrelude, MagicHash, StandaloneDeriving #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
-- XXX -fno-warn-unused-imports needed for the GHC.Tuple import below. Sigh.
{-# OPTIONS_HADDOCK hide #-}
-----------------------------------------------------------------------------
-- |
-- Module : GHC.Classes
-- Copyright : (c) The University of Glasgow, 1992-2002
-- License : see libraries/base/LICENSE
--
-- Maintainer : cvs-ghc@haskell.org
-- Stability : internal
-- Portability : non-portable (GHC extensions)
--
-- Basic classes.
--
-----------------------------------------------------------------------------
-- #hide
module GHC.Classes where
-- GHC.Magic is used in some derived instances
import GHC.Magic ()
import GHC.Prim
import GHC.Tuple
import GHC.Types
-- For defining instances for the generic deriving mechanism
import GHC.Generics (Arity(..), Associativity(..), Fixity(..))
infix 4 ==, /=, <, <=, >=, >
infixr 3 &&
infixr 2 ||
default () -- Double isn't available yet
-- | The 'Eq' class defines equality ('==') and inequality ('/=').
-- All the basic datatypes exported by the "Prelude" are instances of 'Eq',
-- and 'Eq' may be derived for any datatype whose constituents are also
-- instances of 'Eq'.
--
-- Minimal complete definition: either '==' or '/='.
--
class Eq a where
(==), (/=) :: a -> a -> Bool
{-# INLINE (/=) #-}
{-# INLINE (==) #-}
x /= y = not (x == y)
x == y = not (x /= y)
deriving instance Eq ()
deriving instance (Eq a, Eq b) => Eq (a, b)
deriving instance (Eq a, Eq b, Eq c) => Eq (a, b, c)
deriving instance (Eq a, Eq b, Eq c, Eq d) => Eq (a, b, c, d)
deriving instance (Eq a, Eq b, Eq c, Eq d, Eq e) => Eq (a, b, c, d, e)
deriving instance (Eq a, Eq b, Eq c, Eq d, Eq e, Eq f)
=> Eq (a, b, c, d, e, f)
deriving instance (Eq a, Eq b, Eq c, Eq d, Eq e, Eq f, Eq g)
=> Eq (a, b, c, d, e, f, g)
deriving instance (Eq a, Eq b, Eq c, Eq d, Eq e, Eq f, Eq g,
Eq h)
=> Eq (a, b, c, d, e, f, g, h)
deriving instance (Eq a, Eq b, Eq c, Eq d, Eq e, Eq f, Eq g,
Eq h, Eq i)
=> Eq (a, b, c, d, e, f, g, h, i)
deriving instance (Eq a, Eq b, Eq c, Eq d, Eq e, Eq f, Eq g,
Eq h, Eq i, Eq j)
=> Eq (a, b, c, d, e, f, g, h, i, j)
deriving instance (Eq a, Eq b, Eq c, Eq d, Eq e, Eq f, Eq g,
Eq h, Eq i, Eq j, Eq k)
=> Eq (a, b, c, d, e, f, g, h, i, j, k)
deriving instance (Eq a, Eq b, Eq c, Eq d, Eq e, Eq f, Eq g,
Eq h, Eq i, Eq j, Eq k, Eq l)
=> Eq (a, b, c, d, e, f, g, h, i, j, k, l)
deriving instance (Eq a, Eq b, Eq c, Eq d, Eq e, Eq f, Eq g,
Eq h, Eq i, Eq j, Eq k, Eq l, Eq m)
=> Eq (a, b, c, d, e, f, g, h, i, j, k, l, m)
deriving instance (Eq a, Eq b, Eq c, Eq d, Eq e, Eq f, Eq g,
Eq h, Eq i, Eq j, Eq k, Eq l, Eq m, Eq n)
=> Eq (a, b, c, d, e, f, g, h, i, j, k, l, m, n)
deriving instance (Eq a, Eq b, Eq c, Eq d, Eq e, Eq f, Eq g,
Eq h, Eq i, Eq j, Eq k, Eq l, Eq m, Eq n, Eq o)
=> Eq (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o)
instance (Eq a) => Eq [a] where
{-# SPECIALISE instance Eq [Char] #-}
[] == [] = True
(x:xs) == (y:ys) = x == y && xs == ys
_xs == _ys = False
deriving instance Eq Bool
deriving instance Eq Ordering
instance Eq Char where
(C# c1) == (C# c2) = c1 `eqChar#` c2
(C# c1) /= (C# c2) = c1 `neChar#` c2
instance Eq Float where
(F# x) == (F# y) = x `eqFloat#` y
instance Eq Double where
(D# x) == (D# y) = x ==## y
instance Eq Int where
(==) = eqInt
(/=) = neInt
{-# INLINE eqInt #-}
{-# INLINE neInt #-}
eqInt, neInt :: Int -> Int -> Bool
(I# x) `eqInt` (I# y) = x ==# y
(I# x) `neInt` (I# y) = x /=# y
-- | The 'Ord' class is used for totally ordered datatypes.
--
-- Instances of 'Ord' can be derived for any user-defined
-- datatype whose constituent types are in 'Ord'. The declared order
-- of the constructors in the data declaration determines the ordering
-- in derived 'Ord' instances. The 'Ordering' datatype allows a single
-- comparison to determine the precise ordering of two objects.
--
-- Minimal complete definition: either 'compare' or '<='.
-- Using 'compare' can be more efficient for complex types.
--
class (Eq a) => Ord a where
compare :: a -> a -> Ordering
(<), (<=), (>), (>=) :: a -> a -> Bool
max, min :: a -> a -> a
compare x y = if x == y then EQ
-- NB: must be '<=' not '<' to validate the
-- above claim about the minimal things that
-- can be defined for an instance of Ord:
else if x <= y then LT
else GT
x < y = case compare x y of { LT -> True; _ -> False }
x <= y = case compare x y of { GT -> False; _ -> True }
x > y = case compare x y of { GT -> True; _ -> False }
x >= y = case compare x y of { LT -> False; _ -> True }
-- These two default methods use '<=' rather than 'compare'
-- because the latter is often more expensive
max x y = if x <= y then y else x
min x y = if x <= y then x else y
deriving instance Ord ()
deriving instance (Ord a, Ord b) => Ord (a, b)
deriving instance (Ord a, Ord b, Ord c) => Ord (a, b, c)
deriving instance (Ord a, Ord b, Ord c, Ord d) => Ord (a, b, c, d)
deriving instance (Ord a, Ord b, Ord c, Ord d, Ord e) => Ord (a, b, c, d, e)
deriving instance (Ord a, Ord b, Ord c, Ord d, Ord e, Ord f)
=> Ord (a, b, c, d, e, f)
deriving instance (Ord a, Ord b, Ord c, Ord d, Ord e, Ord f, Ord g)
=> Ord (a, b, c, d, e, f, g)
deriving instance (Ord a, Ord b, Ord c, Ord d, Ord e, Ord f, Ord g,
Ord h)
=> Ord (a, b, c, d, e, f, g, h)
deriving instance (Ord a, Ord b, Ord c, Ord d, Ord e, Ord f, Ord g,
Ord h, Ord i)
=> Ord (a, b, c, d, e, f, g, h, i)
deriving instance (Ord a, Ord b, Ord c, Ord d, Ord e, Ord f, Ord g,
Ord h, Ord i, Ord j)
=> Ord (a, b, c, d, e, f, g, h, i, j)
deriving instance (Ord a, Ord b, Ord c, Ord d, Ord e, Ord f, Ord g,
Ord h, Ord i, Ord j, Ord k)
=> Ord (a, b, c, d, e, f, g, h, i, j, k)
deriving instance (Ord a, Ord b, Ord c, Ord d, Ord e, Ord f, Ord g,
Ord h, Ord i, Ord j, Ord k, Ord l)
=> Ord (a, b, c, d, e, f, g, h, i, j, k, l)
deriving instance (Ord a, Ord b, Ord c, Ord d, Ord e, Ord f, Ord g,
Ord h, Ord i, Ord j, Ord k, Ord l, Ord m)
=> Ord (a, b, c, d, e, f, g, h, i, j, k, l, m)
deriving instance (Ord a, Ord b, Ord c, Ord d, Ord e, Ord f, Ord g,
Ord h, Ord i, Ord j, Ord k, Ord l, Ord m, Ord n)
=> Ord (a, b, c, d, e, f, g, h, i, j, k, l, m, n)
deriving instance (Ord a, Ord b, Ord c, Ord d, Ord e, Ord f, Ord g,
Ord h, Ord i, Ord j, Ord k, Ord l, Ord m, Ord n, Ord o)
=> Ord (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o)
instance (Ord a) => Ord [a] where
{-# SPECIALISE instance Ord [Char] #-}
compare [] [] = EQ
compare [] (_:_) = LT
compare (_:_) [] = GT
compare (x:xs) (y:ys) = case compare x y of
EQ -> compare xs ys
other -> other
deriving instance Ord Bool
deriving instance Ord Ordering
-- We don't use deriving for Ord Char, because for Ord the derived
-- instance defines only compare, which takes two primops. Then
-- '>' uses compare, and therefore takes two primops instead of one.
instance Ord Char where
(C# c1) > (C# c2) = c1 `gtChar#` c2
(C# c1) >= (C# c2) = c1 `geChar#` c2
(C# c1) <= (C# c2) = c1 `leChar#` c2
(C# c1) < (C# c2) = c1 `ltChar#` c2
instance Ord Float where
(F# x) `compare` (F# y)
= if x `ltFloat#` y then LT
else if x `eqFloat#` y then EQ
else GT
(F# x) < (F# y) = x `ltFloat#` y
(F# x) <= (F# y) = x `leFloat#` y
(F# x) >= (F# y) = x `geFloat#` y
(F# x) > (F# y) = x `gtFloat#` y
instance Ord Double where
(D# x) `compare` (D# y)
= if x <## y then LT
else if x ==## y then EQ
else GT
(D# x) < (D# y) = x <## y
(D# x) <= (D# y) = x <=## y
(D# x) >= (D# y) = x >=## y
(D# x) > (D# y) = x >## y
instance Ord Int where
compare = compareInt
(<) = ltInt
(<=) = leInt
(>=) = geInt
(>) = gtInt
{-# INLINE gtInt #-}
{-# INLINE geInt #-}
{-# INLINE ltInt #-}
{-# INLINE leInt #-}
gtInt, geInt, ltInt, leInt :: Int -> Int -> Bool
(I# x) `gtInt` (I# y) = x ># y
(I# x) `geInt` (I# y) = x >=# y
(I# x) `ltInt` (I# y) = x <# y
(I# x) `leInt` (I# y) = x <=# y
compareInt :: Int -> Int -> Ordering
(I# x#) `compareInt` (I# y#) = compareInt# x# y#
compareInt# :: Int# -> Int# -> Ordering
compareInt# x# y#
| x# <# y# = LT
| x# ==# y# = EQ
| True = GT
-- OK, so they're technically not part of a class...:
-- Boolean functions
-- | Boolean \"and\"
(&&) :: Bool -> Bool -> Bool
True && x = x
False && _ = False
-- | Boolean \"or\"
(||) :: Bool -> Bool -> Bool
True || _ = True
False || x = x
-- | Boolean \"not\"
not :: Bool -> Bool
not True = False
not False = True
------------------------------------------------------------------------
-- Generic deriving
------------------------------------------------------------------------
-- We need instances for some basic datatypes, but some of those use Int,
-- so we have to put the instances here
deriving instance Eq Arity
deriving instance Eq Associativity
deriving instance Eq Fixity
deriving instance Ord Arity
deriving instance Ord Associativity
deriving instance Ord Fixity
|
