[project @ 2006-01-06 15:46:09 by simonpj]
[packages/old-time.git] / GHC / Enum.lhs
index 1391b1f..69c49e0 100644 (file)
@@ -1,25 +1,28 @@
-% -----------------------------------------------------------------------------
-% $Id: Enum.lhs,v 1.5 2001/07/31 13:06:51 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.
+-- 
+-----------------------------------------------------------------------------
+
+-- #hide
 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      ()              -- for dependencies
 default ()             -- Double isn't available yet
@@ -33,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
@@ -78,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 = ()
@@ -86,12 +140,13 @@ 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}
+-- Report requires instances up to 15
 instance (Bounded a, Bounded b) => Bounded (a,b) where
    minBound = (minBound, minBound)
    maxBound = (maxBound, maxBound)
@@ -103,6 +158,82 @@ 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}
 
 
@@ -119,14 +250,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
@@ -150,16 +281,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
@@ -205,53 +336,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
@@ -313,7 +441,8 @@ instance  Enum Int  where
     fromEnum x = x
 
     {-# INLINE enumFrom #-}
-    enumFrom (I# x) = case maxInt of I# y -> eftInt x y
+    enumFrom (I# x) = eftInt x maxInt#
+        where I# maxInt# = maxInt
        -- Blarg: technically I guess enumFrom isn't strict!
 
     {-# INLINE enumFromTo #-}
@@ -325,22 +454,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
@@ -350,64 +483,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# = 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
-
-efdIntList 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)
+-----------------------------------------------------
+-- 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}