X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Flib%2Fstd%2FPrelBase.lhs;h=cebd1101411d87842fc4eac760cda70615a2f061;hb=42b7210bb5909375da7f918363f9df2010b4aced;hp=90e59bbb9c2f6637be6e54c159e0ff764ea2eb39;hpb=438596897ebbe25a07e1c82085cfbc5bdb00f09e;p=ghc-hetmet.git

diff --git a/ghc/lib/std/PrelBase.lhs b/ghc/lib/std/PrelBase.lhs
index 90e59bb..cebd110 100644
--- a/ghc/lib/std/PrelBase.lhs
+++ b/ghc/lib/std/PrelBase.lhs
@@ -1,147 +1,144 @@
+% -----------------------------------------------------------------------------
+% $Id: PrelBase.lhs,v 1.36 2000/08/29 17:42:17 qrczak Exp $
 %
-% (c) The GRAP/AQUA Project, Glasgow University, 1992-1996
+% (c) The University of Glasgow, 1992-2000
 %
 \section[PrelBase]{Module @PrelBase@}
 
 
-\begin{code}
-{-# OPTIONS -fno-implicit-prelude #-}
+The overall structure of the GHC Prelude is a bit tricky.
 
-module PrelBase
-	(
-	module PrelBase,
-	module PrelGHC		-- Re-export PrelGHC, to avoid lots of people 
-				-- having to import it explicitly
-  ) 
-	where
+  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
 
-import {-# SOURCE #-} PrelErr ( error )
-import PrelGHC
+  b) We want to avoid giant modules
 
-infixr 9  .
-infixl 9  !!
-infixl 7  *
-infixl 6  +, -
-infixr 5  ++, :
-infix  4  ==, /=, <, <=, >=, >
-infixr 3  &&
-infixr 2  ||
-infixl 1  >>, >>=
-infixr 0  $
-\end{code}
+So the rough structure is as follows, in (linearised) dependency order
 
 
-\begin{code}
-{-
-data [] a = [] | a : [a]  -- do explicitly: deriving (Eq, Ord)
-			  -- to avoid weird names like con2tag_[]#
-instance Functor [] where
-    map f []             =  []
-    map f (x:xs)         =  f x : [] -- map f xs
+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
 
-class  Functor f  where
-    map         :: (a -> b) -> f a -> f b
+		Classes: CCallable, CReturnable
 
-class Eval a
+PrelBase	Classes: Eq, Ord, Functor, Monad
+		Types:   list, (), Int, Bool, Ordering, Char, String
 
-data Bool = False | True
-data Int = I# Int#
-data Double	= D# Double#
-data  ()  =  ()  --easier to do explicitly: deriving (Eq, Ord, Enum, Show, Bounded)
-		 -- (avoids weird-named functions, e.g., con2tag_()#
+PrelTup		Types: tuples, plus instances for PrelBase classes
 
-data  Maybe a  =  Nothing | Just a	
-data Ordering = LT | EQ | GT deriving( Eq, Ord )
+PrelShow	Class: Show, plus instances for PrelBase/PrelTup types
 
-type  String = [Char]
+PrelEnum	Class: Enum,  plus instances for PrelBase/PrelTup types
 
-data Char = C# Char#	
+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)
 
--------------- Stage 2 -----------------------
-not True = False
-not False = True
-True  && x		=  x
-False && x		=  False
-otherwise = True
+		Integer is needed here because it is mentioned in the signature
+		of 'fromInteger' in class Num
 
-maybe :: b -> (a -> b) -> Maybe a -> b
-maybe n f Nothing  = n
-maybe n f (Just x) = f x
+PrelReal	Classes: Real, Integral, Fractional, RealFrac
+			 plus instances for Int, Integer
+		Types:  Ratio, Rational
+			plus intances for classes so far
 
--------------- Stage 3 -----------------------
-class  Eq a  where
-    (==), (/=)		:: a -> a -> Bool
+		Rational is needed here because it is mentioned in the signature
+		of 'toRational' in class Real
 
-    x /= y		=  not (x == y)
+Ix		Classes: Ix, plus instances for Int, Bool, Char, Integer, Ordering, tuples
 
--- f :: Eq a => a -> a -> Bool
-f x y = x == y
+PrelArr		Types: Array, MutableArray, MutableVar
 
-g :: Eq a => a -> a -> Bool
-g x y =  f x y 
+		Does *not* contain any ByteArray stuff (see PrelByteArr)
+		Arrays are used by a function in PrelFloat
 
--------------- Stage 4 -----------------------
+PrelFloat	Classes: Floating, RealFloat
+		Types:   Float, Double, plus instances of all classes so far
 
-class  (Eq a) => Ord a  where
-    compare             :: a -> a -> Ordering
-    (<), (<=), (>=), (>):: a -> a -> Bool
-    max, min		:: a -> a -> a
+		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
 
--- 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
+PrelByteArr	Types: ByteArray, MutableByteArray
+		
+		We want this one to be after PrelFloat, because it defines arrays
+		of unboxed floats.
 
-    x <= y  = compare x y /= GT
-    x <	 y  = compare x y == LT
-    x >= y  = compare x y /= LT
-    x >	 y  = compare x y == GT
-    max x y = case (compare x y) of { LT -> y ; EQ -> x ; GT -> x }
-    min x y = case (compare x y) of { LT -> x ; EQ -> x ; GT -> y }
 
-eqInt	(I# x) (I# y) = x ==# y
+Other Prelude modules are much easier with fewer complex dependencies.
 
-instance Eq Int where
-    (==) x y = x `eqInt` y
 
-instance Ord Int where
-    compare x y = error "help"
-  
-class  Bounded a  where
-    minBound, maxBound :: a
+\begin{code}
+{-# OPTIONS -fno-implicit-prelude #-}
 
+module PrelBase
+	(
+	module PrelBase,
+	module PrelGHC,		-- Re-export PrelGHC, PrelErr & PrelNum, to avoid lots
+	module PrelErr,         -- of people having to import it explicitly
+	module PrelNum
+  ) 
+	where
 
-type  ShowS     = String -> String
+import PrelGHC
+import {-# SOURCE #-} PrelErr
+import {-# SOURCE #-} PrelNum
 
-class  Show a  where
-    showsPrec :: Bool -> a -> ShowS
-    showList  :: [a] -> ShowS
+infixr 9  .
+infixr 5  ++, :
+infix  4  ==, /=, <, <=, >=, >
+infixr 3  &&
+infixr 2  ||
+infixl 1  >>, >>=
+infixr 0  $
 
-    showList ls = showList__ (showsPrec True) ls 
+default ()		-- Double isn't available yet
+\end{code}
 
-showList__ :: (a -> ShowS) ->  [a] -> ShowS
-showList__ showx []     = showString "[]"
 
-showString      :: String -> ShowS
-showString      =  (++)
+%*********************************************************
+%*							*
+\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
 
-shows           :: (Show a) => a -> ShowS
-shows           =  showsPrec True
+not True = False
+(&&) True True = True
+otherwise = True
 
--- show            :: (Show a) => a -> String
---show x          =  shows x ""
+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@, @Eval@}
+\subsection{Standard classes @Eq@, @Ord@}
 %*							*
 %*********************************************************
 
@@ -149,7 +146,11 @@ shows           =  showsPrec True
 class  Eq a  where
     (==), (/=)		:: a -> a -> Bool
 
-    x /= y		=  not (x == y)
+--    x /= y		= not (x == y)
+--    x == y		= not (x /= y)
+--    x /= y		=  True
+    (/=) x y            = not  ((==) x y)
+    x == y		=  True
 
 class  (Eq a) => Ord a  where
     compare             :: a -> a -> Ordering
@@ -160,119 +161,46 @@ class  (Eq a) => Ord a  where
 -- Using compare can be more efficient for complex types.
     compare x y
 	    | x == y    = EQ
-	    | x <= y    = LT
+	    | 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  = compare x y /= GT
-    x <	 y  = compare x y == LT
-    x >= y  = compare x y /= LT
-    x >	 y  = compare x y == GT
-    max x y = case (compare x y) of { LT -> y ; EQ -> x ; GT -> x }
-    min x y = case (compare x y) of { LT -> x ; EQ -> x ; GT -> y }
-
-class  Bounded a  where
-    minBound, maxBound :: a
+    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 }
 
--- Leave this in for now; to make it easier to silently
--- discard Evals from Haskell 1.4 contexts
-class Eval a
+	-- 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
 \end{code}
 
 %*********************************************************
 %*							*
-\subsection{Monadic classes @Functor@, @Monad@, @MonadZero@, @MonadPlus@}
+\subsection{Monadic classes @Functor@, @Monad@ }
 %*							*
 %*********************************************************
 
 \begin{code}
 class  Functor f  where
-    map         :: (a -> b) -> f a -> f b
+    fmap        :: (a -> b) -> f a -> f b
 
 class  Monad m  where
     (>>=)       :: m a -> (a -> m b) -> m b
     (>>)        :: m a -> m b -> m b
     return      :: a -> m a
+    fail	:: String -> m a
 
     m >> k      =  m >>= \_ -> k
+    fail s      = error s
 
-class  (Monad m) => MonadZero m  where
-    zero        :: m a
-
-class  (MonadZero m) => MonadPlus m where
-   (++)         :: m a -> m a -> m a
-\end{code}
-
-
-%*********************************************************
-%*							*
-\subsection{Classes @Num@ and @Enum@}
-%*							*
-%*********************************************************
-
-\begin{code}
-class  Enum a	where
-    toEnum              :: Int -> a
-    fromEnum            :: a -> Int
-    enumFrom		:: a -> [a]		-- [n..]
-    enumFromThen	:: a -> a -> [a]	-- [n,n'..]
-    enumFromTo		:: a -> a -> [a]	-- [n..m]
-    enumFromThenTo	:: a -> a -> a -> [a]	-- [n,n'..m]
-
-    enumFromTo n m      =  map toEnum [fromEnum n .. fromEnum m]
-    enumFromThenTo n n' m
-                        =  map toEnum [fromEnum n, fromEnum n' .. fromEnum m]
-
-class  (Eq a, Show a) => Num a  where
-    (+), (-), (*)	:: a -> a -> a
-    negate		:: a -> a
-    abs, signum		:: a -> a
-    fromInteger		:: Integer -> a
-    fromInt		:: Int -> a -- partain: Glasgow extension
-
-    x - y		=  x + negate y
-    fromInt (I# i#)	= fromInteger (case int2Integer# i# of 
-					  (# a, s, d #) -> J# a s d)
-					-- Go via the standard class-op if the
-					-- non-standard one ain't provided
-\end{code}
-
-\begin{code}
-{-# SPECIALISE succ :: Int -> Int #-}
-{-# SPECIALISE pred :: Int -> Int #-}
-succ, pred              :: Enum a => a -> a
-succ                    =  toEnum . (+1) . fromEnum
-pred                    =  toEnum . (subtract 1) . fromEnum
-
-chr = (toEnum   :: Int  -> Char)
-ord = (fromEnum :: Char -> Int)
-
-ord_0 :: Num a => a
-ord_0 = fromInt (ord '0')
-
-{-# SPECIALISE subtract :: Int -> Int -> Int #-}
-subtract	:: (Num a) => a -> a -> a
-subtract x y	=  y - x
 \end{code}
 
 
 %*********************************************************
 %*							*
-\subsection{The @Show@ class}
-%*							*
-%*********************************************************
-
-\begin{code}
-type  ShowS     = String -> String
-
-class  Show a  where
-    showsPrec :: Int -> a -> ShowS
-    showList  :: [a] -> ShowS
-
-    showList ls = showList__ (showsPrec 0) ls 
-\end{code}
-
-%*********************************************************
-%*							*
 \subsection{The list type}
 %*							*
 %*********************************************************
@@ -281,119 +209,138 @@ class  Show a  where
 data [] a = [] | a : [a]  -- 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			
+    _xs    == _ys    = False			
+
     xs     /= ys     = if (xs == ys) then False else True
 
 instance (Ord a) => Ord [a] where
+{-
+    {-# SPECIALISE instance Ord [Char] #-}
+-}
     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  }
 
-    max a b = case compare a b of { LT -> b; EQ -> a;  GT -> a }
-    min a b = case compare a b of { LT -> a; EQ -> a;  GT -> b }
-
     compare []     []     = EQ
-    compare (x:xs) []     = GT
-    compare []     (y:ys) = LT
+    compare (_:_)  []     = GT
+    compare []     (_:_)  = LT
     compare (x:xs) (y:ys) = case compare x y of
                                  LT -> LT	
 			         GT -> GT		
 				 EQ -> compare xs ys
 
 instance Functor [] where
-    map f []             =  []
-    map f (x:xs)         =  f x : map f xs
+    fmap = map
 
 instance  Monad []  where
     m >>= k             = foldr ((++) . k) [] m
     m >> k              = foldr ((++) . (\ _ -> k)) [] m
     return x            = [x]
-
-instance  MonadZero []  where
-    zero                = []
-
-instance  MonadPlus []  where
-#ifdef USE_REPORT_PRELUDE
-    xs ++ ys            =  foldr (:) ys xs
-#else
-    [] ++ ys            =  ys
-    (x:xs) ++ ys        =  x : (xs ++ ys)
-#endif
-
-instance  (Show a) => Show [a]  where
-    showsPrec p         = showList
-    showList  ls	= showList__ (showsPrec 0) ls
-\end{code}
-
+    fail _		= []
 \end{code}
 
 A few list functions that appear here because they are used here.
 The rest of the prelude list functions are in PrelList.
 
+----------------------------------------------
+--	foldr/build/augment
+----------------------------------------------
+  
 \begin{code}
-foldr                   :: (a -> b -> b) -> b -> [a] -> b
-foldr f z []            =  z
-foldr f z (x:xs)        =  f x (foldr f z xs)
-
--- takeWhile, applied to a predicate p and a list xs, returns the longest
--- prefix (possibly empty) of xs of elements that satisfy p.  dropWhile p xs
--- returns the remaining suffix.  Span p xs is equivalent to 
--- (takeWhile p xs, dropWhile p xs), while break p uses the negation of p.
-
-takeWhile               :: (a -> Bool) -> [a] -> [a]
-takeWhile p []          =  []
-takeWhile p (x:xs) 
-            | p x       =  x : takeWhile p xs
-            | otherwise =  []
-
-dropWhile               :: (a -> Bool) -> [a] -> [a]
-dropWhile p []          =  []
-dropWhile p xs@(x:xs')
-            | p x       =  dropWhile p xs'
-            | otherwise =  xs
-
--- List index (subscript) operator, 0-origin
-(!!)                    :: [a] -> Int -> a
-#ifdef USE_REPORT_PRELUDE
-(x:_)  !! 0             =  x
-(_:xs) !! n | n > 0     =  xs !! (n-1)
-(_:_)  !! _             =  error "PreludeList.!!: negative index"
-[]     !! _             =  error "PreludeList.!!: index too large"
-#else
--- HBC version (stolen), then unboxified
--- The semantics is not quite the same for error conditions
--- in the more efficient version.
---
-_      !! n | n < 0  =  error "(!!){PreludeList}: negative index\n"
-xs     !! n          =  sub xs (case n of { I# n# -> n# })
-                           where sub :: [a] -> Int# -> a
-                                 sub []      _ = error "(!!){PreludeList}: index too large\n"
-                                 sub (x:xs) n# = if n# ==# 0#
-						 then x
-						 else sub xs (n# -# 1#)
-#endif
+foldr            :: (a -> b -> b) -> b -> [a] -> b
+-- 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 (x:xs) = x `k` go xs
+
+build 	:: forall a. (forall b. (a -> b -> b) -> b -> b) -> [a]
+{-# 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 2 augment #-}
+augment g xs = g (:) xs
+
+{-# RULES
+"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 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/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}
 
 
-%*********************************************************
-%*							*
-\subsection{Type @Void@}
-%*							*
-%*********************************************************
+----------------------------------------------
+--		map	
+----------------------------------------------
+
+\begin{code}
+map :: (a -> b) -> [a] -> [b]
+map = mapList
+
+-- Note eta expanded
+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
+"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}
 
-The type @Void@ is built in, but it needs a @Show@ instance.
 
+----------------------------------------------
+--		append	
+----------------------------------------------
 \begin{code}
-void :: Void
-void = error "You tried to evaluate void"
+(++) :: [a] -> [a] -> [a]
+(++) = append
+
+{-# RULES
+  "++"	forall xs ys. (++) xs ys = augment (\c n -> foldr c n xs) ys
+ #-}
 
-instance  Show Void  where
-    showsPrec p f  =  showString "<<void>>"
-    showList ls    = showList__ (showsPrec 0) ls
+append :: [a] -> [a] -> [a]
+append []     ys = ys
+append (x:xs) ys = x : append xs ys
 \end{code}
 
 
@@ -404,14 +351,15 @@ instance  Show Void  where
 %*********************************************************
 
 \begin{code}
-data  Bool  =  False | True	deriving (Eq, Ord, Enum, Bounded, Show {- Read -})
+data  Bool  =  False | True  deriving (Eq, Ord)
+	-- Read in PrelRead, Show in PrelShow
 
 -- Boolean functions
 
 (&&), (||)		:: Bool -> Bool -> Bool
 True  && x		=  x
-False && x		=  False
-True  || x		=  True
+False && _		=  False
+True  || _		=  True
 False || x		=  x
 
 not			:: Bool -> Bool
@@ -434,11 +382,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  ()  =  ()  --easier to do explicitly: deriving (Eq, Ord, Enum, Show, Bounded)
-		 -- (avoids weird-named functions, e.g., con2tag_()#
+data  ()  =  ()
 
 instance Eq () where
     () == () = True
@@ -452,21 +399,9 @@ instance Ord () where
     max () () = ()
     min () () = ()
     compare () () = EQ
-
-instance Enum () where
-    toEnum 0    = ()
-    toEnum _	= error "Prelude.Enum.().toEnum: argument not 0"
-    fromEnum () = 0
-    enumFrom () 	= [()]
-    enumFromThen () () 	= [()]
-    enumFromTo () () 	= [()]
-    enumFromThenTo () () () = [()]
-
-instance  Show ()  where
-    showsPrec p () = showString "()"
-    showList ls    = showList__ (showsPrec 0) ls
 \end{code}
 
+
 %*********************************************************
 %*							*
 \subsection{Type @Ordering@}
@@ -474,7 +409,8 @@ instance  Show ()  where
 %*********************************************************
 
 \begin{code}
-data Ordering = LT | EQ | GT	deriving (Eq, Ord, Enum, Bounded, Show {- Read -})
+data Ordering = LT | EQ | GT deriving (Eq, Ord)
+	-- Read in PrelRead, Show in PrelShow
 \end{code}
 
 
@@ -487,97 +423,38 @@ data Ordering = LT | EQ | GT	deriving (Eq, Ord, Enum, Bounded, Show {- Read -})
 \begin{code}
 type  String = [Char]
 
-data Char = C# Char#	deriving (Eq, Ord)
-
-instance  Enum Char  where
-    toEnum   (I# i) | i >=# 0# && i <=# 255# =  C# (chr# i)
-		    | otherwise = error ("Prelude.Enum.Char.toEnum:out of range: " ++ show (I# i))
-    fromEnum (C# c)     	 =  I# (ord# c)
+data Char = C# Char#
 
-    enumFrom   (C# c)	       =  efttCh (ord# c)  1#   (># 255#)
-    enumFromTo (C# c1) (C# c2) = efttCh (ord# c1) 1#  (># (ord# c2))
+-- 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.
 
-    enumFromThen (C# c1) (C# c2)
-	| c1 `leChar#` c2 = efttCh (ord# c1) (ord# c2 -# ord# c1) (># 255#)
-	| otherwise       = efttCh (ord# c1) (ord# c2 -# ord# c1) (<# 0#)
+instance Eq Char where
+  (C# c1) == (C# c2) = c1 `eqChar#` c2
+  (C# c1) /= (C# c2) = c1 `neChar#` c2
 
-    enumFromThenTo (C# c1) (C# c2) (C# c3)
-	| c1 `leChar#` c2 = efttCh (ord# c1) (ord# c2 -# ord# c1) (># (ord# c3))
-	| otherwise       = efttCh (ord# c1) (ord# c2 -# ord# c1) (<# (ord# c3))
+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
 
-efttCh :: Int# -> Int# -> (Int# -> Bool) -> [Char]
-efttCh now step done 
-  = go now
-  where
-    go now | done now  = []
-	   | otherwise = C# (chr# now) : go (now +# step)
+chr :: Int -> Char
+chr (I# i) | i >=# 0#
+#if INT_SIZE_IN_BYTES > 4
+             && i <=# 0x7FFFFFFF#
+#endif
+             = C# (chr# i)
+	   | otherwise = error ("Prelude.chr: bad argument")
 
-instance  Show Char  where
-    showsPrec p '\'' = showString "'\\''"
-    showsPrec p c    = showChar '\'' . showLitChar c . showChar '\''
+unsafeChr :: Int -> Char
+unsafeChr (I# i) =  C# (chr# i)
 
-    showList cs = showChar '"' . showl cs
-		 where showl ""       = showChar '"'
-		       showl ('"':cs) = showString "\\\"" . showl cs
-		       showl (c:cs)   = showLitChar c . showl cs
+ord :: Char -> Int
+ord (C# c) =  I# (ord# c)
 \end{code}
 
 
-\begin{code}
-isAscii, isLatin1, isControl, isPrint, isSpace, isUpper,
- isLower, isAlpha, isDigit, isOctDigit, isHexDigit, isAlphanum :: Char -> Bool
-isAscii c	 	=  fromEnum c < 128
-isLatin1 c              =  c <= '\xff'
-isControl c		=  c < ' ' || c >= '\DEL' && c <= '\x9f'
-isPrint c		=  not (isControl c)
-
--- isSpace includes non-breaking space
--- Done with explicit equalities both for efficiency, and to avoid a tiresome
--- recursion with PrelList elem
-isSpace c		=  c == ' '	||
-			   c == '\t'	||
-			   c == '\n'	||
-			   c == '\r'	||
-			   c == '\f'	||
-			   c == '\v'	||
-			   c == '\xa0'
-
--- The upper case ISO characters have the multiplication sign dumped
--- randomly in the middle of the range.  Go figure.
-isUpper c		=  c >= 'A' && c <= 'Z' || 
-                           c >= '\xC0' && c <= '\xD6' ||
-                           c >= '\xD8' && c <= '\xDE'
--- The lower case ISO characters have the division sign dumped
--- randomly in the middle of the range.  Go figure.
-isLower c		=  c >= 'a' && c <= 'z' ||
-                           c >= '\xDF' && c <= '\xF6' ||
-                           c >= '\xF8' && c <= '\xFF'
-isAlpha c		=  isLower c || isUpper c
-isDigit c		=  c >= '0' && c <= '9'
-isOctDigit c		=  c >= '0' && c <= '7'
-isHexDigit c		=  isDigit c || c >= 'A' && c <= 'F' ||
-                                        c >= 'a' && c <= 'f'
-isAlphanum c		=  isAlpha c || isDigit c
-
--- Case-changing operations
-
-toUpper, toLower	:: Char -> Char
-toUpper c | isLower c	&& c /= '\xDF' && c /= '\xFF'
- =  toEnum (fromEnum c - fromEnum 'a' + fromEnum 'A')
-  | otherwise	=  c
-
-toLower c | isUpper c	=  toEnum (fromEnum c - fromEnum 'A' 
-                                              + fromEnum 'a')
-	  | otherwise	=  c
-
-asciiTab = -- Using an array drags in the array module.  listArray ('\NUL', ' ')
-	   ["NUL", "SOH", "STX", "ETX", "EOT", "ENQ", "ACK", "BEL",
-	    "BS",  "HT",  "LF",  "VT",  "FF",  "CR",  "SO",  "SI", 
-	    "DLE", "DC1", "DC2", "DC3", "DC4", "NAK", "SYN", "ETB",
-	    "CAN", "EM",  "SUB", "ESC", "FS",  "GS",  "RS",  "US", 
-	    "SP"] 
-\end{code}
-
 %*********************************************************
 %*							*
 \subsection{Type @Int@}
@@ -587,6 +464,13 @@ asciiTab = -- Using an array drags in the array module.  listArray ('\NUL', ' ')
 \begin{code}
 data Int = I# Int#
 
+zeroInt, oneInt, twoInt, maxInt, minInt :: Int
+zeroInt = I# 0#
+oneInt  = I# 1#
+twoInt  = I# 2#
+minInt  = I# (-2147483648#)	-- GHC <= 2.09 had this at -2147483647
+maxInt  = I# 2147483647#
+
 instance Eq Int where
     (==) x y = x `eqInt` y
     (/=) x y = x `neInt` y
@@ -598,102 +482,21 @@ instance Ord Int where
     (<=) x y = leInt x y
     (>=) x y = geInt x y
     (>)  x y = gtInt x y
-    max x y = case (compareInt x y) of { LT -> y ; EQ -> x ; GT -> x }
-    min x y = case (compareInt x y) of { LT -> x ; EQ -> x ; GT -> y }
 
+compareInt :: Int -> Int -> Ordering
 (I# x) `compareInt` (I# y) | x <# y    = LT
 			   | x ==# y   = EQ
 			   | otherwise = GT
-
-instance  Enum Int  where
-    toEnum   x = x
-    fromEnum x = x
-
-#ifndef USE_FOLDR_BUILD
-    enumFrom     (I# c)	         = eftInt c  1#
-    enumFromTo   (I# c1) (I# c2) = efttInt c1 1#  (># c2)
-    enumFromThen (I# c1) (I# c2) = eftInt c1 (c2 -# c1)
-
-    enumFromThenTo (I# c1) (I# c2) (I# c3)
-	| c1 <=# c2 = efttInt c1 (c2 -# c1) (># c3)
-	| otherwise = efttInt c1 (c2 -# c1) (<# c3)
-
-#else
-    {-# INLINE enumFrom #-}
-    {-# INLINE enumFromTo #-}
-    enumFrom x           = build (\ c _ -> 
-	let g x = x `c` g (x `plusInt` 1) in g x)
-    enumFromTo x y	 = build (\ c n ->
-	let g x = if x <= y then x `c` g (x `plusInt` 1) else n in g x)
-#endif
-
-efttInt :: Int# -> Int# -> (Int# -> Bool) -> [Int]
-efttInt now step done
-  = go now
-  where
-    go now | done now  = []
-	   | otherwise = I# now : go (now +# step)
-
-eftInt :: Int# -> Int# -> [Int]
-eftInt now step
-  = go now
-  where
-    go now = I# now : go (now +# step)
-
-
-instance  Num Int  where
-    (+)	   x y =  plusInt x y
-    (-)	   x y =  minusInt x y
-    negate x   =  negateInt x
-    (*)	   x y =  timesInt x y
-    abs    n   = if n `geInt` 0 then n else (negateInt n)
-
-    signum n | n `ltInt` 0 = negateInt 1
-	     | n `eqInt` 0 = 0
-	     | otherwise   = 1
-
-    fromInteger (J# a# s# d#)
-      = case (integer2Int# a# s# d#) of { i# -> I# i# }
-
-    fromInt n		= n
-
-instance  Show Int  where
-    showsPrec p n = showSignedInt p n
-    showList ls   = showList__ (showsPrec 0)  ls
 \end{code}
 
 
 %*********************************************************
 %*							*
-\subsection{Type @Integer@, @Float@, @Double@}
-%*							*
-%*********************************************************
-
-\begin{code}
-data Float	= F# Float#
-data Double	= D# Double#
-data Integer	= J# Int# Int# ByteArray#
-
-instance  Eq Integer  where
-    (J# a1 s1 d1) == (J# a2 s2 d2)
-      = (cmpInteger# a1 s1 d1 a2 s2 d2) ==# 0#
-
-    (J# a1 s1 d1) /= (J# a2 s2 d2)
-      = (cmpInteger# a1 s1 d1 a2 s2 d2) /=# 0#
-\end{code}
-
-%*********************************************************
-%*							*
 \subsection{The function type}
 %*							*
 %*********************************************************
 
 \begin{code}
-instance  Show (a -> b)  where
-    showsPrec p f  =  showString "<<function>>"
-    showList ls	   = showList__ (showsPrec 0) ls
-
-
 -- identity function
 id			:: a -> a
 id x			=  x
@@ -728,111 +531,24 @@ asTypeOf		:: a -> a -> a
 asTypeOf		=  const
 \end{code}
 
-
 %*********************************************************
 %*							*
-\subsection{Miscellaneous}
+\subsection{CCallable instances}
 %*							*
 %*********************************************************
 
+Defined here to avoid orphans
 
 \begin{code}
-data Lift a = Lift a
-\end{code}
-
-
-
-
-%*********************************************************
-%*							*
-\subsection{Support code for @Show@}
-%*							*
-%*********************************************************
-
-\begin{code}
-shows           :: (Show a) => a -> ShowS
-shows           =  showsPrec 0
-
-show            :: (Show a) => a -> String
-show x          =  shows x ""
-
-showChar        :: Char -> ShowS
-showChar        =  (:)
-
-showString      :: String -> ShowS
-showString      =  (++)
-
-showParen       :: Bool -> ShowS -> ShowS
-showParen b p   =  if b then showChar '(' . p . showChar ')' else p
-
-showList__ :: (a -> ShowS) ->  [a] -> ShowS
-
-showList__ showx []     = showString "[]"
-showList__ showx (x:xs) = showChar '[' . showx x . showl xs
-  where
-    showl []     = showChar ']'
-    showl (x:xs) = showChar ',' . showx x . showl xs
-
-showSpace :: ShowS
-showSpace = {-showChar ' '-} \ xs -> ' ' : xs
-\end{code}
+instance CCallable Char
+instance CReturnable Char
 
-Code specific for characters
-
-\begin{code}
-showLitChar 		   :: Char -> ShowS
-showLitChar c | c > '\DEL' =  showChar '\\' . protectEsc isDigit (shows (ord c))
-showLitChar '\DEL'	   =  showString "\\DEL"
-showLitChar '\\'	   =  showString "\\\\"
-showLitChar c | c >= ' '   =  showChar c
-showLitChar '\a'	   =  showString "\\a"
-showLitChar '\b'	   =  showString "\\b"
-showLitChar '\f'	   =  showString "\\f"
-showLitChar '\n'	   =  showString "\\n"
-showLitChar '\r'	   =  showString "\\r"
-showLitChar '\t'	   =  showString "\\t"
-showLitChar '\v'	   =  showString "\\v"
-showLitChar '\SO'	   =  protectEsc (== 'H') (showString "\\SO")
-showLitChar c		   =  showString ('\\' : asciiTab!!ord c)
-
-protectEsc p f		   = f . cont
-			     where cont s@(c:_) | p c = "\\&" ++ s
-				   cont s	      = s
-
-intToDigit :: Int -> Char
-intToDigit i
- | i >= 0  && i <=  9   =  toEnum (fromEnum '0' + i)
- | i >= 10 && i <= 15   =  toEnum (fromEnum 'a' + i -10)
- | otherwise		=  error ("Char.intToDigit: not a digit" ++ show i)
+instance CCallable   Int
+instance CReturnable Int
 
+instance CReturnable () -- Why, exactly?
 \end{code}
 
-Code specific for Ints.
-
-\begin{code}
-showSignedInt :: Int -> Int -> ShowS
-showSignedInt p (I# n) r
-  = -- from HBC version; support code follows
-    if n <# 0# && p > 6 then '(':itos n++(')':r) else itos n ++ r
-
-itos :: Int# -> String
-itos n =
-    if n <# 0# then
-	if negateInt# n <# 0# then
-	    -- n is minInt, a difficult number
-	    itos (n `quotInt#` 10#) ++ itos' (negateInt# (n `remInt#` 10#)) []
-	else
-	    '-':itos' (negateInt# n) []
-    else 
-	itos' n []
-  where
-    itos' :: Int# -> String -> String
-    itos' n cs = 
-	if n <# 10# then
-	    C# (chr# (n +# ord# '0'#)) : cs
-	else 
-	    itos' (n `quotInt#` 10#) (C# (chr# (n `remInt#` 10# +# ord# '0'#)) : cs)
-\end{code}
 
 %*********************************************************
 %*							*
@@ -846,13 +562,52 @@ used in the case of partial applications, etc.
 \begin{code}
 {-# INLINE eqInt #-}
 {-# INLINE neInt #-}
-
+{-# INLINE gtInt #-}
+{-# INLINE geInt #-}
+{-# INLINE ltInt #-}
+{-# INLINE leInt #-}
+{-# INLINE plusInt #-}
+{-# INLINE minusInt #-}
+{-# INLINE timesInt #-}
+{-# INLINE quotInt #-}
+{-# INLINE remInt #-}
+{-# INLINE negateInt #-}
+
+plusInt, minusInt, timesInt, quotInt, remInt, gcdInt :: 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)
-negateInt (I# x)      = I# (negateInt# x)
+remInt	(I# x) (I# y) = I# (remInt#  x y)
+
+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)
+
+divInt, modInt :: Int -> Int -> Int
+x `divInt` y 
+  | x > zeroInt && y < zeroInt = quotInt ((x `minusInt` y) `minusInt` oneInt) y
+  | x < zeroInt && y > zeroInt = quotInt ((x `minusInt` y) `plusInt`  oneInt) y
+  | otherwise	   = quotInt x y
+
+x `modInt` y 
+  | x > zeroInt && y < zeroInt || 
+    x < zeroInt && y > zeroInt  = if r/=zeroInt then r `plusInt` y else zeroInt
+  | otherwise	   		= r
+  where
+    r = remInt x y
+
+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
@@ -861,18 +616,104 @@ ltInt	(I# x) (I# y) = x <# y
 leInt	(I# x) (I# y) = x <=# y
 \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  i = case int2Integer#  i of (# a, s, d #) -> J# a s d
-addr2Integer s = case addr2Integer# s of (# a, s, d #) -> J# a s d
-
-integer_0, integer_1, integer_2, integer_m1 :: Integer
-integer_0  = int2Integer 0#
-integer_1  = int2Integer 1#
-integer_2  = int2Integer 2#
-integer_m1 = int2Integer (negateInt# 1#)
+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                                  `iShiftL#`  6#) +#
+                                         (ord# (indexCharOffAddr# addr (nh +# 1#))) -# 0x3080#))
+                               : unpack (nh +# 2#)
+      | ch `leChar#` '\xEF'# = C# (chr# ((ord# ch                                  `iShiftL#` 12#) +#
+                                         (ord# (indexCharOffAddr# addr (nh +# 1#)) `iShiftL#`  6#) +#
+                                         (ord# (indexCharOffAddr# addr (nh +# 2#))) -# 0xE2080#))
+                               : unpack (nh +# 3#)
+      | ch `leChar#` '\xF7'# = C# (chr# ((ord# ch                                  `iShiftL#` 18#) +#
+                                         (ord# (indexCharOffAddr# addr (nh +# 1#)) `iShiftL#` 12#) +#
+                                         (ord# (indexCharOffAddr# addr (nh +# 2#)) `iShiftL#`  6#) +#
+                                         (ord# (indexCharOffAddr# addr (nh +# 3#))) -# 0x3C82080#))
+                               : unpack (nh +# 4#)
+      | ch `leChar#` '\xFB'# = C# (chr# ((ord# ch -# 0xF8#                         `iShiftL#` 24#) +#
+                                         (ord# (indexCharOffAddr# addr (nh +# 1#)) `iShiftL#` 18#) +#
+                                         (ord# (indexCharOffAddr# addr (nh +# 2#)) `iShiftL#` 12#) +#
+                                         (ord# (indexCharOffAddr# addr (nh +# 3#)) `iShiftL#`  6#) +#
+                                         (ord# (indexCharOffAddr# addr (nh +# 4#))) -# 0x2082080#))
+                               : unpack (nh +# 5#)
+      | otherwise           = C# (chr# (((ord# ch -# 0xFC#)                        `iShiftL#` 30#) +#
+                                        ((ord# (indexCharOffAddr# addr (nh +# 1#)) -# 0x80#)
+                                                                                   `iShiftL#` 24#) +#
+                                         (ord# (indexCharOffAddr# addr (nh +# 2#)) `iShiftL#` 18#) +#
+                                         (ord# (indexCharOffAddr# addr (nh +# 3#)) `iShiftL#` 12#) +#
+                                         (ord# (indexCharOffAddr# addr (nh +# 4#)) `iShiftL#`  6#) +#
+                                         (ord# (indexCharOffAddr# addr (nh +# 5#))) -# 0x2082080#))
+                               : unpack (nh +# 6#)
+      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}