[project @ 2004-07-26 17:22:41 by ross]
[ghc-base.git] / GHC / Base.lhs
index 968d703..d3dcd46 100644 (file)
@@ -1,11 +1,5 @@
-% -----------------------------------------------------------------------------
-% $Id: Base.lhs,v 1.2 2001/07/03 11:37:50 simonmar Exp $
-%
-% (c) The University of Glasgow, 1992-2000
-%
 \section[GHC.Base]{Module @GHC.Base@}
 
-
 The overall structure of the GHC Prelude is a bit tricky.
 
   a) We want to avoid "orphan modules", i.e. ones with instance
@@ -22,8 +16,6 @@ GHC.Prim              Has no implementation.  It defines built-in things, and
                The source file is GHC.Prim.hi-boot, which is just
                copied to make GHC.Prim.hi
 
-               Classes: CCallable, CReturnable
-
 GHC.Base       Classes: Eq, Ord, Functor, Monad
                Types:   list, (), Int, Bool, Ordering, Char, String
 
@@ -33,7 +25,7 @@ GHC.Show      Class: Show, plus instances for GHC.Base/GHC.Tup types
 
 GHC.Enum       Class: Enum,  plus instances for GHC.Base/GHC.Tup types
 
-GHC.Maybe      Type: Maybe, plus instances for GHC.Base classes
+Data.Maybe     Type: Maybe, plus instances for GHC.Base classes
 
 GHC.Num                Class: Num, plus instances for Int
                Type:  Integer, plus instances for all classes so far (Eq, Ord, Num, Show)
@@ -71,16 +63,28 @@ GHC.ByteArr Types: ByteArray, MutableByteArray
 
 Other Prelude modules are much easier with fewer complex dependencies.
 
-
 \begin{code}
 {-# OPTIONS -fno-implicit-prelude #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  GHC.Base
+-- 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)
+--
+-- Basic data types and classes.
+-- 
+-----------------------------------------------------------------------------
 
 #include "MachDeps.h"
 
 module GHC.Base
        (
        module GHC.Base,
-       module GHC.Prim,                -- Re-export GHC.Prim and GHC.Err, to avoid lots
+       module GHC.Prim,        -- Re-export GHC.Prim and GHC.Err, to avoid lots
        module GHC.Err          -- of people having to import it explicitly
   ) 
        where
@@ -143,20 +147,36 @@ unpackCStringUtf8# a = error "urk"
 %*********************************************************
 
 \begin{code}
+
+-- | The 'Eq' class defines equality ('==') and inequality ('/=').
+-- All the basic datatypes exported by the "Prelude" are instances of 'Eq',
+-- and 'Eq' may be derived for any datatype whose constituents are also
+-- instances of 'Eq'.
+--
+-- Minimal complete definition: either '==' or '/='.
+--
 class  Eq a  where
     (==), (/=)          :: a -> a -> Bool
 
     x /= y              = not (x == y)
     x == y              = not (x /= y)
 
+-- | The 'Ord' class is used for totally ordered datatypes.
+--
+-- Instances of 'Ord' can be derived for any user-defined
+-- datatype whose constituent types are in 'Ord'.  The declared order
+-- of the constructors in the data declaration determines the ordering
+-- in derived 'Ord' instances.  The 'Ordering' datatype allows a single
+-- comparison to determine the precise ordering of two objects.
+--
+-- Minimal complete definition: either 'compare' or '<='.
+-- Using 'compare' can be more efficient for complex types.
+--
 class  (Eq a) => Ord a  where
     compare             :: a -> a -> Ordering
     (<), (<=), (>), (>=) :: a -> a -> Bool
     max, min            :: a -> a -> a
 
-    -- An instance of Ord should define either 'compare' or '<='.
-    -- Using 'compare' can be more efficient for complex types.
-
     compare x y
        | x == y    = EQ
        | x <= y    = LT        -- NB: must be '<=' not '<' to validate the
@@ -182,12 +202,39 @@ class  (Eq a) => Ord a  where
 %*********************************************************
 
 \begin{code}
