Remove redundant imports, now that NoImplicitPrelude does not imply RebindableSyntax
[ghc-base.git] / GHC / Base.lhs
index 3f811fa..027191a 100644 (file)
@@ -63,6 +63,8 @@ Other Prelude modules are much easier with fewer complex dependencies.
 
 \begin{code}
 {-# OPTIONS_GHC -XNoImplicitPrelude #-}
 
 \begin{code}
 {-# OPTIONS_GHC -XNoImplicitPrelude #-}
+-- -fno-warn-orphans is needed for things like:
+-- Orphan rule: "x# -# x#" ALWAYS forall x# :: Int# -# x# x# = 0
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 {-# OPTIONS_HADDOCK hide #-}
 -----------------------------------------------------------------------------
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 {-# OPTIONS_HADDOCK hide #-}
 -----------------------------------------------------------------------------
@@ -101,10 +103,19 @@ import GHC.Classes
 import GHC.Generics
 import GHC.Ordering
 import GHC.Prim
 import GHC.Generics
 import GHC.Ordering
 import GHC.Prim
+import {-# SOURCE #-} GHC.Show
 import {-# SOURCE #-} GHC.Err
 import {-# SOURCE #-} GHC.Err
+import {-# SOURCE #-} GHC.IO (failIO)
+
+-- These two are not strictly speaking required by this module, but they are
+-- implicit dependencies whenever () or tuples are mentioned, so adding them
+-- as imports here helps to get the dependencies right in the new build system.
+import GHC.Tuple ()
+import GHC.Unit ()
 
 infixr 9  .
 infixr 5  ++
 
 infixr 9  .
 infixr 5  ++
+infixl 4  <$
 infixl 1  >>, >>=
 infixr 0  $
 
 infixl 1  >>, >>=
 infixr 0  $
 
@@ -162,12 +173,18 @@ Instances of 'Functor' should satisfy the following laws:
 > fmap (f . g)  ==  fmap f . fmap g
 
 The instances of 'Functor' for lists, 'Data.Maybe.Maybe' and 'System.IO.IO'
 > fmap (f . g)  ==  fmap f . fmap g
 
 The instances of 'Functor' for lists, 'Data.Maybe.Maybe' and 'System.IO.IO'
-defined in the "Prelude" satisfy these laws.
+satisfy these laws.
 -}
 
 class  Functor f  where
     fmap        :: (a -> b) -> f a -> f b
 
 -}
 
 class  Functor f  where
     fmap        :: (a -> b) -> f a -> f b
 
+    -- | Replace all locations in the input with the same value.
+    -- The default definition is @'fmap' . 'const'@, but this may be
+    -- overridden with a more efficient version.
+    (<$)        :: a -> f b -> f a
+    (<$)        =  fmap . const
+
 {- | The 'Monad' class defines the basic operations over a /monad/,
 a concept from a branch of mathematics known as /category theory/.
 From the perspective of a Haskell programmer, however, it is best to
 {- | The 'Monad' class defines the basic operations over a /monad/,
 a concept from a branch of mathematics known as /category theory/.
 From the perspective of a Haskell programmer, however, it is best to
@@ -209,6 +226,7 @@ class  Monad m  where
     -- failure in a @do@ expression.
     fail        :: String -> m a
 
     -- failure in a @do@ expression.
     fail        :: String -> m a
 
+    {-# INLINE (>>) #-}
     m >> k      = m >>= \_ -> k
     fail s      = error s
 \end{code}
     m >> k      = m >>= \_ -> k
     fail s      = error s
 \end{code}
@@ -221,24 +239,6 @@ class  Monad m  where
 %*********************************************************
 
 \begin{code}
 %*********************************************************
 
 \begin{code}
--- do explicitly: deriving (Eq, Ord)
--- to avoid weird names like con2tag_[]#
-
-instance (Eq a) => Eq [a] where
-    {-# SPECIALISE instance Eq [Char] #-}
-    []     == []     = True
-    (x:xs) == (y:ys) = x == y && xs == ys
-    _xs    == _ys    = False
-
-instance (Ord a) => Ord [a] where
-    {-# SPECIALISE instance Ord [Char] #-}
-    compare []     []     = EQ
-    compare []     (_:_)  = LT
-    compare (_:_)  []     = GT
-    compare (x:xs) (y:ys) = case compare x y of
-                                EQ    -> compare xs ys
-                                other -> other
-
 instance Functor [] where
     fmap = map
 
 instance Functor [] where
     fmap = map
 
@@ -255,21 +255,6 @@ The rest of the prelude list functions are in GHC.List.
 ----------------------------------------------
 --      foldr/build/augment
 ----------------------------------------------
 ----------------------------------------------
 --      foldr/build/augment
 ----------------------------------------------
-
-Note [Inlining for foldr]
-~~~~~~~~~~~~~~~~~~~~~~~~~
-Inline foldr only in the final stage (0), after the foldr rules
-have had a chance
-
-Notice that we write foldr with just *two* arguments so that it'll inline
-when given just those two arguments.  Those are the ones that allow it to
-be specialised for its argument functions.  If you give it *three* args
-then a definition like 
-   unpack = foldr unpk_fn unpk_arg
-does not get foldr inlined.  But now 'unpack' will probably be inlined at
-every call site (being small and arity 1), and *that* will make foldr inline!
-So we get a copy of foldr at every call of unpack. This is particularly
-bad for literal strings.
   
 \begin{code}
 -- | 'foldr', applied to a binary operator, a starting value (typically
   
 \begin{code}
 -- | 'foldr', applied to a binary operator, a starting value (typically
@@ -281,11 +266,14 @@ bad for literal strings.
 foldr            :: (a -> b -> b) -> b -> [a] -> b
 -- foldr _ z []     =  z
 -- foldr f z (x:xs) =  f x (foldr f z xs)
 foldr            :: (a -> b -> b) -> b -> [a] -> b
 -- foldr _ z []     =  z
 -- foldr f z (x:xs) =  f x (foldr f z xs)
-{-# INLINE [0] foldr #-}    -- See Note [Inlining for foldr]
-foldr k z = go 
+{-# INLINE [0] foldr #-}
+-- Inline only in the final stage, after the foldr/cons rule has had a chance
+-- Also note that we inline it when it has *two* parameters, which are the 
+-- ones we are keen about specialising!
+foldr k z = go
           where
           where
-               go []     = z
-               go (y:ys) = y `k` go ys
+            go []     = z
+            go (y:ys) = y `k` go ys
 
 -- | A list producer that can be fused with 'foldr'.
 -- This function is merely
 
 -- | A list producer that can be fused with 'foldr'.
 -- This function is merely
@@ -373,7 +361,7 @@ map f (x:xs) = f x : map f xs
 -- Note eta expanded
 mapFB ::  (elt -> lst -> lst) -> (a -> elt) -> a -> lst -> lst
 {-# INLINE [0] mapFB #-}
 -- Note eta expanded
 mapFB ::  (elt -> lst -> lst) -> (a -> elt) -> a -> lst -> lst
 {-# INLINE [0] mapFB #-}
-mapFB c f x ys = c (f x) ys
+mapFB c f = \x ys -> c (f x) ys
 
 -- The rules for map work like this.
 -- 
 
 -- The rules for map work like this.
 -- 
@@ -430,30 +418,6 @@ mapFB c f x ys = c (f x) ys
 %*********************************************************
 
 \begin{code}
 %*********************************************************
 
 \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.
--- The actual definition is in the ghc-prim package.
-
--- XXX These don't work:
--- deriving instance Eq Bool
--- deriving instance Ord Bool
--- <wired into compiler>:
---     Illegal binding of built-in syntax: con2tag_Bool#
-
-instance Eq Bool where
-    True  == True  = True
-    False == False = True
-    _     == _     = False
-
-instance Ord Bool where
-    compare False True  = LT
-    compare True  False = GT
-    compare _     _     = EQ
-
--- Read is in GHC.Read, Show in GHC.Show
-
 -- |'otherwise' is defined as the value 'True'.  It helps to make
 -- guards more readable.  eg.
 --
 -- |'otherwise' is defined as the value 'True'.  It helps to make
 -- guards more readable.  eg.
 --
@@ -465,36 +429,6 @@ otherwise               =  True
 
 %*********************************************************
 %*                                                      *
 
 %*********************************************************
 %*                                                      *
-\subsection{Type @Ordering@}
-%*                                                      *
-%*********************************************************
-
-\begin{code}
--- | Represents an ordering relationship between two values: less
--- than, equal to, or greater than.  An 'Ordering' is returned by
--- 'compare'.
--- XXX These don't work:
--- deriving instance Eq Ordering
--- deriving instance Ord Ordering
--- Illegal binding of built-in syntax: con2tag_Ordering#
-instance Eq Ordering where
-    EQ == EQ = True
-    LT == LT = True
-    GT == GT = True
-    _  == _  = False
-        -- Read in GHC.Read, Show in GHC.Show
-
-instance Ord Ordering where
-    LT <= _  = True
-    _  <= LT = False
-    EQ <= _  = True
-    _  <= EQ = False
-    GT <= GT = True
-\end{code}
-
-
-%*********************************************************
-%*                                                      *
 \subsection{Type @Char@ and @String@}
 %*                                                      *
 %*********************************************************
 \subsection{Type @Char@ and @String@}
 %*                                                      *
 %*********************************************************
@@ -505,33 +439,6 @@ instance Ord Ordering where
 --
 type String = [Char]
 
 --
 type String = [Char]
 
-{-| The character type 'Char' is an enumeration whose values represent
-Unicode (or equivalently ISO\/IEC 10646) characters
-(see <http://www.unicode.org/> for details).
-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').
--}
-
--- We don't use deriving for Eq and Ord, because for Ord the derived
--- instance defines only compare, which takes two primops.  Then
--- '>' uses compare, and therefore takes two primops instead of one.
-
-instance Eq Char where
-    (C# c1) == (C# c2) = c1 `eqChar#` c2
-    (C# c1) /= (C# c2) = c1 `neChar#` c2
-
-instance Ord Char where
-    (C# c1) >  (C# c2) = c1 `gtChar#` c2
-    (C# c1) >= (C# c2) = c1 `geChar#` c2
-    (C# c1) <= (C# c2) = c1 `leChar#` c2
-    (C# c1) <  (C# c2) = c1 `ltChar#` c2
-
 {-# RULES
 "x# `eqChar#` x#" forall x#. x# `eqChar#` x# = True
 "x# `neChar#` x#" forall x#. x# `neChar#` x# = False
 {-# RULES
 "x# `eqChar#` x#" forall x#. x# `eqChar#` x# = True
 "x# `neChar#` x#" forall x#. x# `neChar#` x# = False
@@ -543,8 +450,10 @@ instance Ord Char where
 
 -- | The 'Prelude.toEnum' method restricted to the type 'Data.Char.Char'.
 chr :: Int -> Char
 
 -- | 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"
+chr i@(I# i#)
+ | int2Word# i# `leWord#` int2Word# 0x10FFFF# = C# (chr# i#)
+ | otherwise
+    = error ("Prelude.chr: bad argument: " ++ showSignedInt (I# 9#) i "")
 
 unsafeChr :: Int -> Char
 unsafeChr (I# i#) = C# (chr# i#)
 
 unsafeChr :: Int -> Char
 unsafeChr (I# i#) = C# (chr# i#)
@@ -636,16 +545,6 @@ lazy x = x
 -- sees it as lazy.  Then the worker/wrapper phase inlines it.
 -- Result: happiness
 
 -- sees it as lazy.  Then the worker/wrapper phase inlines it.
 -- Result: happiness
 
-
--- | The call '(inline f)' reduces to 'f', but 'inline' has a BuiltInRule
--- that tries to inline 'f' (if it has an unfolding) unconditionally
--- The 'NOINLINE' pragma arranges that inline only gets inlined (and
--- hence eliminated) late in compilation, after the rule has had
--- a god chance to fire.
-inline :: a -> a
-{-# NOINLINE[0] inline #-}
-inline x = x
-
 -- Assertion function.  This simply ignores its boolean argument.
 -- The compiler may rewrite it to @('assertError' line)@.
 
 -- Assertion function.  This simply ignores its boolean argument.
 -- The compiler may rewrite it to @('assertError' line)@.
 
@@ -681,7 +580,9 @@ const x _               =  x
 
 -- | Function composition.
 {-# INLINE (.) #-}
 
 -- | Function composition.
 {-# INLINE (.) #-}
-(.)       :: (b -> c) -> (a -> b) -> a -> c
+-- Make sure it has TWO args only on the left, so that it inlines
+-- when applied to two functions, even if there is no final argument
+(.)    :: (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@.
 (.) f g = \x -> f (g x)
 
 -- | @'flip' f@ takes its (first) two arguments in the reverse order of @f@.
@@ -715,6 +616,38 @@ asTypeOf                =  const
 
 %*********************************************************
 %*                                                      *
 
 %*********************************************************
 %*                                                      *
+\subsection{@Functor@ and @Monad@ instances for @IO@}
+%*                                                      *
+%*********************************************************
+
+\begin{code}
+instance  Functor IO where
+   fmap f x = x >>= (return . f)
+
+instance  Monad IO  where
+    {-# INLINE return #-}
+    {-# INLINE (>>)   #-}
+    {-# INLINE (>>=)  #-}
+    m >> k    = m >>= \ _ -> k
+    return    = returnIO
+    (>>=)     = bindIO
+    fail s    = GHC.IO.failIO s
+
+returnIO :: a -> IO a
+returnIO x = IO $ \ s -> (# s, x #)
+
+bindIO :: IO a -> (a -> IO b) -> IO b
+bindIO (IO m) k = IO $ \ s -> case m s of (# new_s, a #) -> unIO (k a) new_s
+
+thenIO :: IO a -> IO b -> IO b
+thenIO (IO m) k = IO $ \ s -> case m s of (# new_s, _ #) -> unIO k new_s
+
+unIO :: IO a -> (State# RealWorld -> (# State# RealWorld, a #))
+unIO (IO a) = a
+\end{code}
+
+%*********************************************************
+%*                                                      *
 \subsection{@getTag@}
 %*                                                      *
 %*********************************************************
 \subsection{@getTag@}
 %*                                                      *
 %*********************************************************
@@ -761,7 +694,7 @@ x# `modInt#` y#
       (x# <# 0#) && (y# ># 0#)    = if r# /=# 0# then r# +# y# else 0#
     | otherwise                   = r#
     where
       (x# <# 0#) && (y# ># 0#)    = if r# /=# 0# then r# +# y# else 0#
     | otherwise                   = r#
     where
-    r# = x# `remInt#` y#
+    !r# = x# `remInt#` y#
 \end{code}
 
 Definitions of the boxed PrimOps; these will be
 \end{code}
 
 Definitions of the boxed PrimOps; these will be
@@ -781,7 +714,7 @@ used in the case of partial applications, etc.
 {-# INLINE remInt #-}
 {-# INLINE negateInt #-}
 
 {-# INLINE remInt #-}
 {-# INLINE negateInt #-}
 
-plusInt, minusInt, timesInt, quotInt, remInt, divInt, modInt, gcdInt :: Int -> Int -> Int
+plusInt, minusInt, timesInt, quotInt, remInt, divInt, modInt :: Int -> Int -> Int
 (I# x) `plusInt`  (I# y) = I# (x +# y)
 (I# x) `minusInt` (I# y) = I# (x -# y)
 (I# x) `timesInt` (I# y) = I# (x *# y)
 (I# x) `plusInt`  (I# y) = I# (x +# y)
 (I# x) `minusInt` (I# y) = I# (x -# y)
 (I# x) `timesInt` (I# y) = I# (x *# y)
@@ -801,17 +734,6 @@ plusInt, minusInt, timesInt, quotInt, remInt, divInt, modInt, gcdInt :: Int -> I
 "1# *# x#" forall x#. 1# *# x# = x#
   #-}
 
 "1# *# x#" forall x#. 1# *# x# = x#
   #-}
 
-gcdInt (I# a) (I# b) = g a b
-   where g 0# 0# = error "GHC.Base.gcdInt: gcd 0 0 is undefined"
-         g 0# _  = I# absB
-         g _  0# = I# absA
-         g _  _  = I# (gcdInt# absA absB)
-
-         absInt x = if x <# 0# then negateInt# x else x
-
-         absA     = absInt a
-         absB     = absInt b
-
 negateInt :: Int -> Int
 negateInt (I# x) = I# (negateInt# x)
 
 negateInt :: Int -> Int
 negateInt (I# x) = I# (negateInt# x)
 
@@ -929,16 +851,13 @@ a `iShiftRL#` b | b >=# WORD_SIZE_IN_BITS# = 0#
 This code is needed for virtually all programs, since it's used for
 unpacking the strings of error messages.
 
 This code is needed for virtually all programs, since it's used for
 unpacking the strings of error messages.
 
-Note [Inlining for unpacking C strings]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-We use NOINLINE on unpackCString# and unpackFoldrCString# because
-there is little or no gain from inlining them -- and there may be a 
-lot of calls (one for each literal string).
-
 \begin{code}
 unpackCString# :: Addr# -> [Char]
 {-# NOINLINE unpackCString# #-}
 \begin{code}
 unpackCString# :: Addr# -> [Char]
 {-# NOINLINE unpackCString# #-}
--- See Note [Inlining for unpacking C strings]
+    -- There's really no point in inlining this, ever, cos
+    -- the loop doesn't specialise in an interesting
+    -- But it's pretty small, so there's a danger that
+    -- it'll be inlined at every literal, which is a waste
 unpackCString# addr 
   = unpack 0#
   where
 unpackCString# addr 
   = unpack 0#
   where
@@ -946,9 +865,11 @@ unpackCString# addr
       | ch `eqChar#` '\0'# = []
       | otherwise          = C# ch : unpack (nh +# 1#)
       where
       | ch `eqChar#` '\0'# = []
       | otherwise          = C# ch : unpack (nh +# 1#)
       where
-        ch = indexCharOffAddr# addr nh
+        !ch = indexCharOffAddr# addr nh
 
 unpackAppendCString# :: Addr# -> [Char] -> [Char]
 
 unpackAppendCString# :: Addr# -> [Char] -> [Char]
+{-# NOINLINE unpackAppendCString# #-}
+     -- See the NOINLINE note on unpackCString# 
 unpackAppendCString# addr rest
   = unpack 0#
   where
 unpackAppendCString# addr rest
   = unpack 0#
   where
@@ -956,15 +877,24 @@ unpackAppendCString# addr rest
       | ch `eqChar#` '\0'# = rest
       | otherwise          = C# ch : unpack (nh +# 1#)
       where
       | ch `eqChar#` '\0'# = rest
       | otherwise          = C# ch : unpack (nh +# 1#)
       where
-        ch = indexCharOffAddr# addr nh
+        !ch = indexCharOffAddr# addr nh
 
 unpackFoldrCString# :: Addr# -> (Char  -> a -> a) -> a -> a 
 
 unpackFoldrCString# :: Addr# -> (Char  -> a -> a) -> a -> a 
-{-# NOINLINE unpackFoldrCString# #-}
--- See Note [Inlining for unpacking C strings]
--- Usually the unpack-list rule turns it into unpackCString#
+
+-- Usually the unpack-list rule turns unpackFoldrCString# into unpackCString#
+
 -- It also has a BuiltInRule in PrelRules.lhs:
 --      unpackFoldrCString# "foo" c (unpackFoldrCString# "baz" c n)
 --        =  unpackFoldrCString# "foobaz" c n
 -- It also has a BuiltInRule in PrelRules.lhs:
 --      unpackFoldrCString# "foo" c (unpackFoldrCString# "baz" c n)
 --        =  unpackFoldrCString# "foobaz" c n
+
+{-# NOINLINE unpackFoldrCString# #-}
+-- At one stage I had NOINLINE [0] on the grounds that, unlike
+-- unpackCString#, there *is* some point in inlining
+-- unpackFoldrCString#, because we get better code for the
+-- higher-order function call.  BUT there may be a lot of
+-- literal strings, and making a separate 'unpack' loop for
+-- each is highly gratuitous.  See nofib/real/anna/PrettyPrint.
+
 unpackFoldrCString# addr f z 
   = unpack 0#
   where
 unpackFoldrCString# addr f z 
   = unpack 0#
   where
@@ -972,7 +902,7 @@ unpackFoldrCString# addr f z
       | ch `eqChar#` '\0'# = z
       | otherwise          = C# ch `f` unpack (nh +# 1#)
       where
       | ch `eqChar#` '\0'# = z
       | otherwise          = C# ch `f` unpack (nh +# 1#)
       where
-        ch = indexCharOffAddr# addr nh
+        !ch = indexCharOffAddr# addr nh
 
 unpackCStringUtf8# :: Addr# -> [Char]
 unpackCStringUtf8# addr 
 
 unpackCStringUtf8# :: Addr# -> [Char]
 unpackCStringUtf8# addr 
@@ -997,7 +927,7 @@ unpackCStringUtf8# addr
                      (ord# (indexCharOffAddr# addr (nh +# 3#)) -# 0x80#))) :
           unpack (nh +# 4#)
       where
                      (ord# (indexCharOffAddr# addr (nh +# 3#)) -# 0x80#))) :
           unpack (nh +# 4#)
       where
-        ch = indexCharOffAddr# addr nh
+        !ch = indexCharOffAddr# addr nh
 
 unpackNBytes# :: Addr# -> Int# -> [Char]
 unpackNBytes# _addr 0#   = []
 
 unpackNBytes# :: Addr# -> Int# -> [Char]
 unpackNBytes# _addr 0#   = []