X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=GHC%2FBase.lhs;h=3806d78f389ecdf82409148418836b564069c1cf;hb=ee7be4593b1b17d4ef45c37963b8b19d53865ab6;hp=751a9088a2256a762042727009e9502712a2f8b0;hpb=72e4fe7801d2d8ab5b243cbb430272b45010f59d;p=ghc-base.git diff --git a/GHC/Base.lhs b/GHC/Base.lhs index 751a908..3806d78 100644 --- a/GHC/Base.lhs +++ b/GHC/Base.lhs @@ -62,7 +62,8 @@ GHC.Float Classes: Floating, RealFloat Other Prelude modules are much easier with fewer complex dependencies. \begin{code} -{-# OPTIONS_GHC -fno-implicit-prelude #-} +{-# OPTIONS_GHC -XNoImplicitPrelude #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} {-# OPTIONS_HADDOCK hide #-} ----------------------------------------------------------------------------- -- | @@ -85,22 +86,31 @@ module GHC.Base ( module GHC.Base, module GHC.Bool, + module GHC.Classes, module GHC.Generics, + 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.Types import GHC.Bool +import GHC.Classes import GHC.Generics +import GHC.Ordering import GHC.Prim import {-# SOURCE #-} GHC.Err +-- 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 1 >>, >>= infixr 0 $ @@ -146,61 +156,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@ } %* * %********************************************************* @@ -272,9 +227,8 @@ class Monad m where %********************************************************* \begin{code} -data [] a = [] | a : [a] -- do explicitly: deriving (Eq, Ord) - -- to avoid weird names like con2tag_[]# - +-- do explicitly: deriving (Eq, Ord) +-- to avoid weird names like con2tag_[]# instance (Eq a) => Eq [a] where {-# SPECIALISE instance Eq [Char] #-} @@ -492,23 +446,6 @@ instance Ord Bool where -- 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,39 +457,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@} %* * %********************************************************* @@ -561,8 +465,23 @@ instance Ord () where -- | 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) +-- 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} @@ -590,7 +509,6 @@ 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 @@ -634,7 +552,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 +567,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# @@ -744,7 +657,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 @@ -840,7 +753,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 @@ -860,7 +773,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,17 +793,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) @@ -1010,7 +912,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 @@ -1018,9 +924,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 @@ -1028,11 +936,13 @@ 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; +-- 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) @@ -1044,7 +954,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 @@ -1069,7 +979,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# = [] @@ -1082,7 +992,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