+{- | The 'Functor' class is used for types that can be mapped over.
+Instances of 'Functor' should satisfy the following laws:
+
+> fmap id  ==  id
+> fmap (f . g)  ==  fmap f . fmap g
+
+The instances of 'Functor' for lists, 'Maybe' and 'IO' defined in the "Prelude"
+satisfy these laws.
+-}
+
 class  Functor f  where
     fmap        :: (a -> b) -> f a -> f b
 
+{- | The 'Monad' class defines the basic operations over a /monad/.
+Instances of 'Monad' should satisfy the following laws:
+
+> return a >>= k  ==  k a
+> m >>= return  ==  m
+> m >>= (\x -> k x >>= h)  ==  (m >>= k) >>= h
+
+Instances of both 'Monad' and 'Functor' should additionally satisfy the law:
+
+> fmap f xs  ==  xs >>= return . f
+
+The instances of 'Monad' for lists, 'Maybe' and 'IO' defined in the "Prelude"
+satisfy these laws.
+-}
+
 class  Monad m  where
-    (>>=)       :: m a -> (a -> m b) -> m b
-    (>>)        :: m a -> m b -> m b
+    (>>=)       :: forall a b. m a -> (a -> m b) -> m b
+    (>>)        :: forall a b. m a -> m b -> m b
+       -- Explicit for-alls so that we know what order to
+       -- give type arguments when desugaring
     return      :: a -> m a
     fail       :: String -> m a
 
@@ -240,28 +287,35 @@ The rest of the prelude list functions are in GHC.List.
 ----------------------------------------------
   
 \begin{code}
+-- | 'foldr', applied to a binary operator, a starting value (typically
+-- the right-identity of the operator), and a list, reduces the list
+-- using the binary operator, from right to left:
+--
+-- > foldr f z [x1, x2, ..., xn] == x1 `f` (x2 `f` ... (xn `f` z)...)
+
 foldr            :: (a -> b -> b) -> b -> [a] -> b
 -- foldr _ z []     =  z
 -- foldr f z (x:xs) =  f x (foldr f z xs)
-{-# INLINE foldr #-}
+{-# INLINE [0] foldr #-}
+-- Inline only in the final stage, after the foldr/cons rule has had a chance
 foldr k z xs = go xs
             where
               go []     = z
               go (y:ys) = y `k` go ys
 
 build  :: forall a. (forall b. (a -> b -> b) -> b -> b) -> [a]
-{-# INLINE 2 build #-}
+{-# INLINE [1] build #-}
        -- The INLINE is important, even though build is tiny,
        -- because it prevents [] getting inlined in the version that
        -- appears in the interface file.  If [] *is* inlined, it
        -- won't match with [] appearing in rules in an importing module.
        --
-       -- The "2" says to inline in phase 2
+       -- The "1" says to inline in phase 1
 
 build g = g (:) []
 
 augment :: forall a. (forall b. (a->b->b) -> b -> b) -> [a] -> [a]
-{-# INLINE 2 augment #-}
+{-# INLINE [1] augment #-}
 augment g xs = g (:) xs
 
 {-# RULES
@@ -271,11 +325,21 @@ augment g xs = g (:) xs
 "foldr/augment" forall k z xs (g::forall b. (a->b->b) -> b -> b) . 
                foldr k z (augment g xs) = g k (foldr k z xs)
 
-"foldr/id"     foldr (:) [] = \x->x
-"foldr/app"            forall xs ys. foldr (:) ys xs = append xs ys
+"foldr/id"                       foldr (:) [] = \x->x
+"foldr/app"            [1] forall xs ys. foldr (:) ys xs = xs ++ ys
+       -- Only activate this from phase 1, because that's
+       -- when we disable the rule that expands (++) into foldr
+
+-- The foldr/cons rule looks nice, but it can give disastrously
+-- bloated code when commpiling
+--     array (a,b) [(1,2), (2,2), (3,2), ...very long list... ]
+-- i.e. when there are very very long literal lists
+-- So I've disabled it for now. We could have special cases
+-- for short lists, I suppose.
+-- "foldr/cons"        forall k z x xs. foldr k z (x:xs) = k x (foldr k z xs)
 
-"foldr/cons"   forall k z x xs. foldr k z (x:xs) = k x (foldr k z xs)
-"foldr/nil"    forall k z.      foldr k z []     = z 
+"foldr/single" forall k z x. foldr k z [x] = k x z
+"foldr/nil"    forall k z.   foldr k z []  = z 
 
 "augment/build" forall (g::forall b. (a->b->b) -> b -> b)
                       (h::forall b. (a->b->b) -> b -> b) .
@@ -294,21 +358,43 @@ augment g xs = g (:) xs
 ----------------------------------------------
 
 \begin{code}
+-- | 'map' @f xs@ is the list obtained by applying @f@ to each element
+-- of @xs@, i.e.,
+--
+-- > map f [x1, x2, ..., xn] == [f x1, f x2, ..., f xn]
+-- > map f [x1, x2, ...] == [f x1, f x2, ...]
+
 map :: (a -> b) -> [a] -> [b]
-map = mapList
+map _ []     = []
+map f (x:xs) = f x : map f xs
 
 -- Note eta expanded
 mapFB ::  (elt -> lst -> lst) -> (a -> elt) -> a -> lst -> lst
+{-# INLINE [0] mapFB #-}
 mapFB c f x ys = c (f x) ys
 
-mapList :: (a -> b) -> [a] -> [b]
-mapList _ []     = []
-mapList f (x:xs) = f x : mapList f xs
+-- The rules for map work like this.
+-- 
+-- Up to (but not including) phase 1, we use the "map" rule to
+-- rewrite all saturated applications of map with its build/fold 
+-- form, hoping for fusion to happen.
+-- In phase 1 and 0, we switch off that rule, inline build, and
+-- switch on the "mapList" rule, which rewrites the foldr/mapFB
+-- thing back into plain map.  
+--
+-- It's important that these two rules aren't both active at once 
+-- (along with build's unfolding) else we'd get an infinite loop 
+-- in the rules.  Hence the activation control below.
+--
+-- The "mapFB" rule optimises compositions of map.
+--
+-- This same pattern is followed by many other functions: 
+-- e.g. append, filter, iterate, repeat, etc.
 
 {-# RULES
-"map"      forall f xs.        map f xs                = build (\c n -> foldr (mapFB c f) n xs)
+"map"      [~1] forall f xs.   map f xs                = build (\c n -> foldr (mapFB c f) n xs)
+"mapList"   [1]  forall f.     foldr (mapFB (:) f) []  = map f
 "mapFB"            forall c f g.       mapFB (mapFB c f) g     = mapFB c (f.g) 
-"mapList"   forall f.          foldr (mapFB (:) f) []  = mapList f
   #-}
 \end{code}
 
@@ -317,16 +403,21 @@ mapList f (x:xs) = f x : mapList f xs
 --             append  
 ----------------------------------------------
 \begin{code}
+-- | Append two lists, i.e.,
+--
+-- > [x1, ..., xm] ++ [y1, ..., yn] == [x1, ..., xm, y1, ..., yn]
+-- > [x1, ..., xm] ++ [y1, ...] == [x1, ..., xm, y1, ...]
+--
+-- If the first list is not finite, the result is the first list.
+
 (++) :: [a] -> [a] -> [a]
-(++) = append
+(++) []     ys = ys
+(++) (x:xs) ys = x : xs ++ ys
 
 {-# RULES
-"++"   forall xs ys. xs ++ ys = augment (\c n -> foldr c n xs) ys
+"++"   [~1] forall xs ys. xs ++ ys = augment (\c n -> foldr c n xs) ys
   #-}
 
-append :: [a] -> [a] -> [a]
-append []     ys = ys
-append (x:xs) ys = x : append xs ys
 \end{code}
 
 
@@ -337,21 +428,35 @@ append (x:xs) ys = x : append xs ys
 %*********************************************************
 
 \begin{code}
+-- |The 'Bool' type is an enumeration.  It is defined with 'False'
+-- first so that the corresponding 'Prelude.Enum' instance will give
+-- 'Prelude.fromEnum' 'False' the value zero, and
+-- 'Prelude.fromEnum' 'True' the value 1.
 data  Bool  =  False | True  deriving (Eq, Ord)
        -- Read in GHC.Read, Show in GHC.Show
 
 -- Boolean functions
 
-(&&), (||)             :: Bool -> Bool -> Bool
+-- | Boolean \"and\"
+(&&)                   :: Bool -> Bool -> Bool
 True  && x             =  x
 False && _             =  False
+
+-- | Boolean \"or\"
+(||)                   :: Bool -> Bool -> Bool
 True  || _             =  True
 False || x             =  x
 
+-- | Boolean \"not\"
 not                    :: Bool -> Bool
 not True               =  False
 not False              =  True
 
+-- |'otherwise' is defined as the value 'True'.  It helps to make
+-- guards more readable.  eg.
+--
+-- >  f x | x < 0     = ...
+-- >      | otherwise = ...
 otherwise              :: Bool
 otherwise              =  True
 \end{code}
@@ -371,6 +476,8 @@ need ().  (We could arrange suck in () only if -fglasgow-exts, but putting
 it here seems more direct.)
 
 \begin{code}
+-- | The unit datatype @()@ has one non-undefined member, the nullary
+-- constructor @()@.
 data () = ()
 
 instance Eq () where
@@ -395,6 +502,9 @@ instance Ord () where
 %*********************************************************
 
 \begin{code}
+-- | Represents an ordering relationship between two values: less
+-- than, equal to, or greater than.  An 'Ordering' is returned by
+-- 'compare'.
 data Ordering = LT | EQ | GT deriving (Eq, Ord)
        -- Read in GHC.Read, Show in GHC.Show
 \end{code}
@@ -407,8 +517,22 @@ data Ordering = LT | EQ | GT deriving (Eq, Ord)
 %*********************************************************
 
 \begin{code}
+-- | A 'String' is a list of characters.  String constants in Haskell are values
+-- of type 'String'.
+--
 type String = [Char]
 
+{-| The character type 'Char' is an enumeration whose values represent
+Unicode (or equivalently ISO 10646) characters.
+This set extends the ISO 8859-1 (Latin-1) character set
+(the first 256 charachers), which is itself an extension of the ASCII
+character set (the first 128 characters).
+A character literal in Haskell has type 'Char'.
+
+To convert a 'Char' to or from the corresponding 'Int' value defined
+by Unicode, use 'Prelude.toEnum' and 'Prelude.fromEnum' from the
+'Prelude.Enum' class respectively (or equivalently 'ord' and 'chr').
+-}
 data Char = C# Char#
 
 -- We don't use deriving for Eq and Ord, because for Ord the derived
@@ -434,6 +558,7 @@ instance Ord Char where
 "x# `ltChar#` x#" forall x#. x# `ltChar#` x# = False
   #-}
 
+-- | The 'Prelude.toEnum' method restricted to the type 'Data.Char.Char'.
 chr :: Int -> Char
 chr (I# i#) | int2Word# i# `leWord#` int2Word# 0x10FFFF# = C# (chr# i#)
             | otherwise                                  = error "Prelude.chr: bad argument"
@@ -441,6 +566,7 @@ chr (I# i#) | int2Word# i# `leWord#` int2Word# 0x10FFFF# = C# (chr# i#)
 unsafeChr :: Int -> Char
 unsafeChr (I# i#) = C# (chr# i#)
 
+-- | The 'Prelude.fromEnum' method restricted to the type 'Data.Char.Char'.
 ord :: Char -> Int
 ord (C# c#) = I# (ord# c#)
 \end{code}
@@ -449,9 +575,14 @@ String equality is used when desugaring pattern-matches against strings.
 
 \begin{code}
 eqString :: String -> String -> Bool
-eqString = (==)
+eqString []       []      = True
+eqString (c1:cs1) (c2:cs2) = c1 == c2 && cs1 `eqString` cs2
+eqString cs1      cs2     = False
+
+{-# RULES "eqString" (==) = eqString #-}
 \end{code}
 
+
 %*********************************************************
 %*                                                     *
 \subsection{Type @Int@}
@@ -460,15 +591,23 @@ eqString = (==)
 
 \begin{code}
 data Int = I# Int#
+-- ^A fixed-precision integer type with at least the range @[-2^29 .. 2^29-1]@.
+-- The exact range for a given implementation can be determined by using
+-- 'Prelude.minBound' and 'Prelude.maxBound' from the 'Prelude.Bounded' class.
 
 zeroInt, oneInt, twoInt, maxInt, minInt :: Int
 zeroInt = I# 0#
 oneInt  = I# 1#
 twoInt  = I# 2#
-#if WORD_SIZE_IN_BYTES == 4
+
+{- Seems clumsy. Should perhaps put minInt and MaxInt directly into MachDeps.h -}
+#if WORD_SIZE_IN_BITS == 31
+minInt  = I# (-0x40000000#)
+maxInt  = I# 0x3FFFFFFF#
+#elif WORD_SIZE_IN_BITS == 32
 minInt  = I# (-0x80000000#)
 maxInt  = I# 0x7FFFFFFF#
-#else
+#else 
 minInt  = I# (-0x8000000000000000#)
 maxInt  = I# 0x7FFFFFFFFFFFFFFF#
 #endif
@@ -502,36 +641,60 @@ compareInt# x# y#
 %*********************************************************
 
 \begin{code}
--- identity function
+-- | Identity function.
 id                     :: a -> a
 id x                   =  x
 
--- constant function
+-- lazy function; this is just the same as id, but its unfolding
+-- and strictness are over-ridden by the definition in MkId.lhs
+-- That way, it does not get inlined, and the strictness analyser
+-- sees it as lazy.  Then the worker/wrapper phase inlines it.
+-- Result: happiness
+lazy :: a -> a
+lazy x = x
+
+-- | Assertion function.  This simply ignores its boolean argument.
+-- The compiler may rewrite it to @('assertError' line)@.
+
+--     SLPJ: in 5.04 etc 'assert' is in GHC.Prim,
+--     but from Template Haskell onwards it's simply
+--     defined here in Base.lhs
+assert :: Bool -> a -> a
+assert pred r = r
+-- | Constant function.
 const                  :: a -> b -> a
 const x _              =  x
 
--- function composition
+-- | Function composition.
 {-# INLINE (.) #-}
 (.)      :: (b -> c) -> (a -> b) -> a -> c
 (.) f g        x = f (g x)
 
--- flip f  takes its (first) two arguments in the reverse order of f.
+-- | @'flip' f@ takes its (first) two arguments in the reverse order of @f@.
 flip                   :: (a -> b -> c) -> b -> a -> c
 flip f x y             =  f y x
 
--- right-associating infix application operator (useful in continuation-
--- passing style)
+-- | Application operator.  This operator is redundant, since ordinary
+-- application @(f x)@ means the same as @(f '$' x)@. However, '$' has
+-- low, right-associative binding precedence, so it sometimes allows
+-- parentheses to be omitted; for example:
+--
+-- >     f $ g $ h x  =  f (g (h x))
+--
+-- It is also useful in higher-order situations, such as @'map' ('$' 0) xs@,
+-- or @'Data.List.zipWith' ('$') fs xs@.
 {-# INLINE ($) #-}
 ($)                    :: (a -> b) -> a -> b
 f $ x                  =  f x
 
--- until p f  yields the result of applying f until p holds.
+-- | @'until' p f@ yields the result of applying @f@ until @p@ holds.
 until                  :: (a -> Bool) -> (a -> a) -> a -> a
 until p f x | p x      =  x
            | otherwise =  until p f (f x)
 
--- asTypeOf is a type-restricted version of const.  It is usually used
--- as an infix operator, and its typing forces its first argument
+-- | 'asTypeOf' is a type-restricted version of 'const'.  It is usually
+-- used as an infix operator, and its typing forces its first argument
 -- (which is usually overloaded) to have the same type as the second.
 asTypeOf               :: a -> a -> a
 asTypeOf               =  const
@@ -539,36 +702,42 @@ asTypeOf          =  const
 
 %*********************************************************
 %*                                                     *
-\subsection{CCallable instances}
+\subsection{Generics}
 %*                                                     *
 %*********************************************************
 
-Defined here to avoid orphans
-
 \begin{code}
-instance CCallable Char
-instance CReturnable Char
-
-instance CCallable   Int
-instance CReturnable Int
-
-instance CReturnable () -- Why, exactly?
+data Unit = Unit
+#ifndef __HADDOCK__
+data (:+:) a b = Inl a | Inr b
+data (:*:) a b = a :*: b
+#endif
 \end{code}
 
-
 %*********************************************************
 %*                                                     *
-\subsection{Generics}
+\subsection{@getTag@}
 %*                                                     *
 %*********************************************************
 
+Returns the 'tag' of a constructor application; this function is used
+by the deriving code for Eq, Ord and Enum.
+
+The primitive dataToTag# requires an evaluated constructor application
+as its argument, so we provide getTag as a wrapper that performs the
+evaluation before calling dataToTag#.  We could have dataToTag#
+evaluate its argument, but we prefer to do it this way because (a)
+dataToTag# can be an inline primop if it doesn't need to do any
+evaluation, and (b) we want to expose the evaluation to the
+simplifier, because it might be possible to eliminate the evaluation
+in the case when the argument is already known to be evaluated.
+
 \begin{code}
-data Unit = Unit
-data a :+: b = Inl a | Inr b
-data a :*: b = a :*: b
+{-# INLINE getTag #-}
+getTag :: a -> Int#
+getTag x = x `seq` dataToTag# x
 \end{code}
 
-
 %*********************************************************
 %*                                                     *
 \subsection{Numeric primops}
@@ -576,11 +745,18 @@ data a :*: b = a :*: b
 %*********************************************************
 
 \begin{code}
-divInt#, modInt# :: Int# -> Int# -> Int#
+divInt# :: Int# -> Int# -> Int#
 x# `divInt#` y#
-    | (x# ># 0#) && (y# <# 0#) = ((x# -# y#) -# 1#) `quotInt#` y#
-    | (x# <# 0#) && (y# ># 0#) = ((x# -# y#) +# 1#) `quotInt#` y#
+       -- Be careful NOT to overflow if we do any additional arithmetic
+       -- on the arguments...  the following  previous version of this
+       -- code has problems with overflow:
+--    | (x# ># 0#) && (y# <# 0#) = ((x# -# y#) -# 1#) `quotInt#` y#
+--    | (x# <# 0#) && (y# ># 0#) = ((x# -# y#) +# 1#) `quotInt#` y#
+    | (x# ># 0#) && (y# <# 0#) = ((x# -# 1#) `quotInt#` y#) -# 1#
+    | (x# <# 0#) && (y# ># 0#) = ((x# +# 1#) `quotInt#` y#) -# 1#
     | otherwise                = x# `quotInt#` y#
+
+modInt# :: Int# -> Int# -> Int#
 x# `modInt#` y#
     | (x# ># 0#) && (y# <# 0#) ||
       (x# <# 0#) && (y# ># 0#)    = if r# /=# 0# then r# +# y# else 0#
@@ -657,10 +833,61 @@ gtInt, geInt, eqInt, neInt, ltInt, leInt :: Int -> Int -> Bool
 "x# <=# x#" forall x#. x# <=# x# = True
   #-}
 
-#if WORD_SIZE_IN_BYTES == 4
 {-# RULES
-"intToInt32#"   forall x#. intToInt32#   x# = x#
-"wordToWord32#" forall x#. wordToWord32# x# = x#
+"plusFloat x 0.0"   forall x#. plusFloat#  x#   0.0# = x#
+"plusFloat 0.0 x"   forall x#. plusFloat#  0.0# x#   = x#
+"minusFloat x 0.0"  forall x#. minusFloat# x#   0.0# = x#
+"minusFloat x x"    forall x#. minusFloat# x#   x#   = 0.0#
+"timesFloat x 0.0"  forall x#. timesFloat# x#   0.0# = 0.0#
+"timesFloat0.0 x"   forall x#. timesFloat# 0.0# x#   = 0.0#
+"timesFloat x 1.0"  forall x#. timesFloat# x#   1.0# = x#
+"timesFloat 1.0 x"  forall x#. timesFloat# 1.0# x#   = x#
+"divideFloat x 1.0" forall x#. divideFloat# x#  1.0# = x#
+  #-}
+
+{-# RULES
+"plusDouble x 0.0"   forall x#. (+##) x#    0.0## = x#
+"plusDouble 0.0 x"   forall x#. (+##) 0.0## x#    = x#
+"minusDouble x 0.0"  forall x#. (-##) x#    0.0## = x#
+"minusDouble x x"    forall x#. (-##) x#    x#    = 0.0##
+"timesDouble x 0.0"  forall x#. (*##) x#    0.0## = 0.0##
+"timesDouble 0.0 x"  forall x#. (*##) 0.0## x#    = 0.0##
+"timesDouble x 1.0"  forall x#. (*##) x#    1.0## = x#
+"timesDouble 1.0 x"  forall x#. (*##) 1.0## x#    = x#
+"divideDouble x 1.0" forall x#. (/##) x#    1.0## = x#
+  #-}
+
+-- Wrappers for the shift operations.  The uncheckedShift# family are
+-- undefined when the amount being shifted by is greater than the size
+-- in bits of Int#, so these wrappers perform a check and return
+-- either zero or -1 appropriately.
+--
+-- Note that these wrappers still produce undefined results when the
+-- second argument (the shift amount) is negative.
+
+shiftL#, shiftRL# :: Word# -> Int# -> Word#
+
+a `shiftL#` b   | b >=# WORD_SIZE_IN_BITS# = int2Word# 0#
+               | otherwise                = a `uncheckedShiftL#` b
+
+a `shiftRL#` b  | b >=# WORD_SIZE_IN_BITS# = int2Word# 0#
+               | otherwise                = a `uncheckedShiftRL#` b
+
+iShiftL#, iShiftRA#, iShiftRL# :: Int# -> Int# -> Int#
+
+a `iShiftL#` b  | b >=# WORD_SIZE_IN_BITS# = 0#
+               | otherwise                = a `uncheckedIShiftL#` b
+
+a `iShiftRA#` b | b >=# WORD_SIZE_IN_BITS# = if a <# 0# then (-1#) else 0#
+               | otherwise                = a `uncheckedIShiftRA#` b
+
+a `iShiftRL#` b | b >=# WORD_SIZE_IN_BITS# = 0#
+               | otherwise                = a `uncheckedIShiftRL#` b
+
+#if WORD_SIZE_IN_BITS == 32
+{-# RULES
+"narrow32Int#"  forall x#. narrow32Int#   x# = x#
+"narrow32Word#" forall x#. narrow32Word#   x# = x#
    #-}
 #endif
 
@@ -682,10 +909,8 @@ unpacking the strings of error messages.
 
 \begin{code}
 unpackCString# :: Addr# -> [Char]
-unpackCString# a = unpackCStringList# a
-
-unpackCStringList# :: Addr# -> [Char]
-unpackCStringList# addr 
+{-# NOINLINE [1] unpackCString# #-}
+unpackCString# addr 
   = unpack 0#
   where
     unpack nh
@@ -705,6 +930,9 @@ unpackAppendCString# addr rest
        ch = indexCharOffAddr# addr nh
 
 unpackFoldrCString# :: Addr# -> (Char  -> a -> a) -> a -> a 
+{-# NOINLINE [0] unpackFoldrCString# #-}
+-- Don't inline till right at the end;
+-- usually the unpack-list rule turns it into unpackCStringList
 unpackFoldrCString# addr f z 
   = unpack 0#
   where
@@ -722,19 +950,19 @@ unpackCStringUtf8# addr
       | ch `eqChar#` '\0'#   = []
       | ch `leChar#` '\x7F'# = C# ch : unpack (nh +# 1#)
       | ch `leChar#` '\xDF'# =
-          C# (chr# ((ord# ch                                  -# 0xC0#) `iShiftL#`  6# +#
-                    (ord# (indexCharOffAddr# addr (nh +# 1#)) -# 0x80#))) :
+          C# (chr# (((ord# ch                                  -# 0xC0#) `uncheckedIShiftL#`  6#) +#
+                     (ord# (indexCharOffAddr# addr (nh +# 1#)) -# 0x80#))) :
           unpack (nh +# 2#)
       | ch `leChar#` '\xEF'# =
-          C# (chr# ((ord# ch                                  -# 0xE0#) `iShiftL#` 12# +#
-                    (ord# (indexCharOffAddr# addr (nh +# 1#)) -# 0x80#) `iShiftL#`  6# +#
-                    (ord# (indexCharOffAddr# addr (nh +# 2#)) -# 0x80#))) :
+          C# (chr# (((ord# ch                                  -# 0xE0#) `uncheckedIShiftL#` 12#) +#
+                    ((ord# (indexCharOffAddr# addr (nh +# 1#)) -# 0x80#) `uncheckedIShiftL#`  6#) +#
+                     (ord# (indexCharOffAddr# addr (nh +# 2#)) -# 0x80#))) :
           unpack (nh +# 3#)
       | otherwise            =
-          C# (chr# ((ord# ch                                  -# 0xF0#) `iShiftL#` 18# +#
-                    (ord# (indexCharOffAddr# addr (nh +# 1#)) -# 0x80#) `iShiftL#` 12# +#
-                    (ord# (indexCharOffAddr# addr (nh +# 2#)) -# 0x80#) `iShiftL#`  6# +#
-                    (ord# (indexCharOffAddr# addr (nh +# 3#)) -# 0x80#))) :
+          C# (chr# (((ord# ch                                  -# 0xF0#) `uncheckedIShiftL#` 18#) +#
+                    ((ord# (indexCharOffAddr# addr (nh +# 1#)) -# 0x80#) `uncheckedIShiftL#` 12#) +#
+                    ((ord# (indexCharOffAddr# addr (nh +# 2#)) -# 0x80#) `uncheckedIShiftL#`  6#) +#
+                     (ord# (indexCharOffAddr# addr (nh +# 3#)) -# 0x80#))) :
           unpack (nh +# 4#)
       where
        ch = indexCharOffAddr# addr nh
@@ -750,12 +978,21 @@ unpackNBytes#  addr len# = unpack [] (len# -# 1#)
            ch -> unpack (C# ch : acc) (i# -# 1#)
 
 {-# RULES
-"unpack"        forall a   . unpackCString# a             = build (unpackFoldrCString# a)
-"unpack-list"    forall a   . unpackFoldrCString# a (:) [] = unpackCStringList# a
-"unpack-append"  forall a n . unpackFoldrCString# a (:) n  = unpackAppendCString# a n
+"unpack"       [~1] forall a   . unpackCString# a                 = build (unpackFoldrCString# a)
+"unpack-list"  [1]  forall a   . unpackFoldrCString# a (:) [] = unpackCString# a
+"unpack-append"     forall a n . unpackFoldrCString# a (:) n  = unpackAppendCString# a n
 
--- There's a built-in rule (in GHC.Rules.lhs) for
+-- There's a built-in rule (in PrelRules.lhs) for
 --     unpackFoldr "foo" c (unpackFoldr "baz" c n)  =  unpackFoldr "foobaz" c n
 
   #-}
 \end{code}
+
+#ifdef __HADDOCK__
+\begin{code}
+-- | A special argument for the 'Control.Monad.ST.ST' type constructor,
+-- indexing a state embedded in the 'Prelude.IO' monad by
+-- 'Control.Monad.ST.stToIO'.
+data RealWorld
+\end{code}
+#endif