X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=GHC%2FBase.lhs;h=98abed50c446bd4f977474a25678fc3ae8fa15d4;hb=df8d9fc17f6750afe10021cee1b53f200d26d2bf;hp=45ec617bb08815be805b9e5b1b4c3e15798ffcc3;hpb=68d2858d1fbd17d9fb910ed3f929f83ca0f34f0d;p=ghc-base.git diff --git a/GHC/Base.lhs b/GHC/Base.lhs index 45ec617..98abed5 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,9 +96,10 @@ 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.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 @@ -96,9 +108,10 @@ module GHC.Base 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 @@ -144,15 +157,6 @@ 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} @@ -171,7 +175,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 +241,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 +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. -- @@ -434,30 +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 - -- |'otherwise' is defined as the value 'True'. It helps to make -- guards more readable. eg. -- @@ -479,33 +441,6 @@ otherwise = True -- 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 @@ -906,106 +841,9 @@ 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 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 - --- 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 - 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 @@ -1017,6 +855,7 @@ unpackNBytes# addr len# = unpack [] (len# -# 1#) #-} \end{code} + #ifdef __HADDOCK__ \begin{code} -- | A special argument for the 'Control.Monad.ST.ST' type constructor,