X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Flib%2Fstd%2FPrelBase.lhs;h=2208f7fb84169c5e74bce8082c554405c0e23ecb;hb=bf79510397bb7e72f1f7f6ea49a618a858d121a7;hp=314be3b4e4ca93e72928fb55ab672722d86d0084;hpb=8e16c2d2700d4910e30f122a0e5618ae18570016;p=ghc-hetmet.git

diff --git a/ghc/lib/std/PrelBase.lhs b/ghc/lib/std/PrelBase.lhs
index 314be3b..2208f7f 100644
--- a/ghc/lib/std/PrelBase.lhs
+++ b/ghc/lib/std/PrelBase.lhs
@@ -1,22 +1,92 @@
+% -----------------------------------------------------------------------------
+% $Id: PrelBase.lhs,v 1.50 2001/05/03 19:03:27 qrczak Exp $
 %
-% (c) The GRAP/AQUA Project, Glasgow University, 1992-1996
+% (c) The University of Glasgow, 1992-2000
 %
 \section[PrelBase]{Module @PrelBase@}
 
 
+The overall structure of the GHC Prelude is a bit tricky.
+
+  a) We want to avoid "orphan modules", i.e. ones with instance
+	decls that don't belong either to a tycon or a class
+	defined in the same module
+
+  b) We want to avoid giant modules
+
+So the rough structure is as follows, in (linearised) dependency order
+
+
+PrelGHC		Has no implementation.  It defines built-in things, and
+		by importing it you bring them into scope.
+		The source file is PrelGHC.hi-boot, which is just
+		copied to make PrelGHC.hi
+
+		Classes: CCallable, CReturnable
+
+PrelBase	Classes: Eq, Ord, Functor, Monad
+		Types:   list, (), Int, Bool, Ordering, Char, String
+
+PrelTup		Types: tuples, plus instances for PrelBase classes
+
+PrelShow	Class: Show, plus instances for PrelBase/PrelTup types
+
+PrelEnum	Class: Enum,  plus instances for PrelBase/PrelTup types
+
+PrelMaybe	Type: Maybe, plus instances for PrelBase classes
+
+PrelNum		Class: Num, plus instances for Int
+		Type:  Integer, plus instances for all classes so far (Eq, Ord, Num, Show)
+
+		Integer is needed here because it is mentioned in the signature
+		of 'fromInteger' in class Num
+
+PrelReal	Classes: Real, Integral, Fractional, RealFrac
+			 plus instances for Int, Integer
+		Types:  Ratio, Rational
+			plus intances for classes so far
+
+		Rational is needed here because it is mentioned in the signature
+		of 'toRational' in class Real
+
+Ix		Classes: Ix, plus instances for Int, Bool, Char, Integer, Ordering, tuples
+
+PrelArr		Types: Array, MutableArray, MutableVar
+
+		Does *not* contain any ByteArray stuff (see PrelByteArr)
+		Arrays are used by a function in PrelFloat
+
+PrelFloat	Classes: Floating, RealFloat
+		Types:   Float, Double, plus instances of all classes so far
+
+		This module contains everything to do with floating point.
+		It is a big module (900 lines)
+		With a bit of luck, many modules can be compiled without ever reading PrelFloat.hi
+
+PrelByteArr	Types: ByteArray, MutableByteArray
+		
+		We want this one to be after PrelFloat, because it defines arrays
+		of unboxed floats.
+
+
+Other Prelude modules are much easier with fewer complex dependencies.
+
+
 \begin{code}
 {-# OPTIONS -fno-implicit-prelude #-}
 
+#include "MachDeps.h"
+
 module PrelBase
 	(
 	module PrelBase,
-	module PrelGHC		-- Re-export PrelGHC, to avoid lots of people 
-				-- having to import it explicitly
+	module PrelGHC,		-- Re-export PrelGHC and PrelErr, to avoid lots
+	module PrelErr          -- of people having to import it explicitly
   ) 
 	where
 
-import {-# SOURCE #-} PrelErr ( error )
 import PrelGHC
+import {-# SOURCE #-} PrelErr
 
 infixr 9  .
 infixr 5  ++, :
@@ -25,43 +95,84 @@ infixr 3  &&
 infixr 2  ||
 infixl 1  >>, >>=
 infixr 0  $
+
+default ()		-- Double isn't available yet
+\end{code}
+
+
+%*********************************************************
+%*							*
+\subsection{DEBUGGING STUFF}
+%*  (for use when compiling PrelBase itself doesn't work)
+%*							*
+%*********************************************************
+
+\begin{code}
+{-
+data  Bool  =  False | True
+data Ordering = LT | EQ | GT 
+data Char = C# Char#
+type  String = [Char]
+data Int = I# Int#
+data  ()  =  ()
+data [] a = MkNil
+
+not True = False
+(&&) True True = True
+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@, @Bounded@
+\subsection{Standard classes @Eq@, @Ord@}
 %*							*
 %*********************************************************
 
 \begin{code}
 class  Eq a  where
-    (==), (/=)		:: a -> a -> Bool
+    (==), (/=)		 :: a -> a -> Bool
 
-    x /= y		=  not (x == y)
-    x == y		= not  (x /= y)
+    x /= y		 = not (x == y)
+    x == y		 = not (x /= y)
 
 class  (Eq a) => Ord a  where
-    compare             :: a -> a -> Ordering
-    (<), (<=), (>=), (>):: a -> a -> Bool
-    max, min		:: a -> a -> a
+    compare		 :: a -> a -> Ordering
+    (<), (<=), (>), (>=) :: a -> a -> Bool
+    max, min		 :: a -> a -> a
 
--- An instance of Ord should define either compare or <=
--- Using compare can be more efficient for complex types.
-    compare x y
-	    | x == y    = EQ
-	    | x <= y    = LT
-	    | otherwise = GT
-
-    x <= y  = case compare x y of { GT -> False; other -> True }
-    x <	 y  = case compare x y of { LT -> True;  other -> False }
-    x >= y  = case compare x y of { LT -> False; other -> True }
-    x >	 y  = case compare x y of { GT -> True;  other -> False }
+    -- An instance of Ord should define either 'compare' or '<='.
+    -- Using 'compare' can be more efficient for complex types.
 
-	-- These two default methods use '>' rather than compare
+    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 x else y
-    min x y = if x > y then y else x
+    max x y = if x <= y then y else x
+    min x y = if x <= y then x else y
 \end{code}
 
 %*********************************************************
@@ -72,7 +183,7 @@ class  (Eq a) => Ord a  where
 
 \begin{code}
 class  Functor f  where
-    fmap         :: (a -> b) -> f a -> f b
+    fmap        :: (a -> b) -> f a -> f b
 
 class  Monad m  where
     (>>=)       :: m a -> (a -> m b) -> m b
@@ -80,9 +191,8 @@ class  Monad m  where
     return      :: a -> m a
     fail	:: String -> m a
 
-    m >> k      =  m >>= \_ -> k
+    m >> k      = m >>= \_ -> k
     fail s      = error s
-
 \end{code}
 
 
@@ -96,26 +206,21 @@ class  Monad m  where
 data [] a = [] | a : [a]  -- do explicitly: deriving (Eq, Ord)
 			  -- to avoid weird names like con2tag_[]#
 
-instance (Eq a) => Eq [a]  where
-    []     == []     = True	
-    (x:xs) == (y:ys) = x == y && xs == ys
-    _xs    == _ys    = False			
 
-    xs     /= ys     = if (xs == ys) then False else True
+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
-    a <  b  = case compare a b of { LT -> True;  EQ -> False; GT -> False }
-    a <= b  = case compare a b of { LT -> True;  EQ -> True;  GT -> False }
-    a >= b  = case compare a b of { LT -> False; EQ -> True;  GT -> True  }
-    a >  b  = case compare a b of { LT -> False; EQ -> False; GT -> True  }
-
+    {-# SPECIALISE instance Ord [Char] #-}
     compare []     []     = EQ
-    compare (_:_)  []     = GT
     compare []     (_:_)  = LT
+    compare (_:_)  []     = GT
     compare (x:xs) (y:ys) = case compare x y of
-                                 LT -> LT	
-			         GT -> GT		
-				 EQ -> compare xs ys
+                                EQ    -> compare xs ys
+                                other -> other
 
 instance Functor [] where
     fmap = map
@@ -136,34 +241,51 @@ The rest of the prelude list functions are in PrelList.
   
 \begin{code}
 foldr            :: (a -> b -> b) -> b -> [a] -> b
-foldr _ z []     =  z
-foldr f z (x:xs) =  f x (foldr f z xs)
+-- foldr _ z []     =  z
+-- foldr f z (x:xs) =  f x (foldr f z xs)
+{-# INLINE foldr #-}
+foldr k z xs = go xs
+	     where
+	       go []     = z
+	       go (y:ys) = y `k` go ys
 
 build 	:: forall a. (forall b. (a -> b -> b) -> b -> b) -> [a]
-{-# INLINE build #-}
+{-# INLINE 2 build #-}
 	-- The INLINE is important, even though build is tiny,
  	-- because it prevents [] getting inlined in the version that
 	-- appears in the interface file.  If [] *is* inlined, it
 	-- won't match with [] appearing in rules in an importing module.
+	--
+	-- The "2" says to inline in phase 2
+
 build g = g (:) []
 
 augment :: forall a. (forall b. (a->b->b) -> b -> b) -> [a] -> [a]
-{-# INLINE augment #-}
+{-# INLINE 2 augment #-}
 augment g xs = g (:) xs
 
 {-# RULES
-"fold/build" 	forall k,z,g::forall b. (a->b->b) -> b -> b . 
+"fold/build" 	forall k z (g::forall b. (a->b->b) -> b -> b) . 
 		foldr k z (build g) = g k z
 
-"foldr/augment" forall k,z,xs,g::forall b. (a->b->b) -> b -> b . 
+"foldr/augment" forall k z xs (g::forall b. (a->b->b) -> b -> b) . 
 		foldr k z (augment g xs) = g k (foldr k z xs)
 
 "foldr/id"    	foldr (:) [] = \x->x
-"foldr/app"    	forall xs, ys. foldr (:) ys xs = append xs ys
+"foldr/app"    	forall xs ys. foldr (:) ys xs = append xs ys
 
-"foldr/cons"	forall k,z,x,xs. foldr k z (x:xs) = k x (foldr k z xs)
-"foldr/nil"	forall k,z.	 foldr k z []     = z 
+"foldr/cons"	forall k z x xs. foldr k z (x:xs) = k x (foldr k z xs)
+"foldr/nil"	forall k z.	 foldr k z []     = z 
+
+"augment/build" forall (g::forall b. (a->b->b) -> b -> b)
+		       (h::forall b. (a->b->b) -> b -> b) .
+		       augment g (build h) = build (\c n -> g c (h c n))
+"augment/nil"   forall (g::forall b. (a->b->b) -> b -> b) .
+			augment g [] = build g
  #-}
+
+-- This rule is true, but not (I think) useful:
+--	augment g (augment h t) = augment (\cn -> g c (h c n)) t
 \end{code}
 
 
@@ -173,19 +295,21 @@ augment g xs = g (:) xs
 
 \begin{code}
 map :: (a -> b) -> [a] -> [b]
-{-# INLINE map #-}
-map f xs = build (\c n -> foldr (mapFB c f) n xs)
+map = mapList
 
-mapFB c f xs = c (f xs)
+-- Note eta expanded
+mapFB ::  (elt -> lst -> lst) -> (a -> elt) -> a -> lst -> lst
+mapFB c f x ys = c (f x) ys
 
 mapList :: (a -> b) -> [a] -> [b]
 mapList _ []     = []
 mapList f (x:xs) = f x : mapList f xs
 
 {-# RULES
-"mapFB"	    forall c,f,g.	mapFB (mapFB c f) g	= mapFB c (f.g) 
+"map"	    forall f xs.	map f xs		= build (\c n -> foldr (mapFB c f) n xs)
+"mapFB"	    forall c f g.	mapFB (mapFB c f) g	= mapFB c (f.g) 
 "mapList"   forall f.		foldr (mapFB (:) f) []	= mapList f
- #-}
+  #-}
 \end{code}
 
 
@@ -194,8 +318,11 @@ mapList f (x:xs) = f x : mapList f xs
 ----------------------------------------------
 \begin{code}
 (++) :: [a] -> [a] -> [a]
-{-# INLINE (++) #-}
-xs ++ ys = augment (\c n -> foldr c n xs) ys
+(++) = append
+
+{-# RULES
+"++"	forall xs ys. xs ++ ys = augment (\c n -> foldr c n xs) ys
+  #-}
 
 append :: [a] -> [a] -> [a]
 append []     ys = ys
@@ -241,10 +368,10 @@ some programs may get away without consulting PrelTup).  Furthermore,
 the renamer currently *always* asks for () to be in scope, so that
 ccalls can use () as their default type; so when compiling PrelBase we
 need ().  (We could arrange suck in () only if -fglasgow-exts, but putting
-it here seems more direct.
+it here seems more direct.)
 
 \begin{code}
-data  ()  =  ()
+data () = ()
 
 instance Eq () where
     () == () = True
@@ -280,21 +407,50 @@ data Ordering = LT | EQ | GT deriving (Eq, Ord)
 %*********************************************************
 
 \begin{code}
-type  String = [Char]
+type String = [Char]
 
-data Char = C# Char#	deriving (Eq, Ord)
+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
+"x# `gtChar#` x#" forall x#. x# `gtChar#` x# = False
+"x# `geChar#` x#" forall x#. x# `geChar#` x# = True
+"x# `leChar#` x#" forall x#. x# `leChar#` x# = True
+"x# `ltChar#` x#" forall x#. x# `ltChar#` x# = False
+  #-}
 
 chr :: Int -> Char
-chr (I# i) | i >=# 0# && i <=# 255# = C# (chr# i)
-	   | otherwise = error ("Prelude.chr: bad argument")
+chr (I# i#) | int2Word# i# `leWord#` int2Word# 0x10FFFF# = C# (chr# i#)
+            | otherwise                                  = error "Prelude.chr: bad argument"
 
 unsafeChr :: Int -> Char
-unsafeChr (I# i) =  C# (chr# i)
+unsafeChr (I# i#) = C# (chr# i#)
 
 ord :: Char -> Int
-ord (C# c) =  I# (ord# c)
+ord (C# c#) = I# (ord# c#)
 \end{code}
 
+String equality is used when desugaring pattern-matches against strings.
+
+\begin{code}
+eqString :: String -> String -> Bool
+eqString = (==)
+\end{code}
 
 %*********************************************************
 %*							*
@@ -309,52 +465,33 @@ zeroInt, oneInt, twoInt, maxInt, minInt :: Int
 zeroInt = I# 0#
 oneInt  = I# 1#
 twoInt  = I# 2#
-maxInt  = I# (-2147483648#)	-- GHC <= 2.09 had this at -2147483647
-minInt  = I# 2147483647#
+#if WORD_SIZE_IN_BYTES == 4
+minInt  = I# (-0x80000000#)
+maxInt  = I# 0x7FFFFFFF#
+#else
+minInt  = I# (-0x8000000000000000#)
+maxInt  = I# 0x7FFFFFFFFFFFFFFF#
+#endif
 
 instance Eq Int where
-    (==) x y = x `eqInt` y
-    (/=) x y = x `neInt` y
+    (==) = eqInt
+    (/=) = neInt
 
 instance Ord Int where
-    compare x y = compareInt x y 
-
-    (<)  x y = ltInt x y
-    (<=) x y = leInt x y
-    (>=) x y = geInt x y
-    (>)  x y = gtInt x y
+    compare = compareInt
+    (<)     = ltInt
+    (<=)    = leInt
+    (>=)    = geInt
+    (>)     = gtInt
 
 compareInt :: Int -> Int -> Ordering
-(I# x) `compareInt` (I# y) | x <# y    = LT
-			   | x ==# y   = EQ
-			   | otherwise = GT
-\end{code}
-
-
-%*********************************************************
-%*							*
-\subsection{Type @Integer@, @Float@, @Double@}
-%*							*
-%*********************************************************
+(I# x#) `compareInt` (I# y#) = compareInt# x# y#
 
-\begin{code}
-data Float	= F# Float#
-data Double	= D# Double#
-
-data Integer	
-   = S# Int#				-- small integers
-   | J# Int# ByteArray#			-- large integers
-
-instance  Eq Integer  where
-    (S# i)     ==  (S# j)     = i ==# j
-    (S# i)     ==  (J# s d)   = cmpIntegerInt# s d i ==# 0#
-    (J# s d)   ==  (S# i)     = cmpIntegerInt# s d i ==# 0#
-    (J# s1 d1) ==  (J# s2 d2) = (cmpInteger# s1 d1 s2 d2) ==# 0#
-
-    (S# i)     /=  (S# j)     = i /=# j
-    (S# i)     /=  (J# s d)   = cmpIntegerInt# s d i /=# 0#
-    (J# s d)   /=  (S# i)     = cmpIntegerInt# s d i /=# 0#
-    (J# s1 d1) /=  (J# s2 d2) = (cmpInteger# s1 d1 s2 d2) /=# 0#
+compareInt# :: Int# -> Int# -> Ordering
+compareInt# x# y#
+    | x# <#  y# = LT
+    | x# ==# y# = EQ
+    | otherwise = GT
 \end{code}
 
 
@@ -384,6 +521,7 @@ flip f x y		=  f y x
 
 -- right-associating infix application operator (useful in continuation-
 -- passing style)
+{-# INLINE ($) #-}
 ($)			:: (a -> b) -> a -> b
 f $ x			=  f x
 
@@ -401,10 +539,56 @@ asTypeOf		=  const
 
 %*********************************************************
 %*							*
+\subsection{CCallable instances}
+%*							*
+%*********************************************************
+
+Defined here to avoid orphans
+
+\begin{code}
+instance CCallable Char
+instance CReturnable Char
+
+instance CCallable   Int
+instance CReturnable Int
+
+instance CReturnable () -- Why, exactly?
+\end{code}
+
+
+%*********************************************************
+%*							*
+\subsection{Generics}
+%*							*
+%*********************************************************
+
+\begin{code}
+data Unit = Unit
+data a :+: b = Inl a | Inr b
+data a :*: b = a :*: b
+\end{code}
+
+
+%*********************************************************
+%*							*
 \subsection{Numeric primops}
 %*							*
 %*********************************************************
 
+\begin{code}
+divInt#, modInt# :: Int# -> Int# -> Int#
+x# `divInt#` y#
+    | (x# ># 0#) && (y# <# 0#) = ((x# -# y#) -# 1#) `quotInt#` y#
+    | (x# <# 0#) && (y# ># 0#) = ((x# -# y#) +# 1#) `quotInt#` y#
+    | otherwise                = x# `quotInt#` y#
+x# `modInt#` y#
+    | (x# ># 0#) && (y# <# 0#) ||
+      (x# <# 0#) && (y# ># 0#)    = if r# /=# 0# then r# +# y# else 0#
+    | otherwise                   = r#
+    where
+    r# = x# `remInt#` y#
+\end{code}
+
 Definitions of the boxed PrimOps; these will be
 used in the case of partial applications, etc.
 
@@ -422,33 +606,156 @@ used in the case of partial applications, etc.
 {-# INLINE remInt #-}
 {-# INLINE negateInt #-}
 
-plusInt, minusInt, timesInt, quotInt, remInt :: Int -> Int -> Int
-plusInt	(I# x) (I# y) = I# (x +# y)
-minusInt(I# x) (I# y) = I# (x -# y)
-timesInt(I# x) (I# y) = I# (x *# y)
-quotInt	(I# x) (I# y) = I# (quotInt# x y)
-remInt	(I# x) (I# y) = I# (remInt# x y)
+plusInt, minusInt, timesInt, quotInt, remInt, divInt, modInt, gcdInt :: 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)
+(I# x) `quotInt`  (I# y) = I# (x `quotInt#` y)
+(I# x) `remInt`   (I# y) = I# (x `remInt#`  y)
+(I# x) `divInt`   (I# y) = I# (x `divInt#`  y)
+(I# x) `modInt`   (I# y) = I# (x `modInt#`  y)
+
+{-# RULES
+"x# +# 0#" forall x#. x# +# 0# = x#
+"0# +# x#" forall x#. 0# +# x# = x#
+"x# -# 0#" forall x#. x# -# 0# = x#
+"x# -# x#" forall x#. x# -# x# = 0#
+"x# *# 0#" forall x#. x# *# 0# = 0#
+"0# *# x#" forall x#. 0# *# x# = 0#
+"x# *# 1#" forall x#. x# *# 1# = x#
+"1# *# x#" forall x#. 1# *# x# = x#
+  #-}
+
+gcdInt (I# a) (I# b) = g a b
+   where g 0# 0# = error "PrelBase.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)
+negateInt (I# x) = I# (negateInt# x)
 
 gtInt, geInt, eqInt, neInt, ltInt, leInt :: Int -> Int -> Bool
-gtInt	(I# x) (I# y) = x ># y
-geInt	(I# x) (I# y) = x >=# y
-eqInt	(I# x) (I# y) = x ==# y
-neInt	(I# x) (I# y) = x /=# y
-ltInt	(I# x) (I# y) = x <# y
-leInt	(I# x) (I# y) = x <=# y
+(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
+"x# ==# x#" forall x#. x# ==# x# = True
+"x# /=# x#" forall x#. x# /=# x# = False
+"x# <# x#"  forall x#. x# <#  x# = False
+"x# <=# x#" forall x#. x# <=# x# = True
+  #-}
+
+#if WORD_SIZE_IN_BYTES == 4
+{-# RULES
+"intToInt32#"   forall x#. intToInt32#   x# = x#
+"wordToWord32#" forall x#. wordToWord32# x# = x#
+   #-}
+#endif
+
+{-# RULES
+"int2Word2Int"  forall x#. int2Word# (word2Int# x#) = x#
+"word2Int2Word" forall x#. word2Int# (int2Word# x#) = x#
+  #-}
 \end{code}
 
-Convenient boxed Integer PrimOps.  These are 'thin-air' Ids, so
-it's nice to have them in PrelBase.
+
+%********************************************************
+%*							*
+\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}
-{-# INLINE int2Integer #-}
-{-# INLINE addr2Integer #-}
-int2Integer :: Int# -> Integer
-int2Integer  i = S# i
-addr2Integer :: Addr# -> Integer
-addr2Integer x = case addr2Integer# x of (# s, d #) -> J# s d
+unpackCString# :: Addr# -> [Char]
+unpackCString# a = unpackCStringList# a
+
+unpackCStringList# :: Addr# -> [Char]
+unpackCStringList# 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 
+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#) `iShiftL#`  6# +#
+                    (ord# (indexCharOffAddr# addr (nh +# 1#)) -# 0x80#))) :
+          unpack (nh +# 2#)
+      | ch `leChar#` '\xEF'# =
+          C# (chr# ((ord# ch                                  -# 0xE0#) `iShiftL#` 12# +#
+                    (ord# (indexCharOffAddr# addr (nh +# 1#)) -# 0x80#) `iShiftL#`  6# +#
+                    (ord# (indexCharOffAddr# addr (nh +# 2#)) -# 0x80#))) :
+          unpack (nh +# 3#)
+      | otherwise            =
+          C# (chr# ((ord# ch                                  -# 0xF0#) `iShiftL#` 18# +#
+                    (ord# (indexCharOffAddr# addr (nh +# 1#)) -# 0x80#) `iShiftL#` 12# +#
+                    (ord# (indexCharOffAddr# addr (nh +# 2#)) -# 0x80#) `iShiftL#`  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
+"unpack"	 forall a   . unpackCString# a		   = build (unpackFoldrCString# a)
+"unpack-list"    forall a   . unpackFoldrCString# a (:) [] = unpackCStringList# a
+"unpack-append"  forall a n . unpackFoldrCString# a (:) n  = unpackAppendCString# a n
+
+-- There's a built-in rule (in PrelRules.lhs) for
+-- 	unpackFoldr "foo" c (unpackFoldr "baz" c n)  =  unpackFoldr "foobaz" c n
+
+  #-}
 \end{code}