X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=GHC%2FEnum.lhs;h=ac6e9a916a7d7967111d8776249dbee505c0ed77;hb=41e8fba828acbae1751628af50849f5352b27873;hp=0f8df4db1c225c55cc0408d0fc562f27c3fedb50;hpb=c39743fe545c5e3b0af5e8e8ba5208d30f463e22;p=ghc-base.git

diff --git a/GHC/Enum.lhs b/GHC/Enum.lhs
index 0f8df4d..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}
@@ -55,7 +56,9 @@ class  Bounded a  where
 -- 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:
@@ -70,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'.
@@ -89,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]
 
@@ -119,9 +122,9 @@ boundedEnumFromThen n1 n2
 
 
 %*********************************************************
-%*							*
+%*                                                      *
 \subsection{Tuples}
-%*							*
+%*                                                      *
 %*********************************************************
 
 \begin{code}
@@ -130,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)
@@ -155,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}
@@ -171,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
@@ -189,9 +269,9 @@ instance Enum Bool where
 \end{code}
 
 %*********************************************************
-%*							*
+%*                                                      *
 \subsection{Type @Ordering@}
-%*							*
+%*                                                      *
 %*********************************************************
 
 \begin{code}
@@ -202,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
@@ -223,9 +303,9 @@ instance Enum Ordering where
 \end{code}
 
 %*********************************************************
-%*							*
+%*                                                      *
 \subsection{Type @Char@}
-%*							*
+%*                                                      *
 %*********************************************************
 
 \begin{code}
@@ -236,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)
@@ -258,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
@@ -363,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
@@ -375,87 +465,122 @@ 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)
 
-"eftIntList"	[1] eftIntFB  (:) [] = eftInt
-"efdIntList"	[1] efdIntFB  (:) [] = efdInt
-"efdtIntList"	[1] efdtIntFB (:) [] = efdtInt
+-----------------------------------------------------
+-- 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
  #-}
 
+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 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"
-
-eftInt 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"
-{-# 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
-
-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
+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 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
+-----------------------------------------------------
+-- efdInt and efdtInt deal with [a,b..] and [a,b..c].
+-- The code is more complicated because of worries about Int 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)
+{-# RULES
+"efdtInt"       [~1] forall x1 x2 y.
+                     efdtInt x1 x2 y = build (\ c n -> efdtIntFB c n x1 x2 y)
+"efdtIntUpList" [1]  efdtIntFB (:) [] = efdtInt
+ #-}
 
-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)
+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
 
-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)
+efdtInt :: Int# -> Int# -> Int# -> [Int]
+-- [x1,x2..y]
+efdtInt x1 x2 y
+ | x2 >=# x1 = efdtIntUp x1 x2 y
+ | otherwise = efdtIntDn x1 x2 y
 
-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)
+{-# 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 -- >= 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}