\begin{code}
-{-# OPTIONS -fno-implicit-prelude #-}
+{-# OPTIONS_GHC -fno-implicit-prelude #-}
-----------------------------------------------------------------------------
-- |
-- Module : GHC.Enum
--
-----------------------------------------------------------------------------
+-- #hide
module GHC.Enum(
Bounded(..), Enum(..),
boundedEnumFrom, boundedEnumFromThen,
-- arithmetic sequences.
--
-- Instances of 'Enum' may be derived for any enumeration type (types
--- whose constructors have no fields); see Chapter 10 of the /Haskell Report/.
+-- 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:
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 = ()
fromEnum () = zeroInt
enumFrom () = [()]
- enumFromThen () () = [()]
+ enumFromThen () () = let many = ():many in many
enumFromTo () () = [()]
- enumFromThenTo () () () = [()]
+ enumFromThenTo () () () = let many = ():many in many
\end{code}
\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"
+ | otherwise = error "Prelude.Enum.Bool.toEnum: bad argument"
fromEnum False = zeroInt
fromEnum True = oneInt
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"
+ toEnum _ = error "Prelude.Enum.Ordering.toEnum: bad argument"
fromEnum LT = zeroInt
fromEnum EQ = oneInt
{-# INLINE enumFromThenTo #-}
enumFromThenTo (I# x1) (I# x2) (I# y) = efdtInt x1 x2 y
-{-# RULES
-"eftInt" [~1] forall x y. eftInt x y = build (\ c n -> eftIntFB c n x y)
-"efdInt" [~1] forall x1 x2. efdInt x1 x2 = build (\ c n -> efdIntFB c n x1 x2)
-"efdtInt" [~1] 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
+
+{-# RULES
+"eftInt" [~1] forall x y. eftInt x y = build (\ c n -> eftIntFB c n x y)
"eftIntList" [1] eftIntFB (:) [] = eftInt
-"efdIntList" [1] efdIntFB (:) [] = efdInt
-"efdtIntList" [1] efdtIntFB (:) [] = efdtInt
#-}
+eftInt :: Int# -> Int# -> [Int]
+-- [x1..x2]
+eftInt x y | x ># y = []
+ | otherwise = go x
+ 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 x y | x ># y = n
| otherwise = go x
where
-- so that when eftInfFB is inlined we can inline
-- whatver is bound to "c"
-eftInt x y | x ># y = []
- | otherwise = go x
- where
- go x = I# x : if x ==# y then [] else go (x +# 1#)
+-----------------------------------------------------
+-- efdInt and efdtInt deal with [a,b..] and [a,b..c], which are much less common
+-- so we are less elaborate. The code is more complicated anyway, because
+-- of worries about Int overflow, so we don't both with rules and deforestation
--- For enumFromThenTo we give up on inlining; so we don't worry
--- about duplicating occurrences of "c"
-{-# NOINLINE [0] efdtIntFB #-}
-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
+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
- | 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
-
-{-# NOINLINE [0] efdIntFB #-}
-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
-
-efdInt 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 = efdtIntUp x1 x2 y
+ | otherwise = efdtIntDn x1 x2 y
+
+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
+ y' = y -# delta
+ -- NB: x1 <= y'; hence y' is representable
+
+ -- Invariant: x <= y; and x+delta won't overflow
+ go_up x | x ># y' = [I# x]
+ | otherwise = I# x : go_up (x +# delta)
+ in
+ I# x1 : go_up x2
+
+efdtIntDn :: Int# -> Int# -> Int# -> [Int]
+efdtIntDn x1 x2 y -- x2 < x1
+ | y ># x2 = if y ># x1 then [] else [I# x1]
+ | otherwise
+ = -- Common case: x1 > x2 >= y
+ let
+ delta = x2 -# x1
+ y' = y -# delta
+ -- NB: x1 <= y'; hence y' is representable
+
+ -- Invariant: x >= y; and x+delta won't overflow
+ go_dn x | x <# y' = [I# x]
+ | otherwise = I# x : go_dn (x +# delta)
+ in
+ I# x1 : go_dn x2
\end{code}
projects / ghc-base.git / blobdiff