X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=GHC%2FEnum.lhs;h=ac6e9a916a7d7967111d8776249dbee505c0ed77;hb=7a97ec4b12e1fbec5505f82032cf4dc435b5a60c;hp=a0be9e1713bfc532e139cde5936bc2f280fc02f6;hpb=e5330268c78f1697c4f32c1e642e85c101b5112c;p=ghc-base.git diff --git a/GHC/Enum.lhs b/GHC/Enum.lhs index a0be9e1..ac6e9a9 100644 --- a/GHC/Enum.lhs +++ b/GHC/Enum.lhs @@ -1,5 +1,6 @@ \begin{code} -{-# OPTIONS -fno-implicit-prelude #-} +{-# LANGUAGE NoImplicitPrelude, BangPatterns, MagicHash #-} +{-# OPTIONS_HADDOCK hide #-} ----------------------------------------------------------------------------- -- | -- Module : GHC.Enum @@ -14,25 +15,25 @@ -- ----------------------------------------------------------------------------- +-- #hide module GHC.Enum( - Bounded(..), Enum(..), - boundedEnumFrom, boundedEnumFromThen, + Bounded(..), Enum(..), + boundedEnumFrom, boundedEnumFromThen, - -- Instances for Bounded and Enum: (), 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} @@ -72,17 +73,17 @@ class Bounded a where -- * '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 +-- > 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 +class Enum a where -- | the successor of a value. For numeric types, 'succ' adds 1. - succ :: a -> a + succ :: a -> a -- | the predecessor of a value. For numeric types, 'pred' subtracts 1. - pred :: a -> a + pred :: a -> a -- | Convert from an 'Int'. toEnum :: Int -> a -- | Convert to an 'Int'. @@ -91,18 +92,18 @@ class Enum a where fromEnum :: a -> Int -- | Used in Haskell's translation of @[n..]@. - enumFrom :: a -> [a] + enumFrom :: a -> [a] -- | Used in Haskell's translation of @[n,n'..]@. - enumFromThen :: a -> a -> [a] + enumFromThen :: a -> a -> [a] -- | Used in Haskell's translation of @[n..m]@. - enumFromTo :: a -> a -> [a] + enumFromTo :: a -> a -> [a] -- | Used in Haskell's translation of @[n,n'..m]@. - enumFromThenTo :: a -> 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 ..] + 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] @@ -121,9 +122,9 @@ boundedEnumFromThen n1 n2 %********************************************************* -%* * +%* * \subsection{Tuples} -%* * +%* * %********************************************************* \begin{code} @@ -139,13 +140,14 @@ instance Enum () where | 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) @@ -157,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} @@ -179,8 +257,8 @@ instance Enum Bool where 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" + | n == oneInt = True + | otherwise = error "Prelude.Enum.Bool.toEnum: bad argument" fromEnum False = zeroInt fromEnum True = oneInt @@ -191,9 +269,9 @@ instance Enum Bool where \end{code} %********************************************************* -%* * +%* * \subsection{Type @Ordering@} -%* * +%* * %********************************************************* \begin{code} @@ -211,8 +289,8 @@ instance Enum Ordering where pred LT = error "Prelude.Enum.Ordering.pred: bad argument" toEnum n | n == zeroInt = LT - | n == oneInt = EQ - | n == twoInt = GT + | n == oneInt = EQ + | n == twoInt = GT toEnum _ = error "Prelude.Enum.Ordering.toEnum: bad argument" fromEnum LT = zeroInt @@ -225,9 +303,9 @@ instance Enum Ordering where \end{code} %********************************************************* -%* * +%* * \subsection{Type @Char@} -%* * +%* * %********************************************************* \begin{code} @@ -238,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) @@ -260,93 +338,103 @@ instance Enum Char where enumFromThenTo (C# x1) (C# x2) (C# y) = efdtChar (ord# x1) (ord# x2) (ord# y) {-# RULES -"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 +"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 [0] eftCharFB #-} -eftCharFB c n x y = go x - where - go x | x ># y = n - | otherwise = C# (chr# x) `c` go (x +# 1#) +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 x y | x ># y = [] - | otherwise = C# (chr# x) : eftChar (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 +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 +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 @@ -365,8 +453,8 @@ instance Enum Int where {-# INLINE enumFrom #-} enumFrom (I# x) = eftInt x maxInt# - where I# maxInt# = maxInt - -- Blarg: technically I guess enumFrom isn't strict! + where !(I# maxInt#) = maxInt + -- Blarg: technically I guess enumFrom isn't strict! {-# INLINE enumFromTo #-} enumFromTo (I# x) (I# y) = eftInt x y @@ -384,76 +472,115 @@ instance Enum Int where -- 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 +"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#) +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 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" +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], 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 and efdtInt deal with [a,b..] and [a,b..c]. +-- The code is more complicated because of worries about Int overflow. + +{-# RULES +"efdtInt" [~1] forall x1 x2 y. + efdtInt x1 x2 y = build (\ c n -> efdtIntFB c n x1 x2 y) +"efdtIntUpList" [1] efdtIntFB (:) [] = efdtInt + #-} 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 + | 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 + | x2 >=# x1 = efdtIntUp x1 x2 y + | otherwise = efdtIntDn x1 x2 y + +{-# INLINE [0] efdtIntFB #-} +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 +-- 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 - 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 - +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 -- 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 +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}