X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=GHC%2FBase.lhs;h=ba128bfc885e1c8ba24a71cecf9010fdc4f41059;hb=b751723d882e51241f04d6d2ec46fce70f0e0817;hp=b18215b79cd5893726c2839b0cf33e9ac57881bf;hpb=d6727acd2361c3c96a24fbaabde4419328446193;p=ghc-base.git diff --git a/GHC/Base.lhs b/GHC/Base.lhs index b18215b..ba128bf 100644 --- a/GHC/Base.lhs +++ b/GHC/Base.lhs @@ -62,8 +62,20 @@ GHC.Float Classes: Floating, RealFloat 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 @@ -84,7 +96,7 @@ Other Prelude modules are much easier with fewer complex dependencies. module GHC.Base ( module GHC.Base, - module GHC.Bool, + module GHC.Classes, module GHC.Generics, module GHC.Ordering, module GHC.Types, @@ -94,17 +106,23 @@ module GHC.Base where 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 4 <$ infixl 1 >>, >>= infixr 0 $ @@ -150,61 +168,6 @@ unpackCStringUtf8# a = error "urk" %********************************************************* %* * -\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@ } %* * %********************************************************* @@ -217,12 +180,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' -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 @@ -264,6 +233,7 @@ class Monad m where -- failure in a @do@ expression. fail :: String -> m a + {-# INLINE (>>) #-} m >> k = m >>= \_ -> k fail s = error s \end{code} @@ -276,24 +246,6 @@ class Monad m where %********************************************************* \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 @@ -323,10 +275,12 @@ foldr :: (a -> b -> b) -> b -> [a] -> b -- 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 @@ -414,7 +368,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 #-} -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. -- @@ -471,47 +425,6 @@ mapFB c f x ys = c (f x) 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. --- The actual definition is in the ghc-prim package. - --- XXX These don't work: --- deriving instance Eq Bool --- deriving instance Ord Bool --- : --- 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 - --- 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. -- @@ -523,36 +436,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@} %* * %********************************************************* @@ -563,33 +446,6 @@ instance Ord Ordering where -- type String = [Char] -{-| The character type 'Char' is an enumeration whose values represent -Unicode (or equivalently ISO\/IEC 10646) characters -(see 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 @@ -601,8 +457,10 @@ instance Ord Char where -- | 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#) @@ -633,11 +491,6 @@ eqString _ _ = False %********************************************************* \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# @@ -699,16 +552,6 @@ lazy x = x -- 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)@. @@ -744,8 +587,10 @@ const x _ = x -- | 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 @@ -778,6 +623,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@} %* * %********************************************************* @@ -824,7 +701,7 @@ x# `modInt#` y# (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 @@ -844,7 +721,7 @@ used in the case of partial applications, etc. {-# 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) @@ -864,17 +741,6 @@ plusInt, minusInt, timesInt, quotInt, remInt, divInt, modInt, gcdInt :: Int -> I "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) @@ -899,9 +765,6 @@ gtInt, geInt, eqInt, neInt, ltInt, leInt :: Int -> Int -> Bool "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# @@ -929,6 +792,12 @@ This gives wrong answer (0) for NaN * 0 (should be NaN): "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 @@ -994,7 +863,11 @@ unpacking the strings of error messages. \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 @@ -1002,9 +875,11 @@ unpackCString# addr | 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 @@ -1012,15 +887,24 @@ unpackAppendCString# addr rest | 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; --- usually the unpack-list rule turns it into unpackCStringList + +-- 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 + +{-# 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 @@ -1028,7 +912,7 @@ unpackFoldrCString# addr f z | 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 @@ -1053,7 +937,7 @@ 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# = [] @@ -1066,7 +950,7 @@ unpackNBytes# addr len# = unpack [] (len# -# 1#) 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