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