Build system: renable -Wall on validate (base)
[ghc.git] / libraries / base / GHC / Enum.hs
1 {-# LANGUAGE Trustworthy #-}
2 {-# LANGUAGE CPP, NoImplicitPrelude, BangPatterns, MagicHash #-}
3 {-# OPTIONS_HADDOCK hide #-}
4
5 -----------------------------------------------------------------------------
6 -- |
7 -- Module : GHC.Enum
8 -- Copyright : (c) The University of Glasgow, 1992-2002
9 -- License : see libraries/base/LICENSE
10 --
11 -- Maintainer : cvs-ghc@haskell.org
12 -- Stability : internal
13 -- Portability : non-portable (GHC extensions)
14 --
15 -- The 'Enum' and 'Bounded' classes.
16 --
17 -----------------------------------------------------------------------------
18
19 #include "MachDeps.h"
20
21 module GHC.Enum(
22 Bounded(..), Enum(..),
23 boundedEnumFrom, boundedEnumFromThen,
24 toEnumError, fromEnumError, succError, predError,
25
26 -- Instances for Bounded and Enum: (), Char, Int
27
28 ) where
29
30 import GHC.Base hiding ( many )
31 import GHC.Char
32 import GHC.Integer
33 import GHC.Num
34 import GHC.Show
35 default () -- Double isn't available yet
36
37 -- | The 'Bounded' class is used to name the upper and lower limits of a
38 -- type. 'Ord' is not a superclass of 'Bounded' since types that are not
39 -- totally ordered may also have upper and lower bounds.
40 --
41 -- The 'Bounded' class may be derived for any enumeration type;
42 -- 'minBound' is the first constructor listed in the @data@ declaration
43 -- and 'maxBound' is the last.
44 -- 'Bounded' may also be derived for single-constructor datatypes whose
45 -- constituent types are in 'Bounded'.
46
47 class Bounded a where
48 minBound, maxBound :: a
49
50 -- | Class 'Enum' defines operations on sequentially ordered types.
51 --
52 -- The @enumFrom@... methods are used in Haskell's translation of
53 -- arithmetic sequences.
54 --
55 -- Instances of 'Enum' may be derived for any enumeration type (types
56 -- whose constructors have no fields). The nullary constructors are
57 -- assumed to be numbered left-to-right by 'fromEnum' from @0@ through @n-1@.
58 -- See Chapter 10 of the /Haskell Report/ for more details.
59 --
60 -- For any type that is an instance of class 'Bounded' as well as 'Enum',
61 -- the following should hold:
62 --
63 -- * The calls @'succ' 'maxBound'@ and @'pred' 'minBound'@ should result in
64 -- a runtime error.
65 --
66 -- * 'fromEnum' and 'toEnum' should give a runtime error if the
67 -- result value is not representable in the result type.
68 -- For example, @'toEnum' 7 :: 'Bool'@ is an error.
69 --
70 -- * 'enumFrom' and 'enumFromThen' should be defined with an implicit bound,
71 -- thus:
72 --
73 -- > enumFrom x = enumFromTo x maxBound
74 -- > enumFromThen x y = enumFromThenTo x y bound
75 -- > where
76 -- > bound | fromEnum y >= fromEnum x = maxBound
77 -- > | otherwise = minBound
78 --
79 class Enum a where
80 -- | the successor of a value. For numeric types, 'succ' adds 1.
81 succ :: a -> a
82 -- | the predecessor of a value. For numeric types, 'pred' subtracts 1.
83 pred :: a -> a
84 -- | Convert from an 'Int'.
85 toEnum :: Int -> a
86 -- | Convert to an 'Int'.
87 -- It is implementation-dependent what 'fromEnum' returns when
88 -- applied to a value that is too large to fit in an 'Int'.
89 fromEnum :: a -> Int
90
91 -- | Used in Haskell's translation of @[n..]@.
92 enumFrom :: a -> [a]
93 -- | Used in Haskell's translation of @[n,n'..]@.
94 enumFromThen :: a -> a -> [a]
95 -- | Used in Haskell's translation of @[n..m]@.
96 enumFromTo :: a -> a -> [a]
97 -- | Used in Haskell's translation of @[n,n'..m]@.
98 enumFromThenTo :: a -> a -> a -> [a]
99
100 succ = toEnum . (+ 1) . fromEnum
101 pred = toEnum . (subtract 1) . fromEnum
102 enumFrom x = map toEnum [fromEnum x ..]
103 enumFromThen x y = map toEnum [fromEnum x, fromEnum y ..]
104 enumFromTo x y = map toEnum [fromEnum x .. fromEnum y]
105 enumFromThenTo x1 x2 y = map toEnum [fromEnum x1, fromEnum x2 .. fromEnum y]
106
107 -- Default methods for bounded enumerations
108 boundedEnumFrom :: (Enum a, Bounded a) => a -> [a]
109 boundedEnumFrom n = map toEnum [fromEnum n .. fromEnum (maxBound `asTypeOf` n)]
110
111 boundedEnumFromThen :: (Enum a, Bounded a) => a -> a -> [a]
112 boundedEnumFromThen n1 n2
113 | i_n2 >= i_n1 = map toEnum [i_n1, i_n2 .. fromEnum (maxBound `asTypeOf` n1)]
114 | otherwise = map toEnum [i_n1, i_n2 .. fromEnum (minBound `asTypeOf` n1)]
115 where
116 i_n1 = fromEnum n1
117 i_n2 = fromEnum n2
118
119 ------------------------------------------------------------------------
120 -- Helper functions
121 ------------------------------------------------------------------------
122
123 {-# NOINLINE toEnumError #-}
124 toEnumError :: (Show a) => String -> Int -> (a,a) -> b
125 toEnumError inst_ty i bnds =
126 error $ "Enum.toEnum{" ++ inst_ty ++ "}: tag (" ++
127 show i ++
128 ") is outside of bounds " ++
129 show bnds
130
131 {-# NOINLINE fromEnumError #-}
132 fromEnumError :: (Show a) => String -> a -> b
133 fromEnumError inst_ty x =
134 error $ "Enum.fromEnum{" ++ inst_ty ++ "}: value (" ++
135 show x ++
136 ") is outside of Int's bounds " ++
137 show (minBound::Int, maxBound::Int)
138
139 {-# NOINLINE succError #-}
140 succError :: String -> a
141 succError inst_ty =
142 error $ "Enum.succ{" ++ inst_ty ++ "}: tried to take `succ' of maxBound"
143
144 {-# NOINLINE predError #-}
145 predError :: String -> a
146 predError inst_ty =
147 error $ "Enum.pred{" ++ inst_ty ++ "}: tried to take `pred' of minBound"
148
149 ------------------------------------------------------------------------
150 -- Tuples
151 ------------------------------------------------------------------------
152
153 instance Bounded () where
154 minBound = ()
155 maxBound = ()
156
157 instance Enum () where
158 succ _ = error "Prelude.Enum.().succ: bad argument"
159 pred _ = error "Prelude.Enum.().pred: bad argument"
160
161 toEnum x | x == 0 = ()
162 | otherwise = error "Prelude.Enum.().toEnum: bad argument"
163
164 fromEnum () = 0
165 enumFrom () = [()]
166 enumFromThen () () = let many = ():many in many
167 enumFromTo () () = [()]
168 enumFromThenTo () () () = let many = ():many in many
169
170 -- Report requires instances up to 15
171 instance (Bounded a, Bounded b) => Bounded (a,b) where
172 minBound = (minBound, minBound)
173 maxBound = (maxBound, maxBound)
174
175 instance (Bounded a, Bounded b, Bounded c) => Bounded (a,b,c) where
176 minBound = (minBound, minBound, minBound)
177 maxBound = (maxBound, maxBound, maxBound)
178
179 instance (Bounded a, Bounded b, Bounded c, Bounded d) => Bounded (a,b,c,d) where
180 minBound = (minBound, minBound, minBound, minBound)
181 maxBound = (maxBound, maxBound, maxBound, maxBound)
182
183 instance (Bounded a, Bounded b, Bounded c, Bounded d, Bounded e) => Bounded (a,b,c,d,e) where
184 minBound = (minBound, minBound, minBound, minBound, minBound)
185 maxBound = (maxBound, maxBound, maxBound, maxBound, maxBound)
186
187 instance (Bounded a, Bounded b, Bounded c, Bounded d, Bounded e, Bounded f)
188 => Bounded (a,b,c,d,e,f) where
189 minBound = (minBound, minBound, minBound, minBound, minBound, minBound)
190 maxBound = (maxBound, maxBound, maxBound, maxBound, maxBound, maxBound)
191
192 instance (Bounded a, Bounded b, Bounded c, Bounded d, Bounded e, Bounded f, Bounded g)
193 => Bounded (a,b,c,d,e,f,g) where
194 minBound = (minBound, minBound, minBound, minBound, minBound, minBound, minBound)
195 maxBound = (maxBound, maxBound, maxBound, maxBound, maxBound, maxBound, maxBound)
196
197 instance (Bounded a, Bounded b, Bounded c, Bounded d, Bounded e, Bounded f, Bounded g,
198 Bounded h)
199 => Bounded (a,b,c,d,e,f,g,h) where
200 minBound = (minBound, minBound, minBound, minBound, minBound, minBound, minBound, minBound)
201 maxBound = (maxBound, maxBound, maxBound, maxBound, maxBound, maxBound, maxBound, maxBound)
202
203 instance (Bounded a, Bounded b, Bounded c, Bounded d, Bounded e, Bounded f, Bounded g,
204 Bounded h, Bounded i)
205 => Bounded (a,b,c,d,e,f,g,h,i) where
206 minBound = (minBound, minBound, minBound, minBound, minBound, minBound, minBound, minBound,
207 minBound)
208 maxBound = (maxBound, maxBound, maxBound, maxBound, maxBound, maxBound, maxBound, maxBound,
209 maxBound)
210
211 instance (Bounded a, Bounded b, Bounded c, Bounded d, Bounded e, Bounded f, Bounded g,
212 Bounded h, Bounded i, Bounded j)
213 => Bounded (a,b,c,d,e,f,g,h,i,j) where
214 minBound = (minBound, minBound, minBound, minBound, minBound, minBound, minBound, minBound,
215 minBound, minBound)
216 maxBound = (maxBound, maxBound, maxBound, maxBound, maxBound, maxBound, maxBound, maxBound,
217 maxBound, maxBound)
218
219 instance (Bounded a, Bounded b, Bounded c, Bounded d, Bounded e, Bounded f, Bounded g,
220 Bounded h, Bounded i, Bounded j, Bounded k)
221 => Bounded (a,b,c,d,e,f,g,h,i,j,k) where
222 minBound = (minBound, minBound, minBound, minBound, minBound, minBound, minBound, minBound,
223 minBound, minBound, minBound)
224 maxBound = (maxBound, maxBound, maxBound, maxBound, maxBound, maxBound, maxBound, maxBound,
225 maxBound, maxBound, maxBound)
226
227 instance (Bounded a, Bounded b, Bounded c, Bounded d, Bounded e, Bounded f, Bounded g,
228 Bounded h, Bounded i, Bounded j, Bounded k, Bounded l)
229 => Bounded (a,b,c,d,e,f,g,h,i,j,k,l) where
230 minBound = (minBound, minBound, minBound, minBound, minBound, minBound, minBound, minBound,
231 minBound, minBound, minBound, minBound)
232 maxBound = (maxBound, maxBound, maxBound, maxBound, maxBound, maxBound, maxBound, maxBound,
233 maxBound, maxBound, maxBound, maxBound)
234
235 instance (Bounded a, Bounded b, Bounded c, Bounded d, Bounded e, Bounded f, Bounded g,
236 Bounded h, Bounded i, Bounded j, Bounded k, Bounded l, Bounded m)
237 => Bounded (a,b,c,d,e,f,g,h,i,j,k,l,m) where
238 minBound = (minBound, minBound, minBound, minBound, minBound, minBound, minBound, minBound,
239 minBound, minBound, minBound, minBound, minBound)
240 maxBound = (maxBound, maxBound, maxBound, maxBound, maxBound, maxBound, maxBound, maxBound,
241 maxBound, maxBound, maxBound, maxBound, maxBound)
242
243 instance (Bounded a, Bounded b, Bounded c, Bounded d, Bounded e, Bounded f, Bounded g,
244 Bounded h, Bounded i, Bounded j, Bounded k, Bounded l, Bounded m, Bounded n)
245 => Bounded (a,b,c,d,e,f,g,h,i,j,k,l,m,n) where
246 minBound = (minBound, minBound, minBound, minBound, minBound, minBound, minBound, minBound,
247 minBound, minBound, minBound, minBound, minBound, minBound)
248 maxBound = (maxBound, maxBound, maxBound, maxBound, maxBound, maxBound, maxBound, maxBound,
249 maxBound, maxBound, maxBound, maxBound, maxBound, maxBound)
250
251 instance (Bounded a, Bounded b, Bounded c, Bounded d, Bounded e, Bounded f, Bounded g,
252 Bounded h, Bounded i, Bounded j, Bounded k, Bounded l, Bounded m, Bounded n, Bounded o)
253 => Bounded (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o) where
254 minBound = (minBound, minBound, minBound, minBound, minBound, minBound, minBound, minBound,
255 minBound, minBound, minBound, minBound, minBound, minBound, minBound)
256 maxBound = (maxBound, maxBound, maxBound, maxBound, maxBound, maxBound, maxBound, maxBound,
257 maxBound, maxBound, maxBound, maxBound, maxBound, maxBound, maxBound)
258
259 ------------------------------------------------------------------------
260 -- Bool
261 ------------------------------------------------------------------------
262
263 instance Bounded Bool where
264 minBound = False
265 maxBound = True
266
267 instance Enum Bool where
268 succ False = True
269 succ True = error "Prelude.Enum.Bool.succ: bad argument"
270
271 pred True = False
272 pred False = error "Prelude.Enum.Bool.pred: bad argument"
273
274 toEnum n | n == 0 = False
275 | n == 1 = True
276 | otherwise = error "Prelude.Enum.Bool.toEnum: bad argument"
277
278 fromEnum False = 0
279 fromEnum True = 1
280
281 -- Use defaults for the rest
282 enumFrom = boundedEnumFrom
283 enumFromThen = boundedEnumFromThen
284
285 ------------------------------------------------------------------------
286 -- Ordering
287 ------------------------------------------------------------------------
288
289 instance Bounded Ordering where
290 minBound = LT
291 maxBound = GT
292
293 instance Enum Ordering where
294 succ LT = EQ
295 succ EQ = GT
296 succ GT = error "Prelude.Enum.Ordering.succ: bad argument"
297
298 pred GT = EQ
299 pred EQ = LT
300 pred LT = error "Prelude.Enum.Ordering.pred: bad argument"
301
302 toEnum n | n == 0 = LT
303 | n == 1 = EQ
304 | n == 2 = GT
305 toEnum _ = error "Prelude.Enum.Ordering.toEnum: bad argument"
306
307 fromEnum LT = 0
308 fromEnum EQ = 1
309 fromEnum GT = 2
310
311 -- Use defaults for the rest
312 enumFrom = boundedEnumFrom
313 enumFromThen = boundedEnumFromThen
314
315 ------------------------------------------------------------------------
316 -- Char
317 ------------------------------------------------------------------------
318
319 instance Bounded Char where
320 minBound = '\0'
321 maxBound = '\x10FFFF'
322
323 instance Enum Char where
324 succ (C# c#)
325 | isTrue# (ord# c# /=# 0x10FFFF#) = C# (chr# (ord# c# +# 1#))
326 | otherwise = error ("Prelude.Enum.Char.succ: bad argument")
327 pred (C# c#)
328 | isTrue# (ord# c# /=# 0#) = C# (chr# (ord# c# -# 1#))
329 | otherwise = error ("Prelude.Enum.Char.pred: bad argument")
330
331 toEnum = chr
332 fromEnum = ord
333
334 {-# INLINE enumFrom #-}
335 enumFrom (C# x) = eftChar (ord# x) 0x10FFFF#
336 -- Blarg: technically I guess enumFrom isn't strict!
337
338 {-# INLINE enumFromTo #-}
339 enumFromTo (C# x) (C# y) = eftChar (ord# x) (ord# y)
340
341 {-# INLINE enumFromThen #-}
342 enumFromThen (C# x1) (C# x2) = efdChar (ord# x1) (ord# x2)
343
344 {-# INLINE enumFromThenTo #-}
345 enumFromThenTo (C# x1) (C# x2) (C# y) = efdtChar (ord# x1) (ord# x2) (ord# y)
346
347 -- See Note [How the Enum rules work]
348 {-# RULES
349 "eftChar" [~1] forall x y. eftChar x y = build (\c n -> eftCharFB c n x y)
350 "efdChar" [~1] forall x1 x2. efdChar x1 x2 = build (\ c n -> efdCharFB c n x1 x2)
351 "efdtChar" [~1] forall x1 x2 l. efdtChar x1 x2 l = build (\ c n -> efdtCharFB c n x1 x2 l)
352 "eftCharList" [1] eftCharFB (:) [] = eftChar
353 "efdCharList" [1] efdCharFB (:) [] = efdChar
354 "efdtCharList" [1] efdtCharFB (:) [] = efdtChar
355 #-}
356
357
358 -- We can do better than for Ints because we don't
359 -- have hassles about arithmetic overflow at maxBound
360 {-# INLINE [0] eftCharFB #-}
361 eftCharFB :: (Char -> a -> a) -> a -> Int# -> Int# -> a
362 eftCharFB c n x0 y = go x0
363 where
364 go x | isTrue# (x ># y) = n
365 | otherwise = C# (chr# x) `c` go (x +# 1#)
366
367 {-# NOINLINE [1] eftChar #-}
368 eftChar :: Int# -> Int# -> String
369 eftChar x y | isTrue# (x ># y ) = []
370 | otherwise = C# (chr# x) : eftChar (x +# 1#) y
371
372
373 -- For enumFromThenTo we give up on inlining
374 {-# NOINLINE [0] efdCharFB #-}
375 efdCharFB :: (Char -> a -> a) -> a -> Int# -> Int# -> a
376 efdCharFB c n x1 x2
377 | isTrue# (delta >=# 0#) = go_up_char_fb c n x1 delta 0x10FFFF#
378 | otherwise = go_dn_char_fb c n x1 delta 0#
379 where
380 !delta = x2 -# x1
381
382 {-# NOINLINE [1] efdChar #-}
383 efdChar :: Int# -> Int# -> String
384 efdChar x1 x2
385 | isTrue# (delta >=# 0#) = go_up_char_list x1 delta 0x10FFFF#
386 | otherwise = go_dn_char_list x1 delta 0#
387 where
388 !delta = x2 -# x1
389
390 {-# NOINLINE [0] efdtCharFB #-}
391 efdtCharFB :: (Char -> a -> a) -> a -> Int# -> Int# -> Int# -> a
392 efdtCharFB c n x1 x2 lim
393 | isTrue# (delta >=# 0#) = go_up_char_fb c n x1 delta lim
394 | otherwise = go_dn_char_fb c n x1 delta lim
395 where
396 !delta = x2 -# x1
397
398 {-# NOINLINE [1] efdtChar #-}
399 efdtChar :: Int# -> Int# -> Int# -> String
400 efdtChar x1 x2 lim
401 | isTrue# (delta >=# 0#) = go_up_char_list x1 delta lim
402 | otherwise = go_dn_char_list x1 delta lim
403 where
404 !delta = x2 -# x1
405
406 go_up_char_fb :: (Char -> a -> a) -> a -> Int# -> Int# -> Int# -> a
407 go_up_char_fb c n x0 delta lim
408 = go_up x0
409 where
410 go_up x | isTrue# (x ># lim) = n
411 | otherwise = C# (chr# x) `c` go_up (x +# delta)
412
413 go_dn_char_fb :: (Char -> a -> a) -> a -> Int# -> Int# -> Int# -> a
414 go_dn_char_fb c n x0 delta lim
415 = go_dn x0
416 where
417 go_dn x | isTrue# (x <# lim) = n
418 | otherwise = C# (chr# x) `c` go_dn (x +# delta)
419
420 go_up_char_list :: Int# -> Int# -> Int# -> String
421 go_up_char_list x0 delta lim
422 = go_up x0
423 where
424 go_up x | isTrue# (x ># lim) = []
425 | otherwise = C# (chr# x) : go_up (x +# delta)
426
427 go_dn_char_list :: Int# -> Int# -> Int# -> String
428 go_dn_char_list x0 delta lim
429 = go_dn x0
430 where
431 go_dn x | isTrue# (x <# lim) = []
432 | otherwise = C# (chr# x) : go_dn (x +# delta)
433
434
435 ------------------------------------------------------------------------
436 -- Int
437 ------------------------------------------------------------------------
438
439 {-
440 Be careful about these instances.
441 (a) remember that you have to count down as well as up e.g. [13,12..0]
442 (b) be careful of Int overflow
443 (c) remember that Int is bounded, so [1..] terminates at maxInt
444 -}
445
446 instance Bounded Int where
447 minBound = minInt
448 maxBound = maxInt
449
450 instance Enum Int where
451 succ x
452 | x == maxBound = error "Prelude.Enum.succ{Int}: tried to take `succ' of maxBound"
453 | otherwise = x + 1
454 pred x
455 | x == minBound = error "Prelude.Enum.pred{Int}: tried to take `pred' of minBound"
456 | otherwise = x - 1
457
458 toEnum x = x
459 fromEnum x = x
460
461 {-# INLINE enumFrom #-}
462 enumFrom (I# x) = eftInt x maxInt#
463 where !(I# maxInt#) = maxInt
464 -- Blarg: technically I guess enumFrom isn't strict!
465
466 {-# INLINE enumFromTo #-}
467 enumFromTo (I# x) (I# y) = eftInt x y
468
469 {-# INLINE enumFromThen #-}
470 enumFromThen (I# x1) (I# x2) = efdInt x1 x2
471
472 {-# INLINE enumFromThenTo #-}
473 enumFromThenTo (I# x1) (I# x2) (I# y) = efdtInt x1 x2 y
474
475
476 -----------------------------------------------------
477 -- eftInt and eftIntFB deal with [a..b], which is the
478 -- most common form, so we take a lot of care
479 -- In particular, we have rules for deforestation
480
481 {-# RULES
482 "eftInt" [~1] forall x y. eftInt x y = build (\ c n -> eftIntFB c n x y)
483 "eftIntList" [1] eftIntFB (:) [] = eftInt
484 #-}
485
486 {- Note [How the Enum rules work]
487 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
488 * Phase 2: eftInt ---> build . eftIntFB
489 * Phase 1: inline build; eftIntFB (:) --> eftInt
490 * Phase 0: optionally inline eftInt
491 -}
492
493 {-# NOINLINE [1] eftInt #-}
494 eftInt :: Int# -> Int# -> [Int]
495 -- [x1..x2]
496 eftInt x0 y | isTrue# (x0 ># y) = []
497 | otherwise = go x0
498 where
499 go x = I# x : if isTrue# (x ==# y)
500 then []
501 else go (x +# 1#)
502
503 {-# INLINE [0] eftIntFB #-}
504 eftIntFB :: (Int -> r -> r) -> r -> Int# -> Int# -> r
505 eftIntFB c n x0 y | isTrue# (x0 ># y) = n
506 | otherwise = go x0
507 where
508 go x = I# x `c` if isTrue# (x ==# y)
509 then n
510 else go (x +# 1#)
511 -- Watch out for y=maxBound; hence ==, not >
512 -- Be very careful not to have more than one "c"
513 -- so that when eftInfFB is inlined we can inline
514 -- whatever is bound to "c"
515
516
517 -----------------------------------------------------
518 -- efdInt and efdtInt deal with [a,b..] and [a,b..c].
519 -- The code is more complicated because of worries about Int overflow.
520
521 -- See Note [How the Enum rules work]
522 {-# RULES
523 "efdtInt" [~1] forall x1 x2 y.
524 efdtInt x1 x2 y = build (\ c n -> efdtIntFB c n x1 x2 y)
525 "efdtIntUpList" [1] efdtIntFB (:) [] = efdtInt
526 #-}
527
528 efdInt :: Int# -> Int# -> [Int]
529 -- [x1,x2..maxInt]
530 efdInt x1 x2
531 | isTrue# (x2 >=# x1) = case maxInt of I# y -> efdtIntUp x1 x2 y
532 | otherwise = case minInt of I# y -> efdtIntDn x1 x2 y
533
534 {-# NOINLINE [1] efdtInt #-}
535 efdtInt :: Int# -> Int# -> Int# -> [Int]
536 -- [x1,x2..y]
537 efdtInt x1 x2 y
538 | isTrue# (x2 >=# x1) = efdtIntUp x1 x2 y
539 | otherwise = efdtIntDn x1 x2 y
540
541 {-# INLINE [0] efdtIntFB #-}
542 efdtIntFB :: (Int -> r -> r) -> r -> Int# -> Int# -> Int# -> r
543 efdtIntFB c n x1 x2 y
544 | isTrue# (x2 >=# x1) = efdtIntUpFB c n x1 x2 y
545 | otherwise = efdtIntDnFB c n x1 x2 y
546
547 -- Requires x2 >= x1
548 efdtIntUp :: Int# -> Int# -> Int# -> [Int]
549 efdtIntUp x1 x2 y -- Be careful about overflow!
550 | isTrue# (y <# x2) = if isTrue# (y <# x1) then [] else [I# x1]
551 | otherwise = -- Common case: x1 <= x2 <= y
552 let !delta = x2 -# x1 -- >= 0
553 !y' = y -# delta -- x1 <= y' <= y; hence y' is representable
554
555 -- Invariant: x <= y
556 -- Note that: z <= y' => z + delta won't overflow
557 -- so we are guaranteed not to overflow if/when we recurse
558 go_up x | isTrue# (x ># y') = [I# x]
559 | otherwise = I# x : go_up (x +# delta)
560 in I# x1 : go_up x2
561
562 -- Requires x2 >= x1
563 efdtIntUpFB :: (Int -> r -> r) -> r -> Int# -> Int# -> Int# -> r
564 efdtIntUpFB c n x1 x2 y -- Be careful about overflow!
565 | isTrue# (y <# x2) = if isTrue# (y <# x1) then n else I# x1 `c` n
566 | otherwise = -- Common case: x1 <= x2 <= y
567 let !delta = x2 -# x1 -- >= 0
568 !y' = y -# delta -- x1 <= y' <= y; hence y' is representable
569
570 -- Invariant: x <= y
571 -- Note that: z <= y' => z + delta won't overflow
572 -- so we are guaranteed not to overflow if/when we recurse
573 go_up x | isTrue# (x ># y') = I# x `c` n
574 | otherwise = I# x `c` go_up (x +# delta)
575 in I# x1 `c` go_up x2
576
577 -- Requires x2 <= x1
578 efdtIntDn :: Int# -> Int# -> Int# -> [Int]
579 efdtIntDn x1 x2 y -- Be careful about underflow!
580 | isTrue# (y ># x2) = if isTrue# (y ># x1) then [] else [I# x1]
581 | otherwise = -- Common case: x1 >= x2 >= y
582 let !delta = x2 -# x1 -- <= 0
583 !y' = y -# delta -- y <= y' <= x1; hence y' is representable
584
585 -- Invariant: x >= y
586 -- Note that: z >= y' => z + delta won't underflow
587 -- so we are guaranteed not to underflow if/when we recurse
588 go_dn x | isTrue# (x <# y') = [I# x]
589 | otherwise = I# x : go_dn (x +# delta)
590 in I# x1 : go_dn x2
591
592 -- Requires x2 <= x1
593 efdtIntDnFB :: (Int -> r -> r) -> r -> Int# -> Int# -> Int# -> r
594 efdtIntDnFB c n x1 x2 y -- Be careful about underflow!
595 | isTrue# (y ># x2) = if isTrue# (y ># x1) then n else I# x1 `c` n
596 | otherwise = -- Common case: x1 >= x2 >= y
597 let !delta = x2 -# x1 -- <= 0
598 !y' = y -# delta -- y <= y' <= x1; hence y' is representable
599
600 -- Invariant: x >= y
601 -- Note that: z >= y' => z + delta won't underflow
602 -- so we are guaranteed not to underflow if/when we recurse
603 go_dn x | isTrue# (x <# y') = I# x `c` n
604 | otherwise = I# x `c` go_dn (x +# delta)
605 in I# x1 `c` go_dn x2
606
607
608 ------------------------------------------------------------------------
609 -- Word
610 ------------------------------------------------------------------------
611
612 instance Bounded Word where
613 minBound = 0
614
615 -- use unboxed literals for maxBound, because GHC doesn't optimise
616 -- (fromInteger 0xffffffff :: Word).
617 #if WORD_SIZE_IN_BITS == 32
618 maxBound = W# (int2Word# 0xFFFFFFFF#)
619 #elif WORD_SIZE_IN_BITS == 64
620 maxBound = W# (int2Word# 0xFFFFFFFFFFFFFFFF#)
621 #else
622 #error Unhandled value for WORD_SIZE_IN_BITS
623 #endif
624
625 instance Enum Word where
626 succ x
627 | x /= maxBound = x + 1
628 | otherwise = succError "Word"
629 pred x
630 | x /= minBound = x - 1
631 | otherwise = predError "Word"
632 toEnum i@(I# i#)
633 | i >= 0 = W# (int2Word# i#)
634 | otherwise = toEnumError "Word" i (minBound::Word, maxBound::Word)
635 fromEnum x@(W# x#)
636 | x <= maxIntWord = I# (word2Int# x#)
637 | otherwise = fromEnumError "Word" x
638
639 enumFrom n = map integerToWordX [wordToIntegerX n .. wordToIntegerX (maxBound :: Word)]
640 enumFromTo n1 n2 = map integerToWordX [wordToIntegerX n1 .. wordToIntegerX n2]
641 enumFromThenTo n1 n2 m = map integerToWordX [wordToIntegerX n1, wordToIntegerX n2 .. wordToIntegerX m]
642 enumFromThen n1 n2 = map integerToWordX [wordToIntegerX n1, wordToIntegerX n2 .. wordToIntegerX limit]
643 where
644 limit :: Word
645 limit | n2 >= n1 = maxBound
646 | otherwise = minBound
647
648 maxIntWord :: Word
649 -- The biggest word representable as an Int
650 maxIntWord = W# (case maxInt of I# i -> int2Word# i)
651
652 -- For some reason integerToWord and wordToInteger (GHC.Integer.Type)
653 -- work over Word#
654 integerToWordX :: Integer -> Word
655 integerToWordX i = W# (integerToWord i)
656
657 wordToIntegerX :: Word -> Integer
658 wordToIntegerX (W# x#) = wordToInteger x#
659
660 ------------------------------------------------------------------------
661 -- Integer
662 ------------------------------------------------------------------------
663
664 instance Enum Integer where
665 succ x = x + 1
666 pred x = x - 1
667 toEnum (I# n) = smallInteger n
668 fromEnum n = I# (integerToInt n)
669
670 {-# INLINE enumFrom #-}
671 {-# INLINE enumFromThen #-}
672 {-# INLINE enumFromTo #-}
673 {-# INLINE enumFromThenTo #-}
674 enumFrom x = enumDeltaInteger x 1
675 enumFromThen x y = enumDeltaInteger x (y-x)
676 enumFromTo x lim = enumDeltaToInteger x 1 lim
677 enumFromThenTo x y lim = enumDeltaToInteger x (y-x) lim
678
679 -- See Note [How the Enum rules work]
680 {-# RULES
681 "enumDeltaInteger" [~1] forall x y. enumDeltaInteger x y = build (\c _ -> enumDeltaIntegerFB c x y)
682 "efdtInteger" [~1] forall x d l. enumDeltaToInteger x d l = build (\c n -> enumDeltaToIntegerFB c n x d l)
683 "efdtInteger1" [~1] forall x l. enumDeltaToInteger x 1 l = build (\c n -> enumDeltaToInteger1FB c n x l)
684
685 "enumDeltaToInteger1FB" [1] forall c n x. enumDeltaToIntegerFB c n x 1 = enumDeltaToInteger1FB c n x
686
687 "enumDeltaInteger" [1] enumDeltaIntegerFB (:) = enumDeltaInteger
688 "enumDeltaToInteger" [1] enumDeltaToIntegerFB (:) [] = enumDeltaToInteger
689 "enumDeltaToInteger1" [1] enumDeltaToInteger1FB (:) [] = enumDeltaToInteger1
690 #-}
691
692 {- Note [Enum Integer rules for literal 1]
693 The "1" rules above specialise for the common case where delta = 1,
694 so that we can avoid the delta>=0 test in enumDeltaToIntegerFB.
695 Then enumDeltaToInteger1FB is nice and small and can be inlined,
696 which would allow the constructor to be inlined and good things to happen.
697
698 We match on the literal "1" both in phase 2 (rule "efdtInteger1") and
699 phase 1 (rule "enumDeltaToInteger1FB"), just for belt and braces
700
701 We do not do it for Int this way because hand-tuned code already exists, and
702 the special case varies more from the general case, due to the issue of overflows.
703 -}
704
705 {-# NOINLINE [0] enumDeltaIntegerFB #-}
706 enumDeltaIntegerFB :: (Integer -> b -> b) -> Integer -> Integer -> b
707 enumDeltaIntegerFB c x0 d = go x0
708 where go x = x `seq` (x `c` go (x+d))
709
710 {-# NOINLINE [1] enumDeltaInteger #-}
711 enumDeltaInteger :: Integer -> Integer -> [Integer]
712 enumDeltaInteger x d = x `seq` (x : enumDeltaInteger (x+d) d)
713 -- strict accumulator, so
714 -- head (drop 1000000 [1 .. ]
715 -- works
716
717 {-# NOINLINE [0] enumDeltaToIntegerFB #-}
718 -- Don't inline this until RULE "enumDeltaToInteger" has had a chance to fire
719 enumDeltaToIntegerFB :: (Integer -> a -> a) -> a
720 -> Integer -> Integer -> Integer -> a
721 enumDeltaToIntegerFB c n x delta lim
722 | delta >= 0 = up_fb c n x delta lim
723 | otherwise = dn_fb c n x delta lim
724
725 {-# NOINLINE [0] enumDeltaToInteger1FB #-}
726 -- Don't inline this until RULE "enumDeltaToInteger" has had a chance to fire
727 enumDeltaToInteger1FB :: (Integer -> a -> a) -> a
728 -> Integer -> Integer -> a
729 enumDeltaToInteger1FB c n x0 lim = go (x0 :: Integer)
730 where
731 go x | x > lim = n
732 | otherwise = x `c` go (x+1)
733
734 {-# NOINLINE [1] enumDeltaToInteger #-}
735 enumDeltaToInteger :: Integer -> Integer -> Integer -> [Integer]
736 enumDeltaToInteger x delta lim
737 | delta >= 0 = up_list x delta lim
738 | otherwise = dn_list x delta lim
739
740 {-# NOINLINE [1] enumDeltaToInteger1 #-}
741 enumDeltaToInteger1 :: Integer -> Integer -> [Integer]
742 -- Special case for Delta = 1
743 enumDeltaToInteger1 x0 lim = go (x0 :: Integer)
744 where
745 go x | x > lim = []
746 | otherwise = x : go (x+1)
747
748 up_fb :: (Integer -> a -> a) -> a -> Integer -> Integer -> Integer -> a
749 up_fb c n x0 delta lim = go (x0 :: Integer)
750 where
751 go x | x > lim = n
752 | otherwise = x `c` go (x+delta)
753 dn_fb :: (Integer -> a -> a) -> a -> Integer -> Integer -> Integer -> a
754 dn_fb c n x0 delta lim = go (x0 :: Integer)
755 where
756 go x | x < lim = n
757 | otherwise = x `c` go (x+delta)
758
759 up_list :: Integer -> Integer -> Integer -> [Integer]
760 up_list x0 delta lim = go (x0 :: Integer)
761 where
762 go x | x > lim = []
763 | otherwise = x : go (x+delta)
764 dn_list :: Integer -> Integer -> Integer -> [Integer]
765 dn_list x0 delta lim = go (x0 :: Integer)
766 where
767 go x | x < lim = []
768 | otherwise = x : go (x+delta)