X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=GHC%2FBase.lhs;h=ba128bfc885e1c8ba24a71cecf9010fdc4f41059;hb=be2750a0a11b919fb03cc070074e430f88bdfa90;hp=401c157adf970877911140c8e975d4d549cbae8e;hpb=de59ad189974c1a3b984f41d609e38a60f65b06a;p=ghc-base.git diff --git a/GHC/Base.lhs b/GHC/Base.lhs index 401c157..ba128bf 100644 --- a/GHC/Base.lhs +++ b/GHC/Base.lhs @@ -62,9 +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 @@ -85,7 +96,6 @@ 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, @@ -96,7 +106,6 @@ module GHC.Base where import GHC.Types -import GHC.Bool import GHC.Classes import GHC.Generics import GHC.Ordering @@ -171,7 +180,7 @@ 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 @@ -237,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 @@ -377,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. -- @@ -434,30 +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 - -- |'otherwise' is defined as the value 'True'. It helps to make -- guards more readable. eg. -- @@ -469,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@} %* * %********************************************************* @@ -509,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 @@ -642,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)@. @@ -865,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# @@ -895,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 @@ -987,14 +890,21 @@ unpackAppendCString# addr rest !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 + +-- 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