-% -----------------------------------------------------------------------------
-% $Id: Enum.lhs,v 1.5 2001/07/31 13:06:51 simonmar Exp $
-%
-% (c) The University of Glasgow, 1992-2000
-%
-
-\section[GHC.Bounded]{Module @GHC.Bounded@}
-
-Instances of Bounded for various datatypes.
-
\begin{code}
-{-# OPTIONS -fno-implicit-prelude #-}
-
+{-# OPTIONS_GHC -XNoImplicitPrelude #-}
+{-# OPTIONS_HADDOCK hide #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module : GHC.Enum
+-- 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)
+--
+-- The 'Enum' and 'Bounded' classes.
+--
+-----------------------------------------------------------------------------
+
+-- #hide
module GHC.Enum(
- Bounded(..), Enum(..),
- boundedEnumFrom, boundedEnumFromThen,
+ Bounded(..), Enum(..),
+ boundedEnumFrom, boundedEnumFromThen,
- -- Instances for Bounded and Eum: (), Char, Int
+ -- Instances for Bounded and Enum: (), Char, Int
) where
-import {-# SOURCE #-} GHC.Err ( error )
import GHC.Base
-import Data.Tuple () -- for dependencies
-default () -- Double isn't available yet
+import Data.Tuple () -- for dependencies
+default () -- Double isn't available yet
\end{code}
%*********************************************************
-%* *
+%* *
\subsection{Class declarations}
-%* *
+%* *
%*********************************************************
\begin{code}
+-- | The 'Bounded' class is used to name the upper and lower limits of a
+-- type. 'Ord' is not a superclass of 'Bounded' since types that are not
+-- totally ordered may also have upper and lower bounds.
+--
+-- The 'Bounded' class may be derived for any enumeration type;
+-- 'minBound' is the first constructor listed in the @data@ declaration
+-- and 'maxBound' is the last.
+-- 'Bounded' may also be derived for single-constructor datatypes whose
+-- constituent types are in 'Bounded'.
+
class Bounded a where
minBound, maxBound :: a
-class Enum a where
- succ, pred :: a -> a
+-- | Class 'Enum' defines operations on sequentially ordered types.
+--
+-- The @enumFrom@... methods are used in Haskell's translation of
+-- arithmetic sequences.
+--
+-- Instances of 'Enum' may be derived for any enumeration type (types
+-- whose constructors have no fields). The nullary constructors are
+-- assumed to be numbered left-to-right by 'fromEnum' from @0@ through @n-1@.
+-- See Chapter 10 of the /Haskell Report/ for more details.
+--
+-- For any type that is an instance of class 'Bounded' as well as 'Enum',
+-- the following should hold:
+--
+-- * The calls @'succ' 'maxBound'@ and @'pred' 'minBound'@ should result in
+-- a runtime error.
+--
+-- * 'fromEnum' and 'toEnum' should give a runtime error if the
+-- result value is not representable in the result type.
+-- For example, @'toEnum' 7 :: 'Bool'@ is an error.
+--
+-- * 'enumFrom' and 'enumFromThen' should be defined with an implicit bound,
+-- thus:
+--
+-- > enumFrom x = enumFromTo x maxBound
+-- > enumFromThen x y = enumFromThenTo x y bound
+-- > where
+-- > bound | fromEnum y >= fromEnum x = maxBound
+-- > | otherwise = minBound
+--
+class Enum a where
+ -- | the successor of a value. For numeric types, 'succ' adds 1.
+ succ :: a -> a
+ -- | the predecessor of a value. For numeric types, 'pred' subtracts 1.
+ pred :: a -> a
+ -- | Convert from an 'Int'.
toEnum :: Int -> a
+ -- | Convert to an 'Int'.
+ -- It is implementation-dependent what 'fromEnum' returns when
+ -- applied to a value that is too large to fit in an 'Int'.
fromEnum :: a -> Int
- enumFrom :: a -> [a] -- [n..]
- enumFromThen :: a -> a -> [a] -- [n,n'..]
- enumFromTo :: a -> a -> [a] -- [n..m]
- enumFromThenTo :: a -> a -> a -> [a] -- [n,n'..m]
-
- succ = toEnum . (`plusInt` oneInt) . fromEnum
- pred = toEnum . (`minusInt` oneInt) . fromEnum
- enumFrom x = map toEnum [fromEnum x ..]
- enumFromThen x y = map toEnum [fromEnum x, fromEnum y ..]
+
+ -- | Used in Haskell's translation of @[n..]@.
+ enumFrom :: a -> [a]
+ -- | Used in Haskell's translation of @[n,n'..]@.
+ enumFromThen :: a -> a -> [a]
+ -- | Used in Haskell's translation of @[n..m]@.
+ enumFromTo :: a -> a -> [a]
+ -- | Used in Haskell's translation of @[n,n'..m]@.
+ enumFromThenTo :: a -> a -> a -> [a]
+
+ succ = toEnum . (`plusInt` oneInt) . fromEnum
+ pred = toEnum . (`minusInt` oneInt) . fromEnum
+ enumFrom x = map toEnum [fromEnum x ..]
+ enumFromThen x y = map toEnum [fromEnum x, fromEnum y ..]
enumFromTo x y = map toEnum [fromEnum x .. fromEnum y]
enumFromThenTo x1 x2 y = map toEnum [fromEnum x1, fromEnum x2 .. fromEnum y]
%*********************************************************
-%* *
+%* *
\subsection{Tuples}
-%* *
+%* *
%*********************************************************
\begin{code}
maxBound = ()
instance Enum () where
- succ _ = error "Prelude.Enum.().succ: bad argment"
+ succ _ = error "Prelude.Enum.().succ: bad argument"
pred _ = error "Prelude.Enum.().pred: bad argument"
toEnum x | x == zeroInt = ()
| otherwise = error "Prelude.Enum.().toEnum: bad argument"
fromEnum () = zeroInt
- enumFrom () = [()]
- enumFromThen () () = [()]
- enumFromTo () () = [()]
- enumFromThenTo () () () = [()]
+ enumFrom () = [()]
+ enumFromThen () () = let many = ():many in many
+ enumFromTo () () = [()]
+ enumFromThenTo () () () = let many = ():many in many
\end{code}
\begin{code}
+-- Report requires instances up to 15
instance (Bounded a, Bounded b) => Bounded (a,b) where
minBound = (minBound, minBound)
maxBound = (maxBound, maxBound)
instance (Bounded a, Bounded b, Bounded c, Bounded d) => Bounded (a,b,c,d) where
minBound = (minBound, minBound, minBound, minBound)
maxBound = (maxBound, maxBound, maxBound, maxBound)
+
+instance (Bounded a, Bounded b, Bounded c, Bounded d, Bounded e) => Bounded (a,b,c,d,e) where
+ minBound = (minBound, minBound, minBound, minBound, minBound)
+ maxBound = (maxBound, maxBound, maxBound, maxBound, maxBound)
+
+instance (Bounded a, Bounded b, Bounded c, Bounded d, Bounded e, Bounded f)
+ => Bounded (a,b,c,d,e,f) where
+ minBound = (minBound, minBound, minBound, minBound, minBound, minBound)
+ maxBound = (maxBound, maxBound, maxBound, maxBound, maxBound, maxBound)
+
+instance (Bounded a, Bounded b, Bounded c, Bounded d, Bounded e, Bounded f, Bounded g)
+ => Bounded (a,b,c,d,e,f,g) where
+ minBound = (minBound, minBound, minBound, minBound, minBound, minBound, minBound)
+ maxBound = (maxBound, maxBound, maxBound, maxBound, maxBound, maxBound, maxBound)
+
+instance (Bounded a, Bounded b, Bounded c, Bounded d, Bounded e, Bounded f, Bounded g,
+ Bounded h)
+ => Bounded (a,b,c,d,e,f,g,h) where
+ minBound = (minBound, minBound, minBound, minBound, minBound, minBound, minBound, minBound)
+ maxBound = (maxBound, maxBound, maxBound, maxBound, maxBound, maxBound, maxBound, maxBound)
+
+instance (Bounded a, Bounded b, Bounded c, Bounded d, Bounded e, Bounded f, Bounded g,
+ Bounded h, Bounded i)
+ => Bounded (a,b,c,d,e,f,g,h,i) where
+ minBound = (minBound, minBound, minBound, minBound, minBound, minBound, minBound, minBound,
+ minBound)
+ maxBound = (maxBound, maxBound, maxBound, maxBound, maxBound, maxBound, maxBound, maxBound,
+ maxBound)
+
+instance (Bounded a, Bounded b, Bounded c, Bounded d, Bounded e, Bounded f, Bounded g,
+ Bounded h, Bounded i, Bounded j)
+ => Bounded (a,b,c,d,e,f,g,h,i,j) where
+ minBound = (minBound, minBound, minBound, minBound, minBound, minBound, minBound, minBound,
+ minBound, minBound)
+ maxBound = (maxBound, maxBound, maxBound, maxBound, maxBound, maxBound, maxBound, maxBound,
+ maxBound, maxBound)
+
+instance (Bounded a, Bounded b, Bounded c, Bounded d, Bounded e, Bounded f, Bounded g,
+ Bounded h, Bounded i, Bounded j, Bounded k)
+ => Bounded (a,b,c,d,e,f,g,h,i,j,k) where
+ minBound = (minBound, minBound, minBound, minBound, minBound, minBound, minBound, minBound,
+ minBound, minBound, minBound)
+ maxBound = (maxBound, maxBound, maxBound, maxBound, maxBound, maxBound, maxBound, maxBound,
+ maxBound, maxBound, maxBound)
+
+instance (Bounded a, Bounded b, Bounded c, Bounded d, Bounded e, Bounded f, Bounded g,
+ Bounded h, Bounded i, Bounded j, Bounded k, Bounded l)
+ => Bounded (a,b,c,d,e,f,g,h,i,j,k,l) where
+ minBound = (minBound, minBound, minBound, minBound, minBound, minBound, minBound, minBound,
+ minBound, minBound, minBound, minBound)
+ maxBound = (maxBound, maxBound, maxBound, maxBound, maxBound, maxBound, maxBound, maxBound,
+ maxBound, maxBound, maxBound, maxBound)
+
+instance (Bounded a, Bounded b, Bounded c, Bounded d, Bounded e, Bounded f, Bounded g,
+ Bounded h, Bounded i, Bounded j, Bounded k, Bounded l, Bounded m)
+ => Bounded (a,b,c,d,e,f,g,h,i,j,k,l,m) where
+ minBound = (minBound, minBound, minBound, minBound, minBound, minBound, minBound, minBound,
+ minBound, minBound, minBound, minBound, minBound)
+ maxBound = (maxBound, maxBound, maxBound, maxBound, maxBound, maxBound, maxBound, maxBound,
+ maxBound, maxBound, maxBound, maxBound, maxBound)
+
+instance (Bounded a, Bounded b, Bounded c, Bounded d, Bounded e, Bounded f, Bounded g,
+ Bounded h, Bounded i, Bounded j, Bounded k, Bounded l, Bounded m, Bounded n)
+ => Bounded (a,b,c,d,e,f,g,h,i,j,k,l,m,n) where
+ minBound = (minBound, minBound, minBound, minBound, minBound, minBound, minBound, minBound,
+ minBound, minBound, minBound, minBound, minBound, minBound)
+ maxBound = (maxBound, maxBound, maxBound, maxBound, maxBound, maxBound, maxBound, maxBound,
+ maxBound, maxBound, maxBound, maxBound, maxBound, maxBound)
+
+instance (Bounded a, Bounded b, Bounded c, Bounded d, Bounded e, Bounded f, Bounded g,
+ Bounded h, Bounded i, Bounded j, Bounded k, Bounded l, Bounded m, Bounded n, Bounded o)
+ => Bounded (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o) where
+ minBound = (minBound, minBound, minBound, minBound, minBound, minBound, minBound, minBound,
+ minBound, minBound, minBound, minBound, minBound, minBound, minBound)
+ maxBound = (maxBound, maxBound, maxBound, maxBound, maxBound, maxBound, maxBound, maxBound,
+ maxBound, maxBound, maxBound, maxBound, maxBound, maxBound, maxBound)
\end{code}
%*********************************************************
-%* *
+%* *
\subsection{Type @Bool@}
-%* *
+%* *
%*********************************************************
\begin{code}
instance Enum Bool where
succ False = True
- succ True = error "Prelude.Enum.Bool.succ: bad argment"
+ succ True = error "Prelude.Enum.Bool.succ: bad argument"
pred True = False
- pred False = error "Prelude.Enum.Bool.pred: bad argment"
+ pred False = error "Prelude.Enum.Bool.pred: bad argument"
toEnum n | n == zeroInt = False
- | n == oneInt = True
- | otherwise = error "Prelude.Enum.Bool.toEnum: bad argment"
+ | n == oneInt = True
+ | otherwise = error "Prelude.Enum.Bool.toEnum: bad argument"
fromEnum False = zeroInt
fromEnum True = oneInt
\end{code}
%*********************************************************
-%* *
+%* *
\subsection{Type @Ordering@}
-%* *
+%* *
%*********************************************************
\begin{code}
instance Enum Ordering where
succ LT = EQ
succ EQ = GT
- succ GT = error "Prelude.Enum.Ordering.succ: bad argment"
+ succ GT = error "Prelude.Enum.Ordering.succ: bad argument"
pred GT = EQ
pred EQ = LT
- pred LT = error "Prelude.Enum.Ordering.pred: bad argment"
+ pred LT = error "Prelude.Enum.Ordering.pred: bad argument"
toEnum n | n == zeroInt = LT
- | n == oneInt = EQ
- | n == twoInt = GT
- toEnum _ = error "Prelude.Enum.Ordering.toEnum: bad argment"
+ | n == oneInt = EQ
+ | n == twoInt = GT
+ toEnum _ = error "Prelude.Enum.Ordering.toEnum: bad argument"
fromEnum LT = zeroInt
fromEnum EQ = oneInt
\end{code}
%*********************************************************
-%* *
+%* *
\subsection{Type @Char@}
-%* *
+%* *
%*********************************************************
\begin{code}
instance Enum Char where
succ (C# c#)
| not (ord# c# ==# 0x10FFFF#) = C# (chr# (ord# c# +# 1#))
- | otherwise = error ("Prelude.Enum.Char.succ: bad argument")
+ | otherwise = error ("Prelude.Enum.Char.succ: bad argument")
pred (C# c#)
| not (ord# c# ==# 0#) = C# (chr# (ord# c# -# 1#))
- | otherwise = error ("Prelude.Enum.Char.pred: bad argument")
+ | otherwise = error ("Prelude.Enum.Char.pred: bad argument")
toEnum = chr
fromEnum = ord
{-# INLINE enumFrom #-}
enumFrom (C# x) = eftChar (ord# x) 0x10FFFF#
- -- Blarg: technically I guess enumFrom isn't strict!
+ -- Blarg: technically I guess enumFrom isn't strict!
{-# INLINE enumFromTo #-}
enumFromTo (C# x) (C# y) = eftChar (ord# x) (ord# y)
{-# INLINE enumFromThenTo #-}
enumFromThenTo (C# x1) (C# x2) (C# y) = efdtChar (ord# x1) (ord# x2) (ord# y)
-eftChar = eftCharList
-efdChar = efdCharList
-efdtChar = efdtCharList
-
-
{-# RULES
-"eftChar" forall x y. eftChar x y = build (\c n -> eftCharFB c n x y)
-"efdChar" forall x1 x2. efdChar x1 x2 = build (\ c n -> efdCharFB c n x1 x2)
-"efdtChar" forall x1 x2 l. efdtChar x1 x2 l = build (\ c n -> efdtCharFB c n x1 x2 l)
-"eftCharList" eftCharFB (:) [] = eftCharList
-"efdCharList" efdCharFB (:) [] = efdCharList
-"efdtCharList" efdtCharFB (:) [] = efdtCharList
+"eftChar" [~1] forall x y. eftChar x y = build (\c n -> eftCharFB c n x y)
+"efdChar" [~1] forall x1 x2. efdChar x1 x2 = build (\ c n -> efdCharFB c n x1 x2)
+"efdtChar" [~1] forall x1 x2 l. efdtChar x1 x2 l = build (\ c n -> efdtCharFB c n x1 x2 l)
+"eftCharList" [1] eftCharFB (:) [] = eftChar
+"efdCharList" [1] efdCharFB (:) [] = efdChar
+"efdtCharList" [1] efdtCharFB (:) [] = efdtChar
#-}
-- We can do better than for Ints because we don't
-- have hassles about arithmetic overflow at maxBound
-{-# INLINE eftCharFB #-}
-eftCharFB c n x y = go x
- where
- go x | x ># y = n
- | otherwise = C# (chr# x) `c` go (x +# 1#)
+{-# INLINE [0] eftCharFB #-}
+eftCharFB :: (Char -> a -> a) -> a -> Int# -> Int# -> a
+eftCharFB c n x0 y = go x0
+ where
+ go x | x ># y = n
+ | otherwise = C# (chr# x) `c` go (x +# 1#)
-eftCharList x y | x ># y = []
- | otherwise = C# (chr# x) : eftCharList (x +# 1#) y
+eftChar :: Int# -> Int# -> String
+eftChar x y | x ># y = []
+ | otherwise = C# (chr# x) : eftChar (x +# 1#) y
-- For enumFromThenTo we give up on inlining
+{-# NOINLINE [0] efdCharFB #-}
+efdCharFB :: (Char -> a -> a) -> a -> Int# -> Int# -> a
efdCharFB c n x1 x2
| delta >=# 0# = go_up_char_fb c n x1 delta 0x10FFFF#
| otherwise = go_dn_char_fb c n x1 delta 0#
where
- delta = x2 -# x1
+ !delta = x2 -# x1
-efdCharList x1 x2
+efdChar :: Int# -> Int# -> String
+efdChar x1 x2
| delta >=# 0# = go_up_char_list x1 delta 0x10FFFF#
| otherwise = go_dn_char_list x1 delta 0#
where
- delta = x2 -# x1
+ !delta = x2 -# x1
+{-# NOINLINE [0] efdtCharFB #-}
+efdtCharFB :: (Char -> a -> a) -> a -> Int# -> Int# -> Int# -> a
efdtCharFB c n x1 x2 lim
| delta >=# 0# = go_up_char_fb c n x1 delta lim
| otherwise = go_dn_char_fb c n x1 delta lim
where
- delta = x2 -# x1
+ !delta = x2 -# x1
-efdtCharList x1 x2 lim
+efdtChar :: Int# -> Int# -> Int# -> String
+efdtChar x1 x2 lim
| delta >=# 0# = go_up_char_list x1 delta lim
| otherwise = go_dn_char_list x1 delta lim
where
- delta = x2 -# x1
+ !delta = x2 -# x1
-go_up_char_fb c n x delta lim
- = go_up x
+go_up_char_fb :: (Char -> a -> a) -> a -> Int# -> Int# -> Int# -> a
+go_up_char_fb c n x0 delta lim
+ = go_up x0
where
go_up x | x ># lim = n
- | otherwise = C# (chr# x) `c` go_up (x +# delta)
+ | otherwise = C# (chr# x) `c` go_up (x +# delta)
-go_dn_char_fb c n x delta lim
- = go_dn x
+go_dn_char_fb :: (Char -> a -> a) -> a -> Int# -> Int# -> Int# -> a
+go_dn_char_fb c n x0 delta lim
+ = go_dn x0
where
go_dn x | x <# lim = n
- | otherwise = C# (chr# x) `c` go_dn (x +# delta)
+ | otherwise = C# (chr# x) `c` go_dn (x +# delta)
-go_up_char_list x delta lim
- = go_up x
+go_up_char_list :: Int# -> Int# -> Int# -> String
+go_up_char_list x0 delta lim
+ = go_up x0
where
go_up x | x ># lim = []
- | otherwise = C# (chr# x) : go_up (x +# delta)
+ | otherwise = C# (chr# x) : go_up (x +# delta)
-go_dn_char_list x delta lim
- = go_dn x
+go_dn_char_list :: Int# -> Int# -> Int# -> String
+go_dn_char_list x0 delta lim
+ = go_dn x0
where
go_dn x | x <# lim = []
- | otherwise = C# (chr# x) : go_dn (x +# delta)
+ | otherwise = C# (chr# x) : go_dn (x +# delta)
\end{code}
%*********************************************************
-%* *
+%* *
\subsection{Type @Int@}
-%* *
+%* *
%*********************************************************
Be careful about these instances.
- (a) remember that you have to count down as well as up e.g. [13,12..0]
- (b) be careful of Int overflow
- (c) remember that Int is bounded, so [1..] terminates at maxInt
+ (a) remember that you have to count down as well as up e.g. [13,12..0]
+ (b) be careful of Int overflow
+ (c) remember that Int is bounded, so [1..] terminates at maxInt
Also NB that the Num class isn't available in this module.
-
+
\begin{code}
instance Bounded Int where
minBound = minInt
fromEnum x = x
{-# INLINE enumFrom #-}
- enumFrom (I# x) = case maxInt of I# y -> eftInt x y
- -- Blarg: technically I guess enumFrom isn't strict!
+ enumFrom (I# x) = eftInt x maxInt#
+ where !(I# maxInt#) = maxInt
+ -- Blarg: technically I guess enumFrom isn't strict!
{-# INLINE enumFromTo #-}
enumFromTo (I# x) (I# y) = eftInt x y
{-# INLINE enumFromThenTo #-}
enumFromThenTo (I# x1) (I# x2) (I# y) = efdtInt x1 x2 y
-eftInt = eftIntList
-efdInt = efdIntList
-efdtInt = efdtIntList
-{-# RULES
-"eftInt" forall x y. eftInt x y = build (\ c n -> eftIntFB c n x y)
-"efdInt" forall x1 x2. efdInt x1 x2 = build (\ c n -> efdIntFB c n x1 x2)
-"efdtInt" forall x1 x2 l. efdtInt x1 x2 l = build (\ c n -> efdtIntFB c n x1 x2 l)
+-----------------------------------------------------
+-- eftInt and eftIntFB deal with [a..b], which is the
+-- most common form, so we take a lot of care
+-- In particular, we have rules for deforestation
-"eftIntList" eftIntFB (:) [] = eftIntList
-"efdIntList" efdIntFB (:) [] = efdIntList
-"efdtIntList" efdtIntFB (:) [] = efdtIntList
+{-# RULES
+"eftInt" [~1] forall x y. eftInt x y = build (\ c n -> eftIntFB c n x y)
+"eftIntList" [1] eftIntFB (:) [] = eftInt
#-}
+eftInt :: Int# -> Int# -> [Int]
+-- [x1..x2]
+eftInt x0 y | x0 ># y = []
+ | otherwise = go x0
+ where
+ go x = I# x : if x ==# y then [] else go (x +# 1#)
+
+{-# INLINE [0] eftIntFB #-}
+eftIntFB :: (Int -> r -> r) -> r -> Int# -> Int# -> r
+eftIntFB c n x0 y | x0 ># y = n
+ | otherwise = go x0
+ where
+ go x = I# x `c` if x ==# y then n else go (x +# 1#)
+ -- Watch out for y=maxBound; hence ==, not >
+ -- Be very careful not to have more than one "c"
+ -- so that when eftInfFB is inlined we can inline
+ -- whatever is bound to "c"
+
+
+-----------------------------------------------------
+-- efdInt and efdtInt deal with [a,b..] and [a,b..c].
+-- The code is more complicated because of worries about Int overflow.
-{-# INLINE eftIntFB #-}
-eftIntFB c n x y | x ># y = n
- | otherwise = go x
- where
- go x = I# x `c` if x ==# y then n else go (x +# 1#)
- -- Watch out for y=maxBound; hence ==, not >
- -- Be very careful not to have more than one "c"
- -- so that when eftInfFB is inlined we can inline
- -- whatver is bound to "c"
+{-# RULES
+"efdtInt" [~1] forall x1 x2 y.
+ efdtInt x1 x2 y = build (\ c n -> efdtIntFB c n x1 x2 y)
+"efdtIntUpList" [1] efdtIntFB (:) [] = efdtInt
+ #-}
-eftIntList x y | x ># y = []
- | otherwise = go x
- where
- go x = I# x : if x ==# y then [] else go (x +# 1#)
+efdInt :: Int# -> Int# -> [Int]
+-- [x1,x2..maxInt]
+efdInt x1 x2
+ | x2 >=# x1 = case maxInt of I# y -> efdtIntUp x1 x2 y
+ | otherwise = case minInt of I# y -> efdtIntDn x1 x2 y
+efdtInt :: Int# -> Int# -> Int# -> [Int]
+-- [x1,x2..y]
+efdtInt x1 x2 y
+ | x2 >=# x1 = efdtIntUp x1 x2 y
+ | otherwise = efdtIntDn x1 x2 y
--- For enumFromThenTo we give up on inlining; so we don't worry
--- about duplicating occurrences of "c"
+{-# INLINE [0] efdtIntFB #-}
+efdtIntFB :: (Int -> r -> r) -> r -> Int# -> Int# -> Int# -> r
efdtIntFB c n x1 x2 y
- | delta >=# 0# = if x1 ># y then n else go_up_int_fb c n x1 delta lim
- | otherwise = if x1 <# y then n else go_dn_int_fb c n x1 delta lim
- where
- delta = x2 -# x1
- lim = y -# delta
-
-efdtIntList x1 x2 y
- | delta >=# 0# = if x1 ># y then [] else go_up_int_list x1 delta lim
- | otherwise = if x1 <# y then [] else go_dn_int_list x1 delta lim
- where
- delta = x2 -# x1
- lim = y -# delta
-
-efdIntFB c n x1 x2
- | delta >=# 0# = case maxInt of I# y -> go_up_int_fb c n x1 delta (y -# delta)
- | otherwise = case minInt of I# y -> go_dn_int_fb c n x1 delta (y -# delta)
- where
- delta = x2 -# x1
-
-efdIntList x1 x2
- | delta >=# 0# = case maxInt of I# y -> go_up_int_list x1 delta (y -# delta)
- | otherwise = case minInt of I# y -> go_dn_int_list x1 delta (y -# delta)
- where
- delta = x2 -# x1
-
--- In all of these, the (x +# delta) is guaranteed not to overflow
-
-go_up_int_fb c n x delta lim
- = go_up x
- where
- go_up x | x ># lim = I# x `c` n
- | otherwise = I# x `c` go_up (x +# delta)
-
-go_dn_int_fb c n x delta lim
- = go_dn x
- where
- go_dn x | x <# lim = I# x `c` n
- | otherwise = I# x `c` go_dn (x +# delta)
-
-go_up_int_list x delta lim
- = go_up x
- where
- go_up x | x ># lim = [I# x]
- | otherwise = I# x : go_up (x +# delta)
-
-go_dn_int_list x delta lim
- = go_dn x
- where
- go_dn x | x <# lim = [I# x]
- | otherwise = I# x : go_dn (x +# delta)
+ | x2 >=# x1 = efdtIntUpFB c n x1 x2 y
+ | otherwise = efdtIntDnFB c n x1 x2 y
+
+-- Requires x2 >= x1
+efdtIntUp :: Int# -> Int# -> Int# -> [Int]
+efdtIntUp x1 x2 y -- Be careful about overflow!
+ | y <# x2 = if y <# x1 then [] else [I# x1]
+ | otherwise = -- Common case: x1 <= x2 <= y
+ let !delta = x2 -# x1 -- >= 0
+ !y' = y -# delta -- x1 <= y' <= y; hence y' is representable
+
+ -- Invariant: x <= y
+ -- Note that: z <= y' => z + delta won't overflow
+ -- so we are guaranteed not to overflow if/when we recurse
+ go_up x | x ># y' = [I# x]
+ | otherwise = I# x : go_up (x +# delta)
+ in I# x1 : go_up x2
+
+-- Requires x2 >= x1
+efdtIntUpFB :: (Int -> r -> r) -> r -> Int# -> Int# -> Int# -> r
+efdtIntUpFB c n x1 x2 y -- Be careful about overflow!
+ | y <# x2 = if y <# x1 then n else I# x1 `c` n
+ | otherwise = -- Common case: x1 <= x2 <= y
+ let !delta = x2 -# x1 -- >= 0
+ !y' = y -# delta -- x1 <= y' <= y; hence y' is representable
+
+ -- Invariant: x <= y
+ -- Note that: z <= y' => z + delta won't overflow
+ -- so we are guaranteed not to overflow if/when we recurse
+ go_up x | x ># y' = I# x `c` n
+ | otherwise = I# x `c` go_up (x +# delta)
+ in I# x1 `c` go_up x2
+
+-- Requires x2 <= x1
+efdtIntDn :: Int# -> Int# -> Int# -> [Int]
+efdtIntDn x1 x2 y -- Be careful about underflow!
+ | y ># x2 = if y ># x1 then [] else [I# x1]
+ | otherwise = -- Common case: x1 >= x2 >= y
+ let !delta = x2 -# x1 -- <= 0
+ !y' = y -# delta -- y <= y' <= x1; hence y' is representable
+
+ -- Invariant: x >= y
+ -- Note that: z >= y' => z + delta won't underflow
+ -- so we are guaranteed not to underflow if/when we recurse
+ go_dn x | x <# y' = [I# x]
+ | otherwise = I# x : go_dn (x +# delta)
+ in I# x1 : go_dn x2
+
+-- Requires x2 <= x1
+efdtIntDnFB :: (Int -> r -> r) -> r -> Int# -> Int# -> Int# -> r
+efdtIntDnFB c n x1 x2 y -- Be careful about underflow!
+ | y ># x2 = if y ># x1 then n else I# x1 `c` n
+ | otherwise = -- Common case: x1 >= x2 >= y
+ let !delta = x2 -# x1 -- <= 0
+ !y' = y -# delta -- y <= y' <= x1; hence y' is representable
+
+ -- Invariant: x >= y
+ -- Note that: z >= y' => z + delta won't underflow
+ -- so we are guaranteed not to underflow if/when we recurse
+ go_dn x | x <# y' = I# x `c` n
+ | otherwise = I# x `c` go_dn (x +# delta)
+ in I# x1 `c` go_dn x2
\end{code}