X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=GHC%2FBase.lhs;h=5075478ea12e0c74f2513b7e81340fa088f8821a;hb=HEAD;hp=751a9088a2256a762042727009e9502712a2f8b0;hpb=72e4fe7801d2d8ab5b243cbb430272b45010f59d;p=ghc-base.git diff --git a/GHC/Base.lhs b/GHC/Base.lhs index 751a908..5075478 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 -fno-implicit-prelude #-} +{-# 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,23 +96,37 @@ Other Prelude modules are much easier with fewer complex dependencies. module GHC.Base ( module GHC.Base, - module GHC.Bool, - module GHC.Generics, + module GHC.Classes, + 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 module GHC.Err -- of people having to import it explicitly ) where -import GHC.Bool -import GHC.Generics +import GHC.Types +import GHC.Classes +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 +-- 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 || +infixr 5 ++ +infixl 4 <$ infixl 1 >>, >>= infixr 0 $ @@ -131,76 +157,12 @@ otherwise = True 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} %********************************************************* %* * -\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@ } %* * %********************************************************* @@ -213,12 +175,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 @@ -260,6 +228,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} @@ -272,25 +241,6 @@ class Monad m where %********************************************************* \begin{code} -data [] a = [] | a : [a] -- 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 @@ -320,10 +270,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 @@ -411,7 +363,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. -- @@ -468,47 +420,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. -- @@ -520,54 +431,6 @@ otherwise = True %********************************************************* %* * -\subsection{The @()@ type} -%* * -%********************************************************* - -The Unit type is here because virtually any program needs it (whereas -some programs may get away without consulting GHC.Tup). Furthermore, -the renamer currently *always* asks for () to be in scope, so that -ccalls can use () as their default type; so when compiling GHC.Base we -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 - () == () = True - () /= () = False - -instance Ord () where - () <= () = True - () < () = False - () >= () = True - () > () = False - max () () = () - min () () = () - compare () () = EQ -\end{code} - - -%********************************************************* -%* * -\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'. -data Ordering = LT | EQ | GT deriving (Eq, Ord) - -- Read in GHC.Read, Show in GHC.Show -\end{code} - - -%********************************************************* -%* * \subsection{Type @Char@ and @String@} %* * %********************************************************* @@ -578,34 +441,6 @@ data Ordering = LT | EQ | GT deriving (Eq, Ord) -- 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'). --} -data Char = C# Char# - --- 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 @@ -617,8 +452,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#) @@ -634,7 +471,7 @@ String equality is used when desugaring pattern-matches against strings. eqString :: String -> String -> Bool eqString [] [] = True eqString (c1:cs1) (c2:cs2) = c1 == c2 && cs1 `eqString` cs2 -eqString cs1 cs2 = False +eqString _ _ = False {-# RULES "eqString" (==) = eqString #-} -- eqString also has a BuiltInRule in PrelRules.lhs: @@ -649,11 +486,6 @@ eqString cs1 cs2 = 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# @@ -670,26 +502,6 @@ maxInt = I# 0x7FFFFFFF# 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} @@ -715,16 +527,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,7 +546,7 @@ inline x = x -- but from Template Haskell onwards it's simply -- defined here in Base.lhs assert :: Bool -> a -> a -assert pred r = r +assert _pred r = r breakpoint :: a -> a breakpoint r = r @@ -760,8 +562,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 @@ -794,6 +598,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@} %* * %********************************************************* @@ -840,19 +676,13 @@ 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 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 #-} @@ -860,7 +690,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) @@ -880,28 +710,9 @@ 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) -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 @@ -915,9 +726,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# @@ -945,6 +753,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 @@ -996,93 +810,11 @@ a `iShiftRL#` b | b >=# WORD_SIZE_IN_BITS# = 0# "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 [1] unpackCString# #-} -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] -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# #-} --- 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" [~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 @@ -1092,6 +824,7 @@ unpackNBytes# addr len# = unpack [] (len# -# 1#) #-} \end{code} + #ifdef __HADDOCK__ \begin{code} -- | A special argument for the 'Control.Monad.ST.ST' type constructor,