Other Prelude modules are much easier with fewer complex dependencies.
\begin{code}
-{-# OPTIONS_GHC -XNoImplicitPrelude #-}
+{-# LANGUAGE CPP
+ , NoImplicitPrelude
+ , BangPatterns
+ , ExplicitForAll
+ , MagicHash
+ , UnboxedTuples
+ , ExistentialQuantification
+ , Rank2Types
+ #-}
+-- -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 #-}
+
-----------------------------------------------------------------------------
-- |
-- Module : GHC.Base
module GHC.Base
(
module GHC.Base,
- module GHC.Bool,
module GHC.Classes,
- module GHC.Generics,
+ module GHC.CString,
+ --module GHC.Generics, -- JPM: We no longer export GHC.Generics
+ -- by default to avoid name clashes
module GHC.Ordering,
module GHC.Types,
module GHC.Prim, -- Re-export GHC.Prim and GHC.Err, to avoid lots
where
import GHC.Types
-import GHC.Bool
import GHC.Classes
-import GHC.Generics
+import GHC.CString
+-- JPM: Since we don't export it, we don't need to import GHC.Generics
+--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
infixr 9 .
infixr 5 ++
+infixl 4 <$
infixl 1 >>, >>=
infixr 0 $
build = error "urk"
foldr = error "urk"
-
-unpackCString# :: Addr# -> [Char]
-unpackFoldrCString# :: Addr# -> (Char -> a -> a) -> a -> a
-unpackAppendCString# :: Addr# -> [Char] -> [Char]
-unpackCStringUtf8# :: Addr# -> [Char]
-unpackCString# a = error "urk"
-unpackFoldrCString# a = error "urk"
-unpackAppendCString# a = error "urk"
-unpackCStringUtf8# a = error "urk"
-}
\end{code}
> 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
+ -- | 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
-- failure in a @do@ expression.
fail :: String -> m a
+ {-# INLINE (>>) #-}
m >> k = m >>= \_ -> k
fail s = error s
\end{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
-- foldr f z (x:xs) = f x (foldr f z xs)
{-# 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
+-- 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
+ go [] = z
+ go (y:ys) = y `k` go ys
-- | A list producer that can be fused with 'foldr'.
-- This function is merely
-- 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.
--
%*********************************************************
\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.
--
%*********************************************************
%* *
-\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@}
%* *
%*********************************************************
--
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
-- | 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#)
minInt = I# (-0x8000000000000000#)
maxInt = I# 0x7FFFFFFFFFFFFFFF#
#endif
-
-instance Eq Int where
- (==) = eqInt
- (/=) = neInt
-
-instance Ord Int where
- compare = compareInt
- (<) = ltInt
- (<=) = leInt
- (>=) = geInt
- (>) = gtInt
-
-compareInt :: Int -> Int -> Ordering
-(I# x#) `compareInt` (I# y#) = compareInt# x# y#
-
-compareInt# :: Int# -> Int# -> Ordering
-compareInt# x# y#
- | x# <# y# = LT
- | x# ==# y# = EQ
- | otherwise = GT
\end{code}
-- 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)@.
-- | Function composition.
{-# INLINE (.) #-}
-(.) :: (b -> c) -> (a -> b) -> a -> c
-(.) f g x = f (g x)
+-- 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@.
flip :: (a -> b -> c) -> b -> a -> c
%*********************************************************
%* *
+\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@}
%* *
%*********************************************************
used in the case of partial applications, etc.
\begin{code}
-{-# INLINE eqInt #-}
-{-# INLINE neInt #-}
-{-# INLINE gtInt #-}
-{-# INLINE geInt #-}
-{-# INLINE ltInt #-}
-{-# INLINE leInt #-}
{-# INLINE plusInt #-}
{-# INLINE minusInt #-}
{-# INLINE timesInt #-}
{-# 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)
-gtInt, geInt, eqInt, neInt, ltInt, leInt :: Int -> Int -> Bool
-(I# x) `gtInt` (I# y) = x ># y
-(I# x) `geInt` (I# y) = x >=# y
-(I# x) `eqInt` (I# y) = x ==# y
-(I# x) `neInt` (I# y) = x /=# y
-(I# x) `ltInt` (I# y) = x <# y
-(I# x) `leInt` (I# y) = x <=# y
-
{-# RULES
"x# ># x#" forall x#. x# ># x# = False
"x# >=# x#" forall x#. x# >=# x# = True
"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#
"timesDouble x 0.0" forall x#. (*##) x# 0.0## = 0.0##
These are tested by num014.
+
+Similarly for Float (#5178):
+
+"minusFloat x x" forall x#. minusFloat# x# x# = 0.0#
+"timesFloat0.0 x" forall x#. timesFloat# 0.0# x# = 0.0#
+"timesFloat x 0.0" forall x#. timesFloat# x# 0.0# = 0.0#
-}
-- Wrappers for the shift operations. The uncheckedShift# family are
"int2Word2Int" forall x#. int2Word# (word2Int# x#) = x#
"word2Int2Word" forall x#. word2Int# (int2Word# x#) = x#
#-}
-\end{code}
-
-%********************************************************
-%* *
-\subsection{Unpacking C strings}
-%* *
-%********************************************************
-
-This code is needed for virtually all programs, since it's used for
-unpacking the strings of error messages.
-
-\begin{code}
-unpackCString# :: Addr# -> [Char]
-{-# 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
- unpack nh
- | ch `eqChar#` '\0'# = []
- | otherwise = C# ch : unpack (nh +# 1#)
- where
- !ch = indexCharOffAddr# addr nh
-
-unpackAppendCString# :: Addr# -> [Char] -> [Char]
-{-# NOINLINE unpackAppendCString# #-}
- -- See the NOINLINE note on unpackCString#
-unpackAppendCString# addr rest
- = unpack 0#
- where
- unpack nh
- | ch `eqChar#` '\0'# = rest
- | otherwise = C# ch : unpack (nh +# 1#)
- where
- !ch = indexCharOffAddr# addr nh
-
-unpackFoldrCString# :: Addr# -> (Char -> a -> a) -> a -> a
-{-# NOINLINE [0] unpackFoldrCString# #-}
--- 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)
--- = unpackFoldrCString# "foobaz" c n
-unpackFoldrCString# addr f z
- = unpack 0#
- where
- unpack nh
- | ch `eqChar#` '\0'# = z
- | otherwise = C# ch `f` unpack (nh +# 1#)
- where
- !ch = indexCharOffAddr# addr nh
-
-unpackCStringUtf8# :: Addr# -> [Char]
-unpackCStringUtf8# addr
- = unpack 0#
- where
- unpack nh
- | ch `eqChar#` '\0'# = []
- | ch `leChar#` '\x7F'# = C# ch : unpack (nh +# 1#)
- | ch `leChar#` '\xDF'# =
- C# (chr# (((ord# ch -# 0xC0#) `uncheckedIShiftL#` 6#) +#
- (ord# (indexCharOffAddr# addr (nh +# 1#)) -# 0x80#))) :
- unpack (nh +# 2#)
- | ch `leChar#` '\xEF'# =
- 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#) `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
-
-unpackNBytes# :: Addr# -> Int# -> [Char]
-unpackNBytes# _addr 0# = []
-unpackNBytes# addr len# = unpack [] (len# -# 1#)
- where
- unpack acc i#
- | i# <# 0# = acc
- | otherwise =
- case indexCharOffAddr# addr i# of
- ch -> unpack (C# ch : acc) (i# -# 1#)
+-- Rules for C strings (the functions themselves are now in GHC.CString)
{-# RULES
"unpack" [~1] forall a . unpackCString# a = build (unpackFoldrCString# a)
"unpack-list" [1] forall a . unpackFoldrCString# a (:) [] = unpackCString# a
#-}
\end{code}
+
#ifdef __HADDOCK__
\begin{code}
-- | A special argument for the 'Control.Monad.ST.ST' type constructor,
projects / ghc-base.git / blobdiff