Moved the CString functions to GHC.CString in ghc-prim (needed for the new generic...
[ghc-base.git] / GHC / Base.lhs
index 45ec617..98abed5 100644 (file)
@@ -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
--- <wired into compiler>:
---     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 <http://www.unicode.org/> 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,