X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=GHC%2FEnum.lhs;h=655b53f363300411ffacddbfdbdb4e3652bfd4d3;hb=e9e2a5412bb7cda8d13a063ac403d9f18ac97380;hp=93af9eb01970a28b2540fe7d9139111682ad9538;hpb=b706340c451952adf230b5b8daecad8a1f34d714;p=ghc-base.git diff --git a/GHC/Enum.lhs b/GHC/Enum.lhs index 93af9eb..655b53f 100644 --- a/GHC/Enum.lhs +++ b/GHC/Enum.lhs @@ -1,5 +1,5 @@ \begin{code} -{-# OPTIONS -fno-implicit-prelude #-} +{-# OPTIONS_GHC -fno-implicit-prelude #-} ----------------------------------------------------------------------------- -- | -- Module : GHC.Enum @@ -36,17 +36,68 @@ default () -- Double isn't available yet %********************************************************* \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' 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 - succ, pred :: a -> a + -- | 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] + + -- | 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 @@ -81,7 +132,7 @@ instance Bounded () where 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 = () @@ -89,9 +140,9 @@ instance Enum () where fromEnum () = zeroInt enumFrom () = [()] - enumFromThen () () = [()] + enumFromThen () () = let many = ():many in many enumFromTo () () = [()] - enumFromThenTo () () () = [()] + enumFromThenTo () () () = let many = ():many in many \end{code} \begin{code} @@ -122,14 +173,14 @@ instance Bounded Bool where 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 @@ -153,16 +204,16 @@ instance Bounded Ordering where 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 @@ -326,18 +377,26 @@ instance Enum Int where {-# 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 @@ -347,66 +406,54 @@ eftIntFB c n x y | x ># y = n -- 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}