X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=GHC%2FEnum.lhs;h=655b53f363300411ffacddbfdbdb4e3652bfd4d3;hb=e9e2a5412bb7cda8d13a063ac403d9f18ac97380;hp=8f1ce75da0c4bfc9f7641a113bac9080702e7ab5;hpb=5545727d5a6a1fc6d5d00f32a92a8fdf0fb7ca77;p=ghc-base.git diff --git a/GHC/Enum.lhs b/GHC/Enum.lhs index 8f1ce75..655b53f 100644 --- a/GHC/Enum.lhs +++ b/GHC/Enum.lhs @@ -1,28 +1,30 @@ -% ----------------------------------------------------------------------------- -% $Id: Enum.lhs,v 1.2 2001/07/03 11:37:50 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 -fno-implicit-prelude #-} +----------------------------------------------------------------------------- +-- | +-- 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. +-- +----------------------------------------------------------------------------- module GHC.Enum( 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 () -- To make sure we look for the .hi file - +import Data.Tuple () -- for dependencies default () -- Double isn't available yet \end{code} @@ -34,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 @@ -79,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 = () @@ -87,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} @@ -120,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 @@ -151,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 @@ -206,53 +259,50 @@ instance Enum Char where {-# 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 #-} +{-# INLINE [0] eftCharFB #-} eftCharFB c n x y = go x 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 x y | x ># y = [] + | otherwise = C# (chr# x) : eftChar (x +# 1#) y -- For enumFromThenTo we give up on inlining +{-# NOINLINE [0] efdCharFB #-} 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 -efdCharList x1 x2 +efdChar x1 x2 | delta >=# 0# = go_up_char_list x1 delta 0x10FFFF# | otherwise = go_dn_char_list x1 delta 0# where delta = x2 -# x1 +{-# NOINLINE [0] efdtCharFB #-} 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 -efdtCharList x1 x2 lim +efdtChar x1 x2 lim | delta >=# 0# = go_up_char_list x1 delta lim | otherwise = go_dn_char_list x1 delta lim where @@ -314,7 +364,8 @@ instance Enum Int where fromEnum x = x {-# INLINE enumFrom #-} - enumFrom (I# x) = eftInt x 2147483647# + enumFrom (I# x) = eftInt x maxInt# + where I# maxInt# = maxInt -- Blarg: technically I guess enumFrom isn't strict! {-# INLINE enumFromTo #-} @@ -326,22 +377,26 @@ instance Enum Int where {-# 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 x y | x ># y = [] + | otherwise = go x + where + go x = I# x : if x ==# y then [] else go (x +# 1#) -{-# INLINE eftIntFB #-} +{-# INLINE [0] eftIntFB #-} +eftIntFB :: (Int -> r -> r) -> r -> Int# -> Int# -> r eftIntFB c n x y | x ># y = n | otherwise = go x where @@ -351,64 +406,54 @@ eftIntFB c n x y | x ># y = n -- so that when eftInfFB is inlined we can inline -- whatver is bound to "c" -eftIntList x y | x ># y = [] - | otherwise = go x - where - go x = I# x : if x ==# y then [] else go (x +# 1#) - --- For enumFromThenTo we give up on inlining; so we don't worry --- about duplicating occurrences of "c" -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# = go_up_int_fb c n x1 delta ( 2147483647# -# delta) - | otherwise = go_dn_int_fb c n x1 delta ((-2147483648#) -# delta) - where - delta = x2 -# x1 - -efdIntList x1 x2 - | delta >=# 0# = go_up_int_list x1 delta ( 2147483647# -# delta) - | otherwise = go_dn_int_list x1 delta ((-2147483648#) -# 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) +----------------------------------------------------- +-- 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 + +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 + +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}