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