X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=GHC%2FEnum.lhs;h=ac6e9a916a7d7967111d8776249dbee505c0ed77;hb=be2750a0a11b919fb03cc070074e430f88bdfa90;hp=7e59d9889bbd58b0f37ffd2fad88357ae7c91acd;hpb=04e1165a49ded96beef4b18a2ed0de7e26b05cf4;p=ghc-base.git diff --git a/GHC/Enum.lhs b/GHC/Enum.lhs index 7e59d98..ac6e9a9 100644 --- a/GHC/Enum.lhs +++ b/GHC/Enum.lhs @@ -1,54 +1,109 @@ -% ----------------------------------------------------------------------------- -% $Id: Enum.lhs,v 1.4 2001/07/04 11:29:26 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 #-} - +{-# LANGUAGE NoImplicitPrelude, BangPatterns, MagicHash #-} +{-# OPTIONS_HADDOCK hide #-} +----------------------------------------------------------------------------- +-- | +-- 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. +-- +----------------------------------------------------------------------------- + +-- #hide module GHC.Enum( - Bounded(..), Enum(..), - boundedEnumFrom, boundedEnumFromThen, + 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 () -- for dependencies -default () -- Double isn't available yet +import Data.Tuple () -- for dependencies +default () -- Double isn't available yet \end{code} %********************************************************* -%* * +%* * \subsection{Class declarations} -%* * +%* * %********************************************************* \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 a where - succ, pred :: a -> 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 + -- | 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] - - 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 ..] + + -- | 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 + 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] @@ -67,9 +122,9 @@ boundedEnumFromThen n1 n2 %********************************************************* -%* * +%* * \subsection{Tuples} -%* * +%* * %********************************************************* \begin{code} @@ -78,20 +133,21 @@ 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 = () | otherwise = error "Prelude.Enum.().toEnum: bad argument" fromEnum () = zeroInt - enumFrom () = [()] - enumFromThen () () = [()] - enumFromTo () () = [()] - enumFromThenTo () () () = [()] + enumFrom () = [()] + enumFromThen () () = let many = ():many in many + enumFromTo () () = [()] + enumFromThenTo () () () = let many = ():many in many \end{code} \begin{code} +-- Report requires instances up to 15 instance (Bounded a, Bounded b) => Bounded (a,b) where minBound = (minBound, minBound) maxBound = (maxBound, maxBound) @@ -103,13 +159,89 @@ instance (Bounded a, Bounded b, Bounded c) => Bounded (a,b,c) where 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} @@ -119,14 +251,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" + | n == oneInt = True + | otherwise = error "Prelude.Enum.Bool.toEnum: bad argument" fromEnum False = zeroInt fromEnum True = oneInt @@ -137,9 +269,9 @@ instance Enum Bool where \end{code} %********************************************************* -%* * +%* * \subsection{Type @Ordering@} -%* * +%* * %********************************************************* \begin{code} @@ -150,16 +282,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" + | n == oneInt = EQ + | n == twoInt = GT + toEnum _ = error "Prelude.Enum.Ordering.toEnum: bad argument" fromEnum LT = zeroInt fromEnum EQ = oneInt @@ -171,9 +303,9 @@ instance Enum Ordering where \end{code} %********************************************************* -%* * +%* * \subsection{Type @Char@} -%* * +%* * %********************************************************* \begin{code} @@ -184,17 +316,17 @@ instance Bounded Char where instance Enum Char where succ (C# c#) | not (ord# c# ==# 0x10FFFF#) = C# (chr# (ord# c# +# 1#)) - | otherwise = error ("Prelude.Enum.Char.succ: bad argument") + | 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") + | otherwise = error ("Prelude.Enum.Char.pred: bad argument") toEnum = chr fromEnum = ord {-# INLINE enumFrom #-} enumFrom (C# x) = eftChar (ord# x) 0x10FFFF# - -- Blarg: technically I guess enumFrom isn't strict! + -- Blarg: technically I guess enumFrom isn't strict! {-# INLINE enumFromTo #-} enumFromTo (C# x) (C# y) = eftChar (ord# x) (ord# y) @@ -205,97 +337,104 @@ 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 #-} -eftCharFB c n x y = go x - where - go x | x ># y = n - | otherwise = C# (chr# x) `c` go (x +# 1#) +{-# INLINE [0] eftCharFB #-} +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#) -eftCharList x y | x ># y = [] - | otherwise = C# (chr# x) : eftCharList (x +# 1#) y +eftChar :: Int# -> Int# -> String +eftChar x y | x ># y = [] + | otherwise = C# (chr# x) : eftChar (x +# 1#) y -- For enumFromThenTo we give up on inlining +{-# NOINLINE [0] efdCharFB #-} +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 + !delta = x2 -# x1 -efdCharList x1 x2 +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 + !delta = x2 -# x1 +{-# NOINLINE [0] efdtCharFB #-} +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 + !delta = x2 -# x1 -efdtCharList x1 x2 lim +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 + !delta = x2 -# x1 -go_up_char_fb c n x delta lim - = go_up x +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) + | otherwise = C# (chr# x) `c` go_up (x +# delta) -go_dn_char_fb c n x delta lim - = go_dn x +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) + | otherwise = C# (chr# x) `c` go_dn (x +# delta) -go_up_char_list x delta lim - = go_up x +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) + | otherwise = C# (chr# x) : go_up (x +# delta) -go_dn_char_list x delta lim - = go_dn x +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) + | 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 + (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 @@ -313,8 +452,9 @@ instance Enum Int where fromEnum x = x {-# INLINE enumFrom #-} - enumFrom (I# x) = eftInt x 2147483647# - -- Blarg: technically I guess enumFrom isn't strict! + enumFrom (I# x) = eftInt x maxInt# + where !(I# maxInt#) = maxInt + -- Blarg: technically I guess enumFrom isn't strict! {-# INLINE enumFromTo #-} enumFromTo (I# x) (I# y) = eftInt x y @@ -325,89 +465,122 @@ 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 x0 y | x0 ># y = [] + | otherwise = go x0 + 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 x0 y | x0 ># y = n + | otherwise = go x0 + where + go x = I# x `c` if x ==# y then n else go (x +# 1#) + -- Watch out for y=maxBound; hence ==, not > + -- Be very careful not to have more than one "c" + -- so that when eftInfFB is inlined we can inline + -- whatever is bound to "c" + + +----------------------------------------------------- +-- efdInt and efdtInt deal with [a,b..] and [a,b..c]. +-- The code is more complicated because of worries about Int overflow. -{-# INLINE eftIntFB #-} -eftIntFB c n x y | x ># y = n - | otherwise = go x - where - go x = I# x `c` if x ==# y then n else go (x +# 1#) - -- Watch out for y=maxBound; hence ==, not > - -- Be very careful not to have more than one "c" - -- so that when eftInfFB is inlined we can inline - -- whatver is bound to "c" +{-# RULES +"efdtInt" [~1] forall x1 x2 y. + efdtInt x1 x2 y = build (\ c n -> efdtIntFB c n x1 x2 y) +"efdtIntUpList" [1] efdtIntFB (:) [] = efdtInt + #-} -eftIntList x y | x ># y = [] - | otherwise = go x - where - go x = I# x : if x ==# y then [] else go (x +# 1#) +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 --- For enumFromThenTo we give up on inlining; so we don't worry --- about duplicating occurrences of "c" +{-# INLINE [0] efdtIntFB #-} +efdtIntFB :: (Int -> r -> r) -> r -> Int# -> Int# -> Int# -> r 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) + | x2 >=# x1 = efdtIntUpFB c n x1 x2 y + | otherwise = efdtIntDnFB c n x1 x2 y + +-- Requires x2 >= x1 +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 -- >= 0 + !y' = y -# delta -- x1 <= y' <= y; hence y' is representable + + -- Invariant: x <= y + -- Note that: z <= y' => z + delta won't overflow + -- so we are guaranteed not to overflow if/when we recurse + go_up x | x ># y' = [I# x] + | otherwise = I# x : go_up (x +# delta) + in I# x1 : go_up x2 + +-- Requires x2 >= x1 +efdtIntUpFB :: (Int -> r -> r) -> r -> Int# -> Int# -> Int# -> r +efdtIntUpFB c n x1 x2 y -- Be careful about overflow! + | y <# x2 = if y <# x1 then n else I# x1 `c` n + | otherwise = -- Common case: x1 <= x2 <= y + let !delta = x2 -# x1 -- >= 0 + !y' = y -# delta -- x1 <= y' <= y; hence y' is representable + + -- Invariant: x <= y + -- Note that: z <= y' => z + delta won't overflow + -- so we are guaranteed not to overflow if/when we recurse + go_up x | x ># y' = I# x `c` n + | otherwise = I# x `c` go_up (x +# delta) + in I# x1 `c` go_up x2 + +-- Requires x2 <= x1 +efdtIntDn :: Int# -> Int# -> Int# -> [Int] +efdtIntDn x1 x2 y -- Be careful about underflow! + | y ># x2 = if y ># x1 then [] else [I# x1] + | otherwise = -- Common case: x1 >= x2 >= y + let !delta = x2 -# x1 -- <= 0 + !y' = y -# delta -- y <= y' <= x1; hence y' is representable + + -- Invariant: x >= y + -- Note that: z >= y' => z + delta won't underflow + -- so we are guaranteed not to underflow if/when we recurse + go_dn x | x <# y' = [I# x] + | otherwise = I# x : go_dn (x +# delta) + in I# x1 : go_dn x2 + +-- Requires x2 <= x1 +efdtIntDnFB :: (Int -> r -> r) -> r -> Int# -> Int# -> Int# -> r +efdtIntDnFB c n x1 x2 y -- Be careful about underflow! + | y ># x2 = if y ># x1 then n else I# x1 `c` n + | otherwise = -- Common case: x1 >= x2 >= y + let !delta = x2 -# x1 -- <= 0 + !y' = y -# delta -- y <= y' <= x1; hence y' is representable + + -- Invariant: x >= y + -- Note that: z >= y' => z + delta won't underflow + -- so we are guaranteed not to underflow if/when we recurse + 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}