\begin{code}
{-# OPTIONS_GHC -XNoImplicitPrelude #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# OPTIONS_HADDOCK hide #-}
-----------------------------------------------------------------------------
-- |
(
module GHC.Base,
module GHC.Bool,
+ module GHC.Classes,
module GHC.Generics,
module GHC.Ordering,
module GHC.Types,
import GHC.Types
import GHC.Bool
+import GHC.Classes
import GHC.Generics
import GHC.Ordering
import GHC.Prim
+import {-# SOURCE #-} GHC.Show
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 ++
-infix 4 ==, /=, <, <=, >=, >
-infixr 3 &&
-infixr 2 ||
infixl 1 >>, >>=
infixr 0 $
%*********************************************************
%* *
-\subsection{Standard classes @Eq@, @Ord@}
-%* *
-%*********************************************************
-
-\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
-
- compare x y
- | x == y = EQ
- | x <= y = LT -- NB: must be '<=' not '<' to validate the
- -- above claim about the minimal things that
- -- can be defined for an instance of Ord
- | otherwise = GT
-
- x < y = case compare x y of { LT -> True; _other -> False }
- x <= y = case compare x y of { GT -> False; _other -> True }
- x > y = case compare x y of { GT -> True; _other -> False }
- x >= y = case compare x y of { LT -> False; _other -> True }
-
- -- These two default methods use '<=' rather than 'compare'
- -- because the latter is often more expensive
- max x y = if x <= y then y else x
- min x y = if x <= y then x else y
-\end{code}
-
-%*********************************************************
-%* *
\subsection{Monadic classes @Functor@, @Monad@ }
%* *
%*********************************************************
-- Read is in GHC.Read, Show in GHC.Show
--- Boolean functions
-
--- | 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.
--
-- | 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#)
%*********************************************************
%* *
+\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@}
%* *
%*********************************************************
(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
{-# 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)
"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)
\begin{code}
unpackCString# :: Addr# -> [Char]
-{-# NOINLINE [1] unpackCString# #-}
+{-# NOINLINE unpackCString# #-}
+ -- 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
| ch `eqChar#` '\0'# = []
| otherwise = C# ch : unpack (nh +# 1#)
where
- ch = indexCharOffAddr# addr nh
+ !ch = indexCharOffAddr# addr nh
unpackAppendCString# :: Addr# -> [Char] -> [Char]
+{-# NOINLINE unpackAppendCString# #-}
+ -- See the NOINLINE note on unpackCString#
unpackAppendCString# addr rest
= unpack 0#
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
{-# NOINLINE [0] unpackFoldrCString# #-}
--- Don't inline till right at the end;
+-- Unlike unpackCString#, there *is* some point in inlining unpackFoldrCString#,
+-- because we get better code for the function call.
+-- However, don't inline till right at the end;
-- usually the unpack-list rule turns it into unpackCStringList
-- It also has a BuiltInRule in PrelRules.lhs:
-- unpackFoldrCString# "foo" c (unpackFoldrCString# "baz" c n)
| 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
(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# = []
ch -> unpack (C# ch : acc) (i# -# 1#)
{-# RULES
-"unpack" [~1] forall a . unpackCString# a = build (unpackFoldrCString# a)
+"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