\begin{code}
module GHC.Enum(
Bounded(..), Enum(..),
boundedEnumFrom, boundedEnumFromThen,
toEnumError, fromEnumError, succError, predError,
) where
import GHC.Base
import GHC.Integer
import GHC.Num
import GHC.Show
import Data.Tuple ()
default ()
\end{code}
%*********************************************************
%* *
\subsection{Class declarations}
%* *
%*********************************************************
\begin{code}
class Bounded a where
minBound, maxBound :: a
class Enum a where
succ :: a -> a
pred :: a -> a
toEnum :: Int -> a
fromEnum :: a -> Int
enumFrom :: a -> [a]
enumFromThen :: a -> a -> [a]
enumFromTo :: a -> a -> [a]
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]
boundedEnumFrom :: (Enum a, Bounded a) => a -> [a]
boundedEnumFrom n = map toEnum [fromEnum n .. fromEnum (maxBound `asTypeOf` n)]
boundedEnumFromThen :: (Enum a, Bounded a) => a -> a -> [a]
boundedEnumFromThen n1 n2
| i_n2 >= i_n1 = map toEnum [i_n1, i_n2 .. fromEnum (maxBound `asTypeOf` n1)]
| otherwise = map toEnum [i_n1, i_n2 .. fromEnum (minBound `asTypeOf` n1)]
where
i_n1 = fromEnum n1
i_n2 = fromEnum n2
\end{code}
\begin{code}
toEnumError :: (Show a) => String -> Int -> (a,a) -> b
toEnumError inst_ty i bnds =
error $ "Enum.toEnum{" ++ inst_ty ++ "}: tag (" ++
show i ++
") is outside of bounds " ++
show bnds
fromEnumError :: (Show a) => String -> a -> b
fromEnumError inst_ty x =
error $ "Enum.fromEnum{" ++ inst_ty ++ "}: value (" ++
show x ++
") is outside of Int's bounds " ++
show (minBound::Int, maxBound::Int)
succError :: String -> a
succError inst_ty =
error $ "Enum.succ{" ++ inst_ty ++ "}: tried to take `succ' of maxBound"
predError :: String -> a
predError inst_ty =
error $ "Enum.pred{" ++ inst_ty ++ "}: tried to take `pred' of minBound"
\end{code}
%*********************************************************
%* *
\subsection{Tuples}
%* *
%*********************************************************
\begin{code}
instance Bounded () where
minBound = ()
maxBound = ()
instance Enum () where
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 () () = let many = ():many in many
enumFromTo () () = [()]
enumFromThenTo () () () = let many = ():many in many
\end{code}
\begin{code}
instance (Bounded a, Bounded b) => Bounded (a,b) where
minBound = (minBound, minBound)
maxBound = (maxBound, maxBound)
instance (Bounded a, Bounded b, Bounded c) => Bounded (a,b,c) where
minBound = (minBound, minBound, minBound)
maxBound = (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 Bounded Bool where
minBound = False
maxBound = True
instance Enum Bool where
succ False = True
succ True = error "Prelude.Enum.Bool.succ: bad argument"
pred True = False
pred False = error "Prelude.Enum.Bool.pred: bad argument"
toEnum n | n == zeroInt = False
| n == oneInt = True
| otherwise = error "Prelude.Enum.Bool.toEnum: bad argument"
fromEnum False = zeroInt
fromEnum True = oneInt
enumFrom = boundedEnumFrom
enumFromThen = boundedEnumFromThen
\end{code}
%*********************************************************
%* *
\subsection{Type @Ordering@}
%* *
%*********************************************************
\begin{code}
instance Bounded Ordering where
minBound = LT
maxBound = GT
instance Enum Ordering where
succ LT = EQ
succ EQ = GT
succ GT = error "Prelude.Enum.Ordering.succ: bad argument"
pred GT = EQ
pred EQ = LT
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 argument"
fromEnum LT = zeroInt
fromEnum EQ = oneInt
fromEnum GT = twoInt
enumFrom = boundedEnumFrom
enumFromThen = boundedEnumFromThen
\end{code}
%*********************************************************
%* *
\subsection{Type @Char@}
%* *
%*********************************************************
\begin{code}
instance Bounded Char where
minBound = '\0'
maxBound = '\x10FFFF'
instance Enum Char where
succ (C# c#)
| not (ord# c# ==# 0x10FFFF#) = C# (chr# (ord# c# +# 1#))
| 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")
toEnum = chr
fromEnum = ord
enumFrom (C# x) = eftChar (ord# x) 0x10FFFF#
enumFromTo (C# x) (C# y) = eftChar (ord# x) (ord# y)
enumFromThen (C# x1) (C# x2) = efdChar (ord# x1) (ord# x2)
enumFromThenTo (C# x1) (C# x2) (C# y) = efdtChar (ord# x1) (ord# x2) (ord# y)
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#)
eftChar :: Int# -> Int# -> String
eftChar x y | x ># y = []
| otherwise = C# (chr# x) : eftChar (x +# 1#) y
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
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
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
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
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)
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)
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)
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)
\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
Also NB that the Num class isn't available in this module.
\begin{code}
instance Bounded Int where
minBound = minInt
maxBound = maxInt
instance Enum Int where
succ x
| x == maxBound = error "Prelude.Enum.succ{Int}: tried to take `succ' of maxBound"
| otherwise = x `plusInt` oneInt
pred x
| x == minBound = error "Prelude.Enum.pred{Int}: tried to take `pred' of minBound"
| otherwise = x `minusInt` oneInt
toEnum x = x
fromEnum x = x
enumFrom (I# x) = eftInt x maxInt#
where !(I# maxInt#) = maxInt
enumFromTo (I# x) (I# y) = eftInt x y
enumFromThen (I# x1) (I# x2) = efdInt x1 x2
enumFromThenTo (I# x1) (I# x2) (I# y) = efdtInt x1 x2 y
eftInt :: Int# -> Int# -> [Int]
eftInt x0 y | x0 ># y = []
| otherwise = go x0
where
go x = I# x : if x ==# y then [] else go (x +# 1#)
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#)
efdInt :: Int# -> Int# -> [Int]
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]
efdtInt x1 x2 y
| x2 >=# x1 = efdtIntUp x1 x2 y
| otherwise = efdtIntDn x1 x2 y
efdtIntFB :: (Int -> r -> r) -> r -> Int# -> Int# -> Int# -> r
efdtIntFB c n x1 x2 y
| x2 >=# x1 = efdtIntUpFB c n x1 x2 y
| otherwise = efdtIntDnFB c n x1 x2 y
efdtIntUp :: Int# -> Int# -> Int# -> [Int]
efdtIntUp x1 x2 y
| y <# x2 = if y <# x1 then [] else [I# x1]
| otherwise =
let !delta = x2 -# x1
!y' = y -# delta
go_up x | x ># y' = [I# x]
| otherwise = I# x : go_up (x +# delta)
in I# x1 : go_up x2
efdtIntUpFB :: (Int -> r -> r) -> r -> Int# -> Int# -> Int# -> r
efdtIntUpFB c n x1 x2 y
| y <# x2 = if y <# x1 then n else I# x1 `c` n
| otherwise =
let !delta = x2 -# x1
!y' = y -# delta
go_up x | x ># y' = I# x `c` n
| otherwise = I# x `c` go_up (x +# delta)
in I# x1 `c` go_up x2
efdtIntDn :: Int# -> Int# -> Int# -> [Int]
efdtIntDn x1 x2 y
| y ># x2 = if y ># x1 then [] else [I# x1]
| otherwise =
let !delta = x2 -# x1
!y' = y -# delta
go_dn x | x <# y' = [I# x]
| otherwise = I# x : go_dn (x +# delta)
in I# x1 : go_dn x2
efdtIntDnFB :: (Int -> r -> r) -> r -> Int# -> Int# -> Int# -> r
efdtIntDnFB c n x1 x2 y
| y ># x2 = if y ># x1 then n else I# x1 `c` n
| otherwise =
let !delta = x2 -# x1
!y' = y -# delta
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}
%*********************************************************
%* *
\subsection{The @Integer@ instance for @Enum@}
%* *
%*********************************************************
\begin{code}
instance Enum Integer where
succ x = x + 1
pred x = x 1
toEnum (I# n) = smallInteger n
fromEnum n = I# (integerToInt n)
enumFrom x = enumDeltaInteger x 1
enumFromThen x y = enumDeltaInteger x (yx)
enumFromTo x lim = enumDeltaToInteger x 1 lim
enumFromThenTo x y lim = enumDeltaToInteger x (yx) lim
enumDeltaIntegerFB :: (Integer -> b -> b) -> Integer -> Integer -> b
enumDeltaIntegerFB c x d = x `seq` (x `c` enumDeltaIntegerFB c (x+d) d)
enumDeltaInteger :: Integer -> Integer -> [Integer]
enumDeltaInteger x d = x `seq` (x : enumDeltaInteger (x+d) d)
enumDeltaToIntegerFB :: (Integer -> a -> a) -> a
-> Integer -> Integer -> Integer -> a
enumDeltaToIntegerFB c n x delta lim
| delta >= 0 = up_fb c n x delta lim
| otherwise = dn_fb c n x delta lim
enumDeltaToInteger :: Integer -> Integer -> Integer -> [Integer]
enumDeltaToInteger x delta lim
| delta >= 0 = up_list x delta lim
| otherwise = dn_list x delta lim
up_fb :: (Integer -> a -> a) -> a -> Integer -> Integer -> Integer -> a
up_fb c n x0 delta lim = go (x0 :: Integer)
where
go x | x > lim = n
| otherwise = x `c` go (x+delta)
dn_fb :: (Integer -> a -> a) -> a -> Integer -> Integer -> Integer -> a
dn_fb c n x0 delta lim = go (x0 :: Integer)
where
go x | x < lim = n
| otherwise = x `c` go (x+delta)
up_list :: Integer -> Integer -> Integer -> [Integer]
up_list x0 delta lim = go (x0 :: Integer)
where
go x | x > lim = []
| otherwise = x : go (x+delta)
dn_list :: Integer -> Integer -> Integer -> [Integer]
dn_list x0 delta lim = go (x0 :: Integer)
where
go x | x < lim = []
| otherwise = x : go (x+delta)
\end{code}