\begin{code}
module GHC.Enum(
Bounded(..), Enum(..),
boundedEnumFrom, boundedEnumFromThen,
) where
import GHC.Base
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}
%*********************************************************
%* *
\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}