[project @ 1997-01-06 17:23:41 by dnt]

The contents of these files are now spread amongst lib/ghc and lib/required

11 files changed, 0 insertions, 5603 deletions

diff --git a/ghc/lib/prelude/GHCbase.hs b/ghc/lib/prelude/GHCbase.hs
deleted file mode 100644
index 5f48825ffc..0000000000
--- a/ghc/lib/prelude/GHCbase.hs
+++ /dev/null
@@ -1,1727 +0,0 @@
-{- The GHCbase module includes all the basic
-   (next-level-above-primitives) GHC-specific code;
-   used to define Prelude.hs, and also other "packagings"
-   of Glasgow extensions.
-   
-   Users should not import it directly.
--}
-module GHCbase where
-
-import Array		( array, bounds, assocs )
-import Char		(isDigit,isUpper,isSpace,isAlphanum,isAlpha,isOctDigit,isHexDigit)
-import Ix
-import Ratio
-import qualified GHCps	( packString, packCBytes, comparePS, unpackPS )
-import qualified GHCio  ( IOError )
-import qualified Monad
-import GHCerr
-
-infixr 0 `seq`, `par`, `fork`
-
-{- =============================================================
-There's a lot in GHCbase.  It's set out as follows:
-
-* Classes (CCallable, CReturnable, ...)
-
-* Types and their instances
-
-* ST, PrimIO, and IO monads
-
-* Basic arrays
-
-* Variables
-
-* Thread waiting
-
-* Other support functions
-
-============================================================= -}
-
-{- =============================================================
-** CLASSES
--}
-
-class CCallable   a
-class CReturnable a
-
-{- =============================================================
-** TYPES and their instances
--}
-data Addr = A# Addr# deriving (Eq, Ord) -- Glasgow extension
-instance CCallable Addr
-instance CReturnable Addr
-
----------------------------------------------------------------
-data Word = W# Word# deriving (Eq, Ord) -- Glasgow extension
-instance CCallable Word
-instance CReturnable Word
-
----------------------------------------------------------------
-data PackedString
-  = PS	ByteArray#  -- the bytes
-	Int#	    -- length (*not* including NUL at the end)
-	Bool	    -- True <=> contains a NUL
-  | CPS	Addr#	    -- pointer to the (null-terminated) bytes in C land
-	Int#	    -- length, as per strlen
-		    -- definitely doesn't contain a NUL
-
-instance Eq PackedString where
-    x == y  = compare x y == EQ
-    x /= y  = compare x y /= EQ
-
-instance Ord PackedString where
-    compare = GHCps.comparePS
-    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 }
-
---instance Read PackedString: ToDo
-
-instance Show PackedString where
-    showsPrec p ps r = showsPrec p (GHCps.unpackPS ps) r
-    showList = showList__ (showsPrec 0) 
-
----------------------------------------------------------------
-data State a = S# (State# a)
-
-data ForeignObj = ForeignObj ForeignObj#
-instance CCallable   ForeignObj
-
-#ifndef __PARALLEL_HASKELL__
-data StablePtr a = StablePtr (StablePtr# a)
-instance CCallable   (StablePtr a)
-instance CReturnable (StablePtr a)
-#endif
-
-eqForeignObj   :: ForeignObj -> ForeignObj -> Bool
-makeForeignObj :: Addr       -> Addr       -> PrimIO ForeignObj
-
-makeForeignObj (A# obj) (A# finaliser) = ST $ \ (S# s#) ->
-    case makeForeignObj# obj finaliser s# of
-      StateAndForeignObj# s1# fo# -> (ForeignObj fo#, S# s1#)
-
-eqForeignObj mp1 mp2
-  = unsafePerformPrimIO (_ccall_ eqForeignObj mp1 mp2) /= (0::Int)
-
-instance Eq ForeignObj where 
-    p == q = eqForeignObj p q
-    p /= q = not (eqForeignObj p q)
-
-#ifndef __PARALLEL_HASKELL__
-
--- Nota Bene: it is important {\em not\/} to inline calls to
--- @makeStablePtr#@ since the corresponding macro is very long and we'll
--- get terrible code-bloat.
-
-makeStablePtr  :: a -> PrimIO (StablePtr a)
-deRefStablePtr :: StablePtr a -> PrimIO a
-freeStablePtr  :: StablePtr a -> PrimIO ()
-
-performGC      :: PrimIO ()
-
-{-# INLINE deRefStablePtr #-}
-{-# INLINE freeStablePtr #-}
-{-# INLINE performGC #-}
-
-makeStablePtr f = ST $ \ (S# rw1#) ->
-    case makeStablePtr# f rw1# of
-      StateAndStablePtr# rw2# sp# -> (StablePtr sp#, S# rw2#)
-
-deRefStablePtr (StablePtr sp#) = ST $ \ (S# rw1#) ->
-    case deRefStablePtr# sp# rw1# of
-      StateAndPtr# rw2# a -> (a, S# rw2#)
-
-freeStablePtr sp = _ccall_ freeStablePointer sp
-
-performGC = _ccall_GC_ StgPerformGarbageCollection
-
-#endif /* !__PARALLEL_HASKELL__ */
-
----------------------------------------------------------------
-data Return2GMPs     = Return2GMPs     Int# Int# ByteArray# Int# Int# ByteArray#
-data ReturnIntAndGMP = ReturnIntAndGMP Int# Int# Int# ByteArray#
-
-data StateAndPtr#    s elt = StateAndPtr#    (State# s) elt 
-
-data StateAndChar#   s     = StateAndChar#   (State# s) Char# 
-data StateAndInt#    s     = StateAndInt#    (State# s) Int# 
-data StateAndWord#   s     = StateAndWord#   (State# s) Word#
-data StateAndFloat#  s     = StateAndFloat#  (State# s) Float# 
-data StateAndDouble# s     = StateAndDouble# (State# s) Double#  
-data StateAndAddr#   s     = StateAndAddr#   (State# s) Addr#
-
-#ifndef __PARALLEL_HASKELL__
-data StateAndStablePtr# s a = StateAndStablePtr# (State# s) (StablePtr# a)
-#endif
-data StateAndForeignObj# s  = StateAndForeignObj# (State# s) ForeignObj#
-
-data StateAndArray#            s elt = StateAndArray#        (State# s) (Array# elt) 
-data StateAndMutableArray#     s elt = StateAndMutableArray# (State# s) (MutableArray# s elt)
-data StateAndByteArray#        s = StateAndByteArray#        (State# s) ByteArray# 
-data StateAndMutableByteArray# s = StateAndMutableByteArray# (State# s) (MutableByteArray# s)
-
-data StateAndSynchVar# s elt = StateAndSynchVar# (State# s) (SynchVar# s elt)
-
----------------------------------------------------------------
-data Lift a = Lift a
-{-# GENERATE_SPECS data a :: Lift a #-}
-
-{- =============================================================
-** ST, PrimIO, and IO monads
--}
-
----------------------------------------------------------------
---The state-transformer proper
--- By default the monad is strict; too many people got bitten by
--- space leaks when it was lazy.
-
-newtype ST s a = ST (State s -> (a, State s))
-
-runST (ST m)
-  = case m (S# realWorld#) of
-      (r,_) -> r
-
-instance Monad (ST s) where
-    {-# INLINE return #-}
-    {-# INLINE (>>)   #-}
-    {-# INLINE (>>=)  #-}
-    return x = ST $ \ s@(S# _) -> (x, s)
-    m >> k   =  m >>= \ _ -> k
-
-    (ST m) >>= k
-      = ST $ \ s ->
-	case (m s) of {(r, new_s) ->
-	case (k r) of { ST k2 ->
-	(k2 new_s) }}
-
-{-# INLINE returnST #-}
-
--- here for backward compatibility:
-returnST :: a -> ST s a
-thenST	 :: ST s a -> (a -> ST s b) -> ST s b
-seqST	 :: ST s a -> ST s b -> ST s b
-
-returnST = return
-thenST   = (>>=)
-seqST	 = (>>)
-
--- not sure whether to 1.3-ize these or what...
-{-# INLINE returnStrictlyST #-}
-{-# INLINE thenStrictlyST #-}
-{-# INLINE seqStrictlyST #-}
-
-{-# GENERATE_SPECS returnStrictlyST a #-}
-returnStrictlyST :: a -> ST s a
-
-{-# GENERATE_SPECS thenStrictlyST a b #-}
-thenStrictlyST :: ST s a -> (a -> ST s b) -> ST s b
-
-{-# GENERATE_SPECS seqStrictlyST a b #-}
-seqStrictlyST :: ST s a -> ST s b -> ST s b
-
-returnStrictlyST a = ST $ \ s@(S# _) -> (a, s)
-
-thenStrictlyST (ST m) k = ST $ \ s ->	-- @(S# _)   Omitted SLPJ [May95] no need to evaluate the state
-    case (m s) of { (r, new_s) ->
-    case (k r) of { ST k2     ->
-    (k2 new_s) }}
-
-seqStrictlyST (ST m) (ST k) = ST $ \ s ->	-- @(S# _)   Omitted SLPJ [May95] no need to evaluate the state
-    case (m s) of { (_, new_s) ->
-    (k new_s) }
-
--- BUILT-IN: runST (see Builtin.hs)
-
-unsafeInterleaveST :: ST s a -> ST s a    -- ToDo: put in state-interface.tex
-unsafeInterleaveST (ST m) = ST $ \ s ->
-    let
-	(r, new_s) = m s
-    in
-    (r, s)
-
-fixST :: (a -> ST s a) -> ST s a
-fixST k = ST $ \ s ->
-    let (ST k_r)  = k r
-	ans       = k_r s
-	(r,new_s) = ans
-    in
-    ans
-
--- more backward compatibility stuff:
-listST		:: [ST s a] -> ST s [a]
-mapST		:: (a -> ST s b) -> [a] -> ST s [b]
-mapAndUnzipST	:: (a -> ST s (b,c)) -> [a] -> ST s ([b],[c])
-
-listST		= accumulate
-mapST		= mapM
-mapAndUnzipST	= Monad.mapAndUnzipL
-
-forkST :: ST s a -> ST s a
-
-#ifndef __CONCURRENT_HASKELL__
-forkST x = x
-#else
-
-forkST (ST action) = ST $ \ s ->
-   let
-    (r, new_s) = action s
-   in
-    new_s `fork__` (r, s)
- where
-    fork__ x y = case (fork# x) of { 0# -> parError; _ -> y }
-
-#endif {- concurrent -}
-
-----------------------------------------------------------------------------
-type PrimIO a = ST RealWorld a
-
-fixPrimIO :: (a -> PrimIO a) -> PrimIO a
-fixPrimIO = fixST
-
-stToIO	   :: ST RealWorld a -> IO a
-primIOToIO :: PrimIO a       -> IO a
-ioToST	   :: IO a -> ST RealWorld a
-ioToPrimIO :: IO a -> PrimIO       a
-
-primIOToIO = stToIO -- for backwards compatibility
-ioToPrimIO = ioToST
-
-stToIO (ST m) = IO $ ST $ \ s ->
-    case (m s) of { (r, new_s) ->
-    (Right r, new_s) }
-
-ioToST (IO (ST io)) = ST $ \ s ->
-    case (io s) of { (r, new_s) ->
-    case r of
-      Right a -> (a, new_s)
-      Left  e -> error ("I/O Error (ioToST): " ++ showsPrec 0 e "\n")
-    }
-
-{-# GENERATE_SPECS unsafePerformPrimIO a #-}
-unsafePerformPrimIO	:: PrimIO a -> a
-unsafeInterleavePrimIO	:: PrimIO a -> PrimIO a
-forkPrimIO		:: PrimIO a -> PrimIO a
-
-unsafePerformPrimIO	= runST
-unsafeInterleavePrimIO	= unsafeInterleaveST
-forkPrimIO		= forkST
-
--- the following functions are now there for backward compatibility mostly:
-
-{-# GENERATE_SPECS returnPrimIO a #-}
-returnPrimIO    :: a -> PrimIO a
-
-{-# GENERATE_SPECS thenPrimIO b #-}
-thenPrimIO      :: PrimIO a -> (a -> PrimIO b) -> PrimIO b
-
-{-# GENERATE_SPECS seqPrimIO b #-}
-seqPrimIO	:: PrimIO a -> PrimIO b -> PrimIO b
-
-listPrimIO	:: [PrimIO a] -> PrimIO [a]
-mapPrimIO	:: (a -> PrimIO b) -> [a] -> PrimIO [b]
-mapAndUnzipPrimIO :: (a -> PrimIO (b,c)) -> [a] -> PrimIO ([b],[c])
-
-{-# INLINE returnPrimIO #-}
-{-# INLINE thenPrimIO   #-}
-{-# INLINE seqPrimIO  #-}
-
-returnPrimIO  	  = return
-thenPrimIO    	  = (>>=)
-seqPrimIO     	  = (>>)
-listPrimIO    	  = accumulate
-mapPrimIO     	  = mapM
-mapAndUnzipPrimIO = Monad.mapAndUnzipL
-
----------------------------------------------------------
-newtype IO a = IO (PrimIO (Either GHCio.IOError a))
-
-instance  Functor IO where
-   map f x = x >>= (return . f)
-
-instance  Monad IO  where
-    {-# INLINE return #-}
-    {-# INLINE (>>)   #-}
-    {-# INLINE (>>=)  #-}
-    m >> k      =  m >>= \ _ -> k
-    return x	= IO $ ST $ \ s@(S# _) -> (Right x, s)
-
-    (IO (ST m)) >>= k
-      = IO $ ST $ \ s ->
-	let  (r, new_s) = m s  in
-	case r of
-	  Left err -> (Left err, new_s)
-	  Right  x -> case (k x) of { IO (ST k2) ->
-		      k2 new_s }
-
-instance  Show (IO a)  where
-    showsPrec p f  = showString "<<IO action>>"
-    showList	   = showList__ (showsPrec 0)
-
-fixIO :: (a -> IO a) -> IO a
-    -- not required but worth having around
-
-fixIO k = IO $ ST $ \ s ->
-    let
-	(IO (ST k_loop)) = k loop
-	result           = k_loop s
-	(Right loop, _)  = result
-    in
-    result
-
-{- =============================================================
-** BASIC ARRAY (and ByteArray) SUPPORT
--}
-
-type IPr = (Int, Int)
-
-data Ix ix => Array      ix elt = Array     (ix,ix) (Array# elt)
-data Ix ix => ByteArray ix      = ByteArray (ix,ix) ByteArray#
-
-instance CCallable (ByteArray ix)
-
-instance  (Ix a, Eq b)  => Eq (Array a b)  where
-    a == a'  	        =  assocs a == assocs a'
-    a /= a'  	        =  assocs a /= assocs a'
-
-instance  (Ix a, Ord b) => Ord (Array a b)  where
-    compare a b = compare (assocs a) (assocs b)
-
-instance  (Ix a, Show a, Show b) => Show (Array a b)  where
-    showsPrec p a = showParen (p > 9) (
-		    showString "array " .
-		    shows (bounds a) . showChar ' ' .
-		    shows (assocs a)                  )
-    showList = showList__ (showsPrec 0)
-
-instance  (Ix a, Read a, Read b) => Read (Array a b)  where
-    readsPrec p = readParen (p > 9)
-	   (\r -> [(array b as, u) | ("array",s) <- lex r,
-				     (b,t)       <- reads s,
-				     (as,u)      <- reads t   ])
-    readList = readList__ (readsPrec 0)
-
------------------------------------------------------------------
--- Mutable arrays
-{-
-Idle ADR question: What's the tradeoff here between flattening these
-datatypes into @MutableArray ix ix (MutableArray# s elt)@ and using
-it as is?  As I see it, the former uses slightly less heap and
-provides faster access to the individual parts of the bounds while the
-code used has the benefit of providing a ready-made @(lo, hi)@ pair as
-required by many array-related functions.  Which wins? Is the
-difference significant (probably not).
-
-Idle AJG answer: When I looked at the outputted code (though it was 2
-years ago) it seems like you often needed the tuple, and we build
-it frequently. Now we've got the overloading specialiser things
-might be different, though.
--}
-
-data Ix ix => MutableArray     s ix elt = MutableArray     (ix,ix) (MutableArray# s elt)
-data Ix ix => MutableByteArray s ix     = MutableByteArray (ix,ix) (MutableByteArray# s)
-
-instance CCallable (MutableByteArray s ix)
-
-newArray :: Ix ix => (ix,ix) -> elt -> ST s (MutableArray s ix elt)
-newCharArray, newIntArray, newAddrArray, newFloatArray, newDoubleArray
-	 :: Ix ix => (ix,ix) -> ST s (MutableByteArray s ix) 
-
-{-# SPECIALIZE newArray      :: IPr       -> elt -> ST s (MutableArray s Int elt),
-				(IPr,IPr) -> elt -> ST s (MutableArray s IPr elt)
-  #-}
-{-# SPECIALIZE newCharArray   :: IPr -> ST s (MutableByteArray s Int) #-}
-{-# SPECIALIZE newIntArray    :: IPr -> ST s (MutableByteArray s Int) #-}
-{-# SPECIALIZE newAddrArray   :: IPr -> ST s (MutableByteArray s Int) #-}
-{-# SPECIALIZE newFloatArray  :: IPr -> ST s (MutableByteArray s Int) #-}
-{-# SPECIALIZE newDoubleArray :: IPr -> ST s (MutableByteArray s Int) #-}
-
-newArray ixs@(ix_start, ix_end) init = ST $ \ (S# s#) ->
-    let n# = case (if null (range ixs)
-		  then 0
-		  else (index ixs ix_end) + 1) of { I# x -> x }
-	-- size is one bigger than index of last elem
-    in
-    case (newArray# n# init s#)     of { StateAndMutableArray# s2# arr# ->
-    (MutableArray ixs arr#, S# s2#)}
-
-newCharArray ixs@(ix_start, ix_end) = ST $ \ (S# s#) ->
-    let n# = case (if null (range ixs)
-		  then 0
-		  else ((index ixs ix_end) + 1)) of { I# x -> x }
-    in
-    case (newCharArray# n# s#)	  of { StateAndMutableByteArray# s2# barr# ->
-    (MutableByteArray ixs barr#, S# s2#)}
-
-newIntArray ixs@(ix_start, ix_end) = ST $ \ (S# s#) ->
-    let n# = case (if null (range ixs)
-		  then 0
-		  else ((index ixs ix_end) + 1)) of { I# x -> x }
-    in
-    case (newIntArray# n# s#)	  of { StateAndMutableByteArray# s2# barr# ->
-    (MutableByteArray ixs barr#, S# s2#)}
-
-newAddrArray ixs@(ix_start, ix_end) = ST $ \ (S# s#) ->
-    let n# = case (if null (range ixs)
-		  then 0
-		  else ((index ixs ix_end) + 1)) of { I# x -> x }
-    in
-    case (newAddrArray# n# s#)	  of { StateAndMutableByteArray# s2# barr# ->
-    (MutableByteArray ixs barr#, S# s2#)}
-
-newFloatArray ixs@(ix_start, ix_end) = ST $ \ (S# s#) ->
-    let n# = case (if null (range ixs)
-		  then 0
-		  else ((index ixs ix_end) + 1)) of { I# x -> x }
-    in
-    case (newFloatArray# n# s#)	  of { StateAndMutableByteArray# s2# barr# ->
-    (MutableByteArray ixs barr#, S# s2#)}
-
-newDoubleArray ixs@(ix_start, ix_end) = ST $ \ (S# s#) ->
-    let n# = case (if null (range ixs)
-		  then 0
-		  else ((index ixs ix_end) + 1)) of { I# x -> x }
-    in
-    case (newDoubleArray# n# s#)  of { StateAndMutableByteArray# s2# barr# ->
-    (MutableByteArray ixs barr#, S# s2#)}
-
-boundsOfArray     :: Ix ix => MutableArray s ix elt -> (ix, ix)  
-boundsOfByteArray :: Ix ix => MutableByteArray s ix -> (ix, ix)
-
-{-# SPECIALIZE boundsOfArray     :: MutableArray s Int elt -> IPr #-}
-{-# SPECIALIZE boundsOfByteArray :: MutableByteArray s Int -> IPr #-}
-
-boundsOfArray     (MutableArray     ixs _) = ixs
-boundsOfByteArray (MutableByteArray ixs _) = ixs
-
-readArray   	:: Ix ix => MutableArray s ix elt -> ix -> ST s elt 
-
-readCharArray   :: Ix ix => MutableByteArray s ix -> ix -> ST s Char 
-readIntArray    :: Ix ix => MutableByteArray s ix -> ix -> ST s Int
-readAddrArray   :: Ix ix => MutableByteArray s ix -> ix -> ST s Addr
-readFloatArray  :: Ix ix => MutableByteArray s ix -> ix -> ST s Float
-readDoubleArray :: Ix ix => MutableByteArray s ix -> ix -> ST s Double
-
-{-# SPECIALIZE readArray       :: MutableArray s Int elt -> Int -> ST s elt,
-				  MutableArray s IPr elt -> IPr -> ST s elt
-  #-}
-{-# SPECIALIZE readCharArray   :: MutableByteArray s Int -> Int -> ST s Char #-}
-{-# SPECIALIZE readIntArray    :: MutableByteArray s Int -> Int -> ST s Int #-}
-{-# SPECIALIZE readAddrArray   :: MutableByteArray s Int -> Int -> ST s Addr #-}
---NO:{-# SPECIALIZE readFloatArray  :: MutableByteArray s Int -> Int -> ST s Float #-}
-{-# SPECIALIZE readDoubleArray :: MutableByteArray s Int -> Int -> ST s Double #-}
-
-readArray (MutableArray ixs arr#) n = ST $ \ (S# s#) ->
-    case (index ixs n)	    	of { I# n# ->
-    case readArray# arr# n# s#	of { StateAndPtr# s2# r ->
-    (r, S# s2#)}}
-
-readCharArray (MutableByteArray ixs barr#) n = ST $ \ (S# s#) ->
-    case (index ixs n)	    	    	of { I# n# ->
-    case readCharArray# barr# n# s#	of { StateAndChar# s2# r# ->
-    (C# r#, S# s2#)}}
-
-readIntArray (MutableByteArray ixs barr#) n = ST $ \ (S# s#) ->
-    case (index ixs n)	    	    	of { I# n# ->
-    case readIntArray# barr# n# s#	of { StateAndInt# s2# r# ->
-    (I# r#, S# s2#)}}
-
-readAddrArray (MutableByteArray ixs barr#) n = ST $ \ (S# s#) ->
-    case (index ixs n)	    	    	of { I# n# ->
-    case readAddrArray# barr# n# s#	of { StateAndAddr# s2# r# ->
-    (A# r#, S# s2#)}}
-
-readFloatArray (MutableByteArray ixs barr#) n = ST $ \ (S# s#) ->
-    case (index ixs n)	    	    	of { I# n# ->
-    case readFloatArray# barr# n# s#	of { StateAndFloat# s2# r# ->
-    (F# r#, S# s2#)}}
-
-readDoubleArray (MutableByteArray ixs barr#) n = ST $ \ (S# s#) ->
-    case (index ixs n) 	    	    	of { I# n# ->
-    case readDoubleArray# barr# n# s#	of { StateAndDouble# s2# r# ->
-    (D# r#, S# s2#)}}
-
---Indexing of ordinary @Arrays@ is standard Haskell and isn't defined here.
-indexCharArray   :: Ix ix => ByteArray ix -> ix -> Char 
-indexIntArray    :: Ix ix => ByteArray ix -> ix -> Int
-indexAddrArray   :: Ix ix => ByteArray ix -> ix -> Addr
-indexFloatArray  :: Ix ix => ByteArray ix -> ix -> Float
-indexDoubleArray :: Ix ix => ByteArray ix -> ix -> Double
-
-{-# SPECIALIZE indexCharArray   :: ByteArray Int -> Int -> Char #-}
-{-# SPECIALIZE indexIntArray    :: ByteArray Int -> Int -> Int #-}
-{-# SPECIALIZE indexAddrArray   :: ByteArray Int -> Int -> Addr #-}
---NO:{-# SPECIALIZE indexFloatArray  :: ByteArray Int -> Int -> Float #-}
-{-# SPECIALIZE indexDoubleArray :: ByteArray Int -> Int -> Double #-}
-
-indexCharArray (ByteArray ixs barr#) n
-  = case (index ixs n)	    	    	of { I# n# ->
-    case indexCharArray# barr# n# 	of { r# ->
-    (C# r#)}}
-
-indexIntArray (ByteArray ixs barr#) n
-  = case (index ixs n)	    	    	of { I# n# ->
-    case indexIntArray# barr# n# 	of { r# ->
-    (I# r#)}}
-
-indexAddrArray (ByteArray ixs barr#) n
-  = case (index ixs n)	    	    	of { I# n# ->
-    case indexAddrArray# barr# n# 	of { r# ->
-    (A# r#)}}
-
-indexFloatArray (ByteArray ixs barr#) n
-  = case (index ixs n)	    	    	of { I# n# ->
-    case indexFloatArray# barr# n# 	of { r# ->
-    (F# r#)}}
-
-indexDoubleArray (ByteArray ixs barr#) n
-  = case (index ixs n) 	    	    	of { I# n# ->
-    case indexDoubleArray# barr# n# 	of { r# ->
-    (D# r#)}}
-
---Indexing off @Addrs@ is similar, and therefore given here.
-indexCharOffAddr   :: Addr -> Int -> Char
-indexIntOffAddr    :: Addr -> Int -> Int
-indexAddrOffAddr   :: Addr -> Int -> Addr
-indexFloatOffAddr  :: Addr -> Int -> Float
-indexDoubleOffAddr :: Addr -> Int -> Double
-
-indexCharOffAddr (A# addr#) n
-  = case n  	    		    	of { I# n# ->
-    case indexCharOffAddr# addr# n# 	of { r# ->
-    (C# r#)}}
-
-indexIntOffAddr (A# addr#) n
-  = case n  	    		    	of { I# n# ->
-    case indexIntOffAddr# addr# n# 	of { r# ->
-    (I# r#)}}
-
-indexAddrOffAddr (A# addr#) n
-  = case n  	    	    	    	of { I# n# ->
-    case indexAddrOffAddr# addr# n# 	of { r# ->
-    (A# r#)}}
-
-indexFloatOffAddr (A# addr#) n
-  = case n  	    		    	of { I# n# ->
-    case indexFloatOffAddr# addr# n# 	of { r# ->
-    (F# r#)}}
-
-indexDoubleOffAddr (A# addr#) n
-  = case n  	    	 	    	of { I# n# ->
-    case indexDoubleOffAddr# addr# n# 	of { r# ->
-    (D# r#)}}
-
-writeArray  	 :: Ix ix => MutableArray s ix elt -> ix -> elt -> ST s () 
-writeCharArray   :: Ix ix => MutableByteArray s ix -> ix -> Char -> ST s () 
-writeIntArray    :: Ix ix => MutableByteArray s ix -> ix -> Int  -> ST s () 
-writeAddrArray   :: Ix ix => MutableByteArray s ix -> ix -> Addr -> ST s () 
-writeFloatArray  :: Ix ix => MutableByteArray s ix -> ix -> Float -> ST s () 
-writeDoubleArray :: Ix ix => MutableByteArray s ix -> ix -> Double -> ST s () 
-
-{-# SPECIALIZE writeArray  	:: MutableArray s Int elt -> Int -> elt -> ST s (),
-				   MutableArray s IPr elt -> IPr -> elt -> ST s ()
-  #-}
-{-# SPECIALIZE writeCharArray   :: MutableByteArray s Int -> Int -> Char -> ST s () #-}
-{-# SPECIALIZE writeIntArray    :: MutableByteArray s Int -> Int -> Int  -> ST s () #-}
-{-# SPECIALIZE writeAddrArray   :: MutableByteArray s Int -> Int -> Addr -> ST s () #-}
---NO:{-# SPECIALIZE writeFloatArray  :: MutableByteArray s Int -> Int -> Float -> ST s () #-}
-{-# SPECIALIZE writeDoubleArray :: MutableByteArray s Int -> Int -> Double -> ST s () #-}
-
-writeArray (MutableArray ixs arr#) n ele = ST $ \ (S# s#) ->
-    case index ixs n		    of { I# n# ->
-    case writeArray# arr# n# ele s# of { s2# ->
-    ((), S# s2#)}}
-
-writeCharArray (MutableByteArray ixs barr#) n (C# ele) = ST $ \ (S# s#) ->
-    case (index ixs n)	    	    	    of { I# n# ->
-    case writeCharArray# barr# n# ele s#    of { s2#   ->
-    ((), S# s2#)}}
-
-writeIntArray (MutableByteArray ixs barr#) n (I# ele) = ST $ \ (S# s#) ->
-    case (index ixs n)	    	    	    of { I# n# ->
-    case writeIntArray# barr# n# ele s#     of { s2#   ->
-    ((), S# s2#)}}
-
-writeAddrArray (MutableByteArray ixs barr#) n (A# ele) = ST $ \ (S# s#) ->
-    case (index ixs n)	    	    	    of { I# n# ->
-    case writeAddrArray# barr# n# ele s#    of { s2#   ->
-    ((), S# s2#)}}
-
-writeFloatArray (MutableByteArray ixs barr#) n (F# ele) = ST $ \ (S# s#) ->
-    case (index ixs n)	    	    	    of { I# n# ->
-    case writeFloatArray# barr# n# ele s#   of { s2#   ->
-    ((), S# s2#)}}
-
-writeDoubleArray (MutableByteArray ixs barr#) n (D# ele) = ST $ \ (S# s#) ->
-    case (index ixs n)	    	    	    of { I# n# ->
-    case writeDoubleArray# barr# n# ele s#  of { s2#   ->
-    ((), S# s2#)}}
-
-freezeArray	  :: Ix ix => MutableArray s ix elt -> ST s (Array ix elt)
-freezeCharArray   :: Ix ix => MutableByteArray s ix -> ST s (ByteArray ix)
-freezeIntArray    :: Ix ix => MutableByteArray s ix -> ST s (ByteArray ix)
-freezeAddrArray   :: Ix ix => MutableByteArray s ix -> ST s (ByteArray ix)
-freezeFloatArray  :: Ix ix => MutableByteArray s ix -> ST s (ByteArray ix)
-freezeDoubleArray :: Ix ix => MutableByteArray s ix -> ST s (ByteArray ix)
-
-{-# SPECIALISE freezeArray :: MutableArray s Int elt -> ST s (Array Int elt),
-			      MutableArray s IPr elt -> ST s (Array IPr elt)
-  #-}
-{-# SPECIALISE freezeCharArray :: MutableByteArray s Int -> ST s (ByteArray Int) #-}
-
-freezeArray (MutableArray ixs@(ix_start, ix_end) arr#) = ST $ \ (S# s#) ->
-    let n# = case (if null (range ixs)
-		  then 0
-		  else (index ixs ix_end) + 1) of { I# x -> x }
-    in
-    case freeze arr# n# s# of { StateAndArray# s2# frozen# ->
-    (Array ixs frozen#, S# s2#)}
-  where
-    freeze  :: MutableArray# s ele	-- the thing
-	    -> Int#			-- size of thing to be frozen
-	    -> State# s			-- the Universe and everything
-	    -> StateAndArray# s ele
-
-    freeze arr# n# s#
-      = case newArray# n# init s#	      of { StateAndMutableArray# s2# newarr1# ->
-	case copy 0# n# arr# newarr1# s2#     of { StateAndMutableArray# s3# newarr2# ->
-	unsafeFreezeArray# newarr2# s3#
-	}}
-      where
-	init = error "freezeArray: element not copied"
-
-	copy :: Int# -> Int#
-	     -> MutableArray# s ele -> MutableArray# s ele
-	     -> State# s
-	     -> StateAndMutableArray# s ele
-
-	copy cur# end# from# to# s#
-	  | cur# ==# end#
-	    = StateAndMutableArray# s# to#
-	  | True
-	    = case readArray#  from# cur#     s#  of { StateAndPtr# s1# ele ->
-	      case writeArray# to#   cur# ele s1# of { s2# ->
-	      copy (cur# +# 1#) end# from# to# s2#
-	      }}
-
-freezeCharArray (MutableByteArray ixs@(ix_start, ix_end) arr#) = ST $ \ (S# s#) ->
-    let n# = case (if null (range ixs)
-		  then 0
-		  else ((index ixs ix_end) + 1)) of { I# x -> x }
-    in
-    case freeze arr# n# s# of { StateAndByteArray# s2# frozen# ->
-    (ByteArray ixs frozen#, S# s2#) }
-  where
-    freeze  :: MutableByteArray# s	-- the thing
-	    -> Int#			-- size of thing to be frozen
-	    -> State# s			-- the Universe and everything
-	    -> StateAndByteArray# s
-
-    freeze arr# n# s#
-      = case (newCharArray# n# s#)    	   of { StateAndMutableByteArray# s2# newarr1# ->
-	case copy 0# n# arr# newarr1# s2#  of { StateAndMutableByteArray# s3# newarr2# ->
-	unsafeFreezeByteArray# newarr2# s3#
-	}}
-      where
-	copy :: Int# -> Int#
-	     -> MutableByteArray# s -> MutableByteArray# s
-	     -> State# s
-	     -> StateAndMutableByteArray# s
-
-	copy cur# end# from# to# s#
-	  | cur# ==# end#
-	    = StateAndMutableByteArray# s# to#
-	  | True
-	    = case (readCharArray#  from# cur#     s#)  of { StateAndChar# s1# ele ->
-	      case (writeCharArray# to#   cur# ele s1#) of { s2# ->
-	      copy (cur# +# 1#) end# from# to# s2#
-	      }}
-
-freezeIntArray (MutableByteArray ixs@(ix_start, ix_end) arr#) = ST $ \ (S# s#) ->
-    let n# = case (if null (range ixs)
-		  then 0
-		  else ((index ixs ix_end) + 1)) of { I# x -> x }
-    in
-    case freeze arr# n# s# of { StateAndByteArray# s2# frozen# ->
-    (ByteArray ixs frozen#, S# s2#) }
-  where
-    freeze  :: MutableByteArray# s	-- the thing
-	    -> Int#			-- size of thing to be frozen
-	    -> State# s			-- the Universe and everything
-	    -> StateAndByteArray# s
-
-    freeze arr# n# s#
-      = case (newIntArray# n# s#)    	   of { StateAndMutableByteArray# s2# newarr1# ->
-	case copy 0# n# arr# newarr1# s2#  of { StateAndMutableByteArray# s3# newarr2# ->
-	unsafeFreezeByteArray# newarr2# s3#
-	}}
-      where
-	copy :: Int# -> Int#
-	     -> MutableByteArray# s -> MutableByteArray# s
-	     -> State# s
-	     -> StateAndMutableByteArray# s
-
-	copy cur# end# from# to# s#
-	  | cur# ==# end#
-	    = StateAndMutableByteArray# s# to#
-	  | True
-	    = case (readIntArray#  from# cur#     s#)  of { StateAndInt# s1# ele ->
-	      case (writeIntArray# to#   cur# ele s1#) of { s2# ->
-	      copy (cur# +# 1#) end# from# to# s2#
-	      }}
-
-freezeAddrArray (MutableByteArray ixs@(ix_start, ix_end) arr#) = ST $ \ (S# s#) ->
-    let n# = case (if null (range ixs)
-		  then 0
-		  else ((index ixs ix_end) + 1)) of { I# x -> x }
-    in
-    case freeze arr# n# s# of { StateAndByteArray# s2# frozen# ->
-    (ByteArray ixs frozen#, S# s2#) }
-  where
-    freeze  :: MutableByteArray# s	-- the thing
-	    -> Int#			-- size of thing to be frozen
-	    -> State# s			-- the Universe and everything
-	    -> StateAndByteArray# s
-
-    freeze arr# n# s#
-      = case (newAddrArray# n# s#)    	   of { StateAndMutableByteArray# s2# newarr1# ->
-	case copy 0# n# arr# newarr1# s2#  of { StateAndMutableByteArray# s3# newarr2# ->
-	unsafeFreezeByteArray# newarr2# s3#
-	}}
-      where
-	copy :: Int# -> Int#
-	     -> MutableByteArray# s -> MutableByteArray# s
-	     -> State# s
-	     -> StateAndMutableByteArray# s
-
-	copy cur# end# from# to# s#
-	  | cur# ==# end#
-	    = StateAndMutableByteArray# s# to#
-	  | True
-	    = case (readAddrArray#  from# cur#     s#)  of { StateAndAddr# s1# ele ->
-	      case (writeAddrArray# to#   cur# ele s1#) of { s2# ->
-	      copy (cur# +# 1#) end# from# to# s2#
-	      }}
-
-freezeFloatArray (MutableByteArray ixs@(ix_start, ix_end) arr#) = ST $ \ (S# s#) ->
-    let n# = case (if null (range ixs)
-		  then 0
-		  else ((index ixs ix_end) + 1)) of { I# x -> x }
-    in
-    case freeze arr# n# s# of { StateAndByteArray# s2# frozen# ->
-    (ByteArray ixs frozen#, S# s2#) }
-  where
-    freeze  :: MutableByteArray# s	-- the thing
-	    -> Int#			-- size of thing to be frozen
-	    -> State# s			-- the Universe and everything
-	    -> StateAndByteArray# s
-
-    freeze arr# n# s#
-      = case (newFloatArray# n# s#)    	   of { StateAndMutableByteArray# s2# newarr1# ->
-	case copy 0# n# arr# newarr1# s2#  of { StateAndMutableByteArray# s3# newarr2# ->
-	unsafeFreezeByteArray# newarr2# s3#
-	}}
-      where
-	copy :: Int# -> Int#
-	     -> MutableByteArray# s -> MutableByteArray# s
-	     -> State# s
-	     -> StateAndMutableByteArray# s
-
-	copy cur# end# from# to# s#
-	  | cur# ==# end#
-	    = StateAndMutableByteArray# s# to#
-	  | True
-	    = case (readFloatArray#  from# cur#     s#)  of { StateAndFloat# s1# ele ->
-	      case (writeFloatArray# to#   cur# ele s1#) of { s2# ->
-	      copy (cur# +# 1#) end# from# to# s2#
-	      }}
-
-freezeDoubleArray (MutableByteArray ixs@(ix_start, ix_end) arr#) = ST $ \ (S# s#) ->
-    let n# = case (if null (range ixs)
-		  then 0
-		  else ((index ixs ix_end) + 1)) of { I# x -> x }
-    in
-    case freeze arr# n# s# of { StateAndByteArray# s2# frozen# ->
-    (ByteArray ixs frozen#, S# s2#) }
-  where
-    freeze  :: MutableByteArray# s	-- the thing
-	    -> Int#			-- size of thing to be frozen
-	    -> State# s			-- the Universe and everything
-	    -> StateAndByteArray# s
-
-    freeze arr# n# s#
-      = case (newDoubleArray# n# s#)   	   of { StateAndMutableByteArray# s2# newarr1# ->
-	case copy 0# n# arr# newarr1# s2#  of { StateAndMutableByteArray# s3# newarr2# ->
-	unsafeFreezeByteArray# newarr2# s3#
-	}}
-      where
-	copy :: Int# -> Int#
-	     -> MutableByteArray# s -> MutableByteArray# s
-	     -> State# s
-	     -> StateAndMutableByteArray# s
-
-	copy cur# end# from# to# s#
-	  | cur# ==# end#
-	    = StateAndMutableByteArray# s# to#
-	  | True
-	    = case (readDoubleArray#  from# cur#     s#)  of { StateAndDouble# s1# ele ->
-	      case (writeDoubleArray# to#   cur# ele s1#) of { s2# ->
-	      copy (cur# +# 1#) end# from# to# s2#
-	      }}
-
-unsafeFreezeArray     :: Ix ix => MutableArray s ix elt -> ST s (Array ix elt)  
-unsafeFreezeByteArray :: Ix ix => MutableByteArray s ix -> ST s (ByteArray ix)
-
-{-# SPECIALIZE unsafeFreezeByteArray :: MutableByteArray s Int -> ST s (ByteArray Int)
-  #-}
-
-unsafeFreezeArray (MutableArray ixs arr#) = ST $ \ (S# s#) ->
-    case unsafeFreezeArray# arr# s# of { StateAndArray# s2# frozen# ->
-    (Array ixs frozen#, S# s2#) }
-
-unsafeFreezeByteArray (MutableByteArray ixs arr#) = ST $ \ (S# s#) ->
-    case unsafeFreezeByteArray# arr# s# of { StateAndByteArray# s2# frozen# ->
-    (ByteArray ixs frozen#, S# s2#) }
-
-
---This takes a immutable array, and copies it into a mutable array, in a
---hurry.
-
-{-# SPECIALISE thawArray :: Array Int elt -> ST s (MutableArray s Int elt),
-			    Array IPr elt -> ST s (MutableArray s IPr elt)
-  #-}
-
-thawArray (Array ixs@(ix_start, ix_end) arr#) = ST $ \ (S# s#) ->
-    let n# = case (if null (range ixs)
-		  then 0
-		  else (index ixs ix_end) + 1) of { I# x -> x }
-    in
-    case thaw arr# n# s# of { StateAndMutableArray# s2# thawed# ->
-    (MutableArray ixs thawed#, S# s2#)}
-  where
-    thaw  :: Array# ele			-- the thing
-	    -> Int#			-- size of thing to be thawed
-	    -> State# s			-- the Universe and everything
-	    -> StateAndMutableArray# s ele
-
-    thaw arr# n# s#
-      = case newArray# n# init s#	      of { StateAndMutableArray# s2# newarr1# ->
-	copy 0# n# arr# newarr1# s2# }
-      where
-	init = error "thawArray: element not copied"
-
-	copy :: Int# -> Int#
-	     -> Array# ele 
-	     -> MutableArray# s ele
-	     -> State# s
-	     -> StateAndMutableArray# s ele
-
-	copy cur# end# from# to# s#
-	  | cur# ==# end#
-	    = StateAndMutableArray# s# to#
-	  | True
-	    = case indexArray#  from# cur#       of { Lift ele ->
-	      case writeArray# to#   cur# ele s# of { s1# ->
-	      copy (cur# +# 1#) end# from# to# s1#
-	      }}
-
-sameMutableArray     :: MutableArray s ix elt -> MutableArray s ix elt -> Bool
-sameMutableByteArray :: MutableByteArray s ix -> MutableByteArray s ix -> Bool
-
-sameMutableArray (MutableArray _ arr1#) (MutableArray _ arr2#)
-  = sameMutableArray# arr1# arr2#
-
-sameMutableByteArray (MutableByteArray _ arr1#) (MutableByteArray _ arr2#)
-  = sameMutableByteArray# arr1# arr2#
-
-{- =============================================================
-** VARIABLES, including MVars and IVars
--}
-
---************************************************************************
--- Variables
-
-type MutableVar s a = MutableArray s Int a
-
-newVar   :: a -> ST s (MutableVar s a)
-readVar  :: MutableVar s a -> ST s a
-writeVar :: MutableVar s a -> a -> ST s ()
-sameVar  :: MutableVar s a -> MutableVar s a -> Bool
-
-newVar init = ST $ \ (S# s#) ->
-    case (newArray# 1# init s#)     of { StateAndMutableArray# s2# arr# ->
-    (MutableArray vAR_IXS arr#, S# s2#) }
-  where
-    vAR_IXS = error "newVar: Shouldn't access `bounds' of a MutableVar\n"
-
-readVar (MutableArray _ var#) = ST $ \ (S# s#) ->
-    case readArray# var# 0# s#	of { StateAndPtr# s2# r ->
-    (r, S# s2#) }
-
-writeVar (MutableArray _ var#) val = ST $ \ (S# s#) ->
-    case writeArray# var# 0# val s# of { s2# ->
-    ((), S# s2#) }
-
-sameVar (MutableArray _ var1#) (MutableArray _ var2#)
-  = sameMutableArray# var1# var2#
-
---%************************************************************************
---%*									*
---\subsection[PreludeGlaST-mvars]{M-Structures}
---%*									*
---%************************************************************************
-{-
-M-Vars are rendezvous points for concurrent threads.  They begin
-empty, and any attempt to read an empty M-Var blocks.  When an M-Var
-is written, a single blocked thread may be freed.  Reading an M-Var
-toggles its state from full back to empty.  Therefore, any value
-written to an M-Var may only be read once.  Multiple reads and writes
-are allowed, but there must be at least one read between any two
-writes.
--}
-
-data MVar a = MVar (SynchVar# RealWorld a)
-
-newEmptyMVar  :: IO (MVar a)
-
-newEmptyMVar = IO $ ST $ \ (S# s#) ->
-    case newSynchVar# s# of
-        StateAndSynchVar# s2# svar# -> (Right (MVar svar#), S# s2#)
-
-takeMVar :: MVar a -> IO a
-
-takeMVar (MVar mvar#) = IO $ ST $ \ (S# s#) ->
-    case takeMVar# mvar# s# of
-        StateAndPtr# s2# r -> (Right r, S# s2#)
-
-putMVar  :: MVar a -> a -> IO ()
-
-putMVar (MVar mvar#) x = IO $ ST $ \ (S# s#) ->
-    case putMVar# mvar# x s# of
-        s2# -> (Right (), S# s2#)
-
-newMVar :: a -> IO (MVar a)
-
-newMVar value =
-    newEmptyMVar	>>= \ mvar ->
-    putMVar mvar value	>>
-    return mvar
-
-readMVar :: MVar a -> IO a
-
-readMVar mvar =
-    takeMVar mvar	>>= \ value ->
-    putMVar mvar value	>>
-    return value
-
-swapMVar :: MVar a -> a -> IO a
-
-swapMVar mvar new =
-    takeMVar mvar	>>= \ old ->
-    putMVar mvar new	>>
-    return old
-
---%************************************************************************
---%*									*
---\subsection[PreludeGlaST-ivars]{I-Structures}
---%*									*
---%************************************************************************
-{-
-I-Vars are write-once variables.  They start out empty, and any threads that 
-attempt to read them will block until they are filled.  Once they are written, 
-any blocked threads are freed, and additional reads are permitted.  Attempting 
-to write a value to a full I-Var results in a runtime error.
--}
-data IVar a = IVar (SynchVar# RealWorld a)
-
-newIVar :: IO (IVar a)
-
-newIVar = IO $ ST $ \ (S# s#) ->
-    case newSynchVar# s# of
-        StateAndSynchVar# s2# svar# -> (Right (IVar svar#), S# s2#)
-
-readIVar :: IVar a -> IO a
-
-readIVar (IVar ivar#) = IO $ ST $ \ (S# s#) ->
-    case readIVar# ivar# s# of
-        StateAndPtr# s2# r -> (Right r, S# s2#)
-
-writeIVar :: IVar a -> a -> IO ()
-
-writeIVar (IVar ivar#) x = IO $ ST $ \ (S# s#) ->
-    case writeIVar# ivar# x s# of
-        s2# -> (Right (), S# s2#)
-
-{- =============================================================
-** THREAD WAITING
--}
-
-{-
-@threadDelay@ delays rescheduling of a thread until the indicated
-number of microseconds have elapsed.  Generally, the microseconds are
-counted by the context switch timer, which ticks in virtual time;
-however, when there are no runnable threads, we don't accumulate any
-virtual time, so we start ticking in real time.  (The granularity is
-the effective resolution of the context switch timer, so it is
-affected by the RTS -C option.)
-
-@threadWait@ delays rescheduling of a thread until input on the
-specified file descriptor is available for reading (just like select).
--}
-
-threadDelay, threadWaitRead, threadWaitWrite :: Int -> IO ()
-
-threadDelay (I# x#) = IO $ ST $ \ (S# s#) ->
-    case delay# x# s# of
-      s2# -> (Right (), S# s2#)
-
-threadWaitRead (I# x#) = IO $ ST $ \ (S# s#) -> 
-    case waitRead# x# s# of
-      s2# -> (Right (), S# s2#)
-
-threadWaitWrite (I# x#) = IO $ ST $ \ (S# s#) ->
-    case waitWrite# x# s# of
-      s2# -> (Right (), S# s2#)
-
-{- =============================================================
-** OTHER SUPPORT FUNCTIONS
-
-   3 flavors, basically: string support, error/trace-ish, and read/show-ish.
--}
-seq, par, fork :: Eval a => a -> b -> b
-
-{-# INLINE seq  #-}
-{-# INLINE par  #-}
-{-# INLINE fork #-}
-
-#ifdef __CONCURRENT_HASKELL__
-seq  x y = case (seq#  x) of { 0# -> parError; _ -> y }
-par  x y = case (par#  x) of { 0# -> parError; _ -> y }
-fork x y = case (fork# x) of { 0# -> parError; _ -> y }
-#else
-seq  x y = y
-par  x y = y
-fork x y = y
-#endif
-
--- string-support functions:
----------------------------------------------------------------
-
---------------------------------------------------------------------------
-
-packStringForC__ :: [Char]          -> ByteArray# -- calls injected by compiler
-unpackPS__       :: Addr#           -> [Char] -- calls injected by compiler
-unpackPS2__      :: Addr# -> Int#   -> [Char] -- calls injected by compiler
-unpackAppendPS__ :: Addr# -> [Char] -> [Char] -- ditto?
-unpackFoldrPS__  :: Addr# -> (Char  -> a -> a) -> a -> a -- ditto?
-
-packStringForC__ str = case (GHCps.packString str) of { PS bytes _ _ -> bytes}
-
-unpackPS__ addr -- calls injected by compiler
-  = unpack 0#
-  where
-    unpack nh
-      | ch `eqChar#` '\0'# = []
-      | True		   = C# ch : unpack (nh +# 1#)
-      where
-	ch = indexCharOffAddr# addr nh
-
-unpackAppendPS__ addr rest
-  = unpack 0#
-  where
-    unpack nh
-      | ch `eqChar#` '\0'# = rest
-      | True		   = C# ch : unpack (nh +# 1#)
-      where
-	ch = indexCharOffAddr# addr nh
-
-unpackFoldrPS__ addr f z 
-  = unpack 0#
-  where
-    unpack nh
-      | ch `eqChar#` '\0'# = z
-      | True		   = C# ch `f` unpack (nh +# 1#)
-      where
-	ch = indexCharOffAddr# addr nh
-
-unpackPS2__ addr len -- calls injected by compiler
-  -- this one is for literal strings with NULs in them; rare.
-  = GHCps.unpackPS (GHCps.packCBytes (I# len) (A# addr))
-
----------------------------------------------------------------
--- injected literals:
----------------------------------------------------------------
-integer_0, integer_1, integer_2, integer_m1 :: Integer
-
-integer_0 = 0; integer_1 = 1; integer_2 = 2; integer_m1 = -1
-
----------------------------------------------------------------
--- error/trace-ish functions:
----------------------------------------------------------------
-
-errorIO :: PrimIO () -> a
-
-errorIO (ST io)
-  = case (errorIO# io) of
-      _ -> bottom
-  where
-    bottom = bottom -- Never evaluated
-
-error__ :: (Addr{-FILE *-} -> PrimIO ()) -> String -> a
-
-error__ msg_hdr s
-#ifdef __PARALLEL_HASKELL__
-  = errorIO (msg_hdr sTDERR{-msg hdr-}	>>
-	     _ccall_ fflush sTDERR	>>
-	     fputs sTDERR s		>>
-	     _ccall_ fflush sTDERR	>>
-	     _ccall_ stg_exit (1::Int)
-	    )
-#else
-  = errorIO (msg_hdr sTDERR{-msg hdr-}	>>
-	     _ccall_ fflush sTDERR	>>
-	     fputs sTDERR s		>>
-	     _ccall_ fflush sTDERR	>>
-	     _ccall_ getErrorHandler	>>= \ errorHandler ->
-	     if errorHandler == (-1::Int) then
-		_ccall_ stg_exit (1::Int)
-	     else
-		_casm_ ``%r = (StgStablePtr)(%0);'' errorHandler
-						>>= \ osptr ->
-		_ccall_ decrementErrorCount     >>= \ () ->
-		deRefStablePtr osptr            >>= \ oact ->
-		oact
-	    )
-#endif {- !parallel -}
-  where
-    sTDERR = (``stderr'' :: Addr)
-
----------------
-
-fputs :: Addr{-FILE*-} -> String -> PrimIO Bool
-
-fputs stream [] = return True
-
-fputs stream (c : cs)
-  = _ccall_ stg_putc c stream >> -- stg_putc expands to putc
-    fputs stream cs		 -- (just does some casting stream)
-
----------------------------------------------------------------
--- ******** defn of `_trace' using Glasgow IO *******
-
-{-# GENERATE_SPECS _trace a #-}
-
-trace :: String -> a -> a
-
-trace string expr
-  = unsafePerformPrimIO (
-	((_ccall_ PreTraceHook sTDERR{-msg-}):: PrimIO ())  >>
-	fputs sTDERR string				    >>
-	((_ccall_ PostTraceHook sTDERR{-msg-}):: PrimIO ()) >>
-	returnPrimIO expr )
-  where
-    sTDERR = (``stderr'' :: Addr)
-
----------------------------------------------------------------
--- read/show-ish functions:
----------------------------------------------------------------
-{-# GENERATE_SPECS readList__ a #-}
-readList__ :: ReadS a -> ReadS [a]
-
-readList__ readx
-  = readParen False (\r -> [pr | ("[",s)  <- lex r, pr <- readl s])
-  where readl  s = [([],t)   | ("]",t)  <- lex s] ++
-		   [(x:xs,u) | (x,t)    <- readx s,
-			       (xs,u)   <- readl2 t]
-	readl2 s = [([],t)   | ("]",t)  <- lex s] ++
-		   [(x:xs,v) | (",",t)  <- lex s,
-			       (x,u)    <- readx t,
-			       (xs,v)   <- readl2 u]
-
-{-# GENERATE_SPECS showList__ a #-}
-showList__ :: (a -> ShowS) ->  [a] -> ShowS
-
-showList__ showx []     = showString "[]"
-showList__ showx (x:xs) = showChar '[' . showx x . showl xs
-  where
-    showl []     = showChar ']'
-    showl (x:xs) = showString ", " . showx x . showl xs
-
-showSpace :: ShowS
-showSpace = {-showChar ' '-} \ xs -> ' ' : xs
-
--- ******************************************************************
-
--- This lexer is not completely faithful to the Haskell lexical syntax.
--- Current limitations:
---    Qualified names are not handled properly
---    A `--' does not terminate a symbol
---    Octal and hexidecimal numerics are not recognized as a single token
-
-lex                   :: ReadS String
-lex ""                = [("","")]
-lex (c:s) | isSpace c = lex (dropWhile isSpace s)
-lex ('\'':s)          = [('\'':ch++"'", t) | (ch,'\'':t)  <- lexLitChar s,
-                                              ch /= "'"                ]
-lex ('"':s)           = [('"':str, t)      | (str,t) <- lexString s]
-                        where
-                        lexString ('"':s) = [("\"",s)]
-                        lexString s = [(ch++str, u)
-                                              | (ch,t)  <- lexStrItem s,
-                                                (str,u) <- lexString t  ]
-
-                        lexStrItem ('\\':'&':s) = [("\\&",s)]
-                        lexStrItem ('\\':c:s) | isSpace c
-                            = [("\\&",t) | '\\':t <- [dropWhile isSpace s]]
-                        lexStrItem s            = lexLitChar s
-
-lex (c:s) | isSingle c = [([c],s)]
-          | isSym c    = [(c:sym,t)       | (sym,t) <- [span isSym s]]
-          | isAlpha c  = [(c:nam,t)       | (nam,t) <- [span isIdChar s]]
-          | isDigit c  = [(c:ds++fe,t)    | (ds,s)  <- [span isDigit s],
-                                            (fe,t)  <- lexFracExp s     ]
-          | otherwise  = []    -- bad character
-             where
-              isSingle c =  c `elem` ",;()[]{}_`"
-              isSym c    =  c `elem` "!@#$%&*+./<=>?\\^|:-~"
-              isIdChar c =  isAlphanum c || c `elem` "_'"
-
-              lexFracExp ('.':s) = [('.':ds++e,u) | (ds,t) <- lexDigits s,
-                                                    (e,u)  <- lexExp t]
-              lexFracExp s       = [("",s)]
-
-              lexExp (e:s) | e `elem` "eE"
-                       = [(e:c:ds,u) | (c:t)  <- [s], c `elem` "+-",
-                                                 (ds,u) <- lexDigits t] ++
-                         [(e:ds,t)   | (ds,t) <- lexDigits s]
-              lexExp s = [("",s)]
-
-lexDigits               :: ReadS String 
-lexDigits               =  nonnull isDigit
-
-nonnull                 :: (Char -> Bool) -> ReadS String
-nonnull p s             =  [(cs,t) | (cs@(_:_),t) <- [span p s]]
-
-lexLitChar              :: ReadS String
-lexLitChar ('\\':s)     =  [('\\':esc, t) | (esc,t) <- lexEsc s]
-        where
-        lexEsc (c:s)     | c `elem` "abfnrtv\\\"'" = [([c],s)]
-        lexEsc s@(d:_)   | isDigit d               = lexDigits s
-        lexEsc _                                   = []
-lexLitChar (c:s)        =  [([c],s)]
-lexLitChar ""           =  []
-
-
-match			:: (Eq a) => [a] -> [a] -> ([a],[a])
-match (x:xs) (y:ys) | x == y  =  match xs ys
-match xs     ys		      =  (xs,ys)
-
-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"] 
-
-readLitChar 		:: ReadS Char
-
-readLitChar ('\\':s)	=  readEsc s
-	where
-	readEsc ('a':s)	 = [('\a',s)]
-	readEsc ('b':s)	 = [('\b',s)]
-	readEsc ('f':s)	 = [('\f',s)]
-	readEsc ('n':s)	 = [('\n',s)]
-	readEsc ('r':s)	 = [('\r',s)]
-	readEsc ('t':s)	 = [('\t',s)]
-	readEsc ('v':s)	 = [('\v',s)]
-	readEsc ('\\':s) = [('\\',s)]
-	readEsc ('"':s)	 = [('"',s)]
-	readEsc ('\'':s) = [('\'',s)]
-	readEsc ('^':c:s) | c >= '@' && c <= '_'
-			 = [(chr (ord c - ord '@'), s)]
-	readEsc s@(d:_) | isDigit d
-			 = [(chr n, t) | (n,t) <- readDec s]
-	readEsc ('o':s)  = [(chr n, t) | (n,t) <- readOct s]
-	readEsc ('x':s)	 = [(chr n, t) | (n,t) <- readHex s]
-	readEsc s@(c:_) | isUpper c
-			 = let table = ('\DEL', "DEL") : zip ['\NUL'..] asciiTab
-			   in case [(c,s') | (c, mne) <- table,
-					     ([],s') <- [match mne s]]
-			      of (pr:_) -> [pr]
-				 []	-> []
-	readEsc _	 = []
-readLitChar (c:s)	=  [(c,s)]
-
-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
-
--- ******************************************************************
-
-{-# GENERATE_SPECS readDec a{Int#,Int,Integer} #-}
-readDec :: (Integral a) => ReadS a
-readDec = readInt 10 isDigit (\d -> ord d - ord_0)
-
-{-# GENERATE_SPECS readOct a{Int#,Int,Integer} #-}
-readOct :: (Integral a) => ReadS a
-readOct = readInt 8 isOctDigit (\d -> ord d - ord_0)
-
-{-# GENERATE_SPECS readHex a{Int#,Int,Integer} #-}
-readHex :: (Integral a) => ReadS a
-readHex = readInt 16 isHexDigit hex
-	    where hex d = ord d - (if isDigit d then ord_0
-				   else ord (if isUpper d then 'A' else 'a') - 10)
-
-{-# GENERATE_SPECS readInt a{Int#,Int,Integer} #-}
-readInt :: (Integral a) => a -> (Char -> Bool) -> (Char -> Int) -> ReadS a
-readInt radix isDig digToInt s =
-    [(foldl1 (\n d -> n * radix + d) (map (fromInt . digToInt) ds), r)
-	| (ds,r) <- nonnull isDig s ]
-
-showInt n r
-  = case quotRem n 10 of		     { (n', d) ->
-    case (chr (ord_0 + fromIntegral d)) of { C# c# -> -- stricter than necessary
-    let
-	r' = C# c# : r
-    in
-    if n' == 0 then r' else showInt n' r'
-    }}
-
--- ******************************************************************
-
-{-# GENERATE_SPECS readSigned a{Int#,Double#,Int,Integer,Double} #-}
-readSigned :: (Real a) => ReadS a -> ReadS a
-readSigned readPos = readParen False read'
-		     where read' r  = read'' r ++
-				      [(-x,t) | ("-",s) <- lex r,
-						(x,t)   <- read'' s]
-			   read'' r = [(n,s)  | (str,s) <- lex r,
-		      				(n,"")  <- readPos str]
-
-
-{-# SPECIALIZE showSigned :: (Int     -> ShowS) -> Int -> Int     -> ShowS = showSigned_Int,
-			     (Integer -> ShowS) -> Int -> Integer -> ShowS = showSigned_Integer #-}
-{-# GENERATE_SPECS showSigned a{Double#,Double} #-}
-showSigned :: (Real a) => (a -> ShowS) -> Int -> a -> ShowS
-showSigned showPos p x = if x < 0 then showParen (p > 6)
-						 (showChar '-' . showPos (-x))
-				  else showPos x
-
-showSigned_Int :: (Int -> ShowS) -> Int -> Int -> ShowS
-showSigned_Int _ p n r
-  = -- from HBC version; support code follows
-    if n < 0 && p > 6 then '(':itos n++(')':r) else itos n ++ r
-
-showSigned_Integer :: (Integer -> ShowS) -> Int -> Integer -> ShowS
-showSigned_Integer _ p n r
-  = -- from HBC version; support code follows
-    if n < 0 && p > 6 then '(':jtos n++(')':r) else jtos n ++ r
-
--- ******************************************************************
-
-itos# :: Int# -> String
-itos# n =
-    if n `ltInt#` 0# then
-	if negateInt# n `ltInt#` 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 `ltInt#` 10# then
-	    C# (chr# (n `plusInt#` ord# '0'#)) : cs
-	else 
-	    itos' (n `quotInt#` 10#) (C# (chr# (n `remInt#` 10# `plusInt#` ord# '0'#)) : cs)
-
-itos :: Int -> String
-itos (I# n) = itos# n
-
-jtos :: Integer -> String
-jtos n 
-  = if n < 0 then
-        '-' : jtos' (-n) []
-    else 
-	jtos' n []
-
-jtos' :: Integer -> String -> String
-jtos' n cs
-  = if n < 10 then
-	chr (fromInteger (n + ord_0)) : cs
-    else 
-	jtos' (n `quot` 10) (chr (fromInteger (n `rem` 10 + ord_0)) : cs)
-
-chr = (toEnum   :: Int  -> Char)
-ord = (fromEnum :: Char -> Int)
-
-ord_0 :: Num a => a
-ord_0 = fromInt (ord '0')
-
--- ******************************************************************
-
--- The functions readFloat and showFloat below use rational arithmetic
--- to insure correct conversion between the floating-point radix and
--- decimal.  It is often possible to use a higher-precision floating-
--- point type to obtain the same results.
-
-{-# GENERATE_SPECS readFloat a{Double#,Double} #-}
-readFloat :: (RealFloat a) => ReadS a
-readFloat r = [(fromRational x, t) | (x, t) <- readRational r]
-
-readRational :: ReadS Rational -- NB: doesn't handle leading "-"
-
-readRational r
-  = [ ( (n%1)*10^^(k-d), t ) | (n,d,s) <- readFix r,
-			       (k,t)   <- readExp s]
-              where readFix r = [(read (ds++ds'), length ds', t)
-					| (ds,'.':s) <- lexDigits r,
-					  (ds',t)    <- lexDigits s ]
-
-		    readExp (e:s) | e `elem` "eE" = readExp' s
-                    readExp s			  = [(0,s)]
-
-                    readExp' ('-':s) = [(-k,t) | (k,t) <- readDec s]
-                    readExp' ('+':s) = readDec s
-                    readExp' s	     = readDec s
-
-readRational__ :: String -> Rational -- we export this one (non-std)
-				    -- NB: *does* handle a leading "-"
-readRational__ top_s
-  = case top_s of
-      '-' : xs -> - (read_me xs)
-      xs       -> read_me xs
-  where
-    read_me s
-      = case [x | (x,t) <- readRational s, ("","") <- lex t] of
-	  [x] -> x
-	  []  -> error ("readRational__: no parse:"        ++ top_s)
-	  _   -> error ("readRational__: ambiguous parse:" ++ top_s)
-
--- The number of decimal digits m below is chosen to guarantee 
--- read (show x) == x.  See
---	Matula, D. W.  A formalization of floating-point numeric base
---	conversion.  IEEE Transactions on Computers C-19, 8 (1970 August),
---	681-692.
- 
-zeros = repeat '0'
-
-{-# GENERATE_SPECS showFloat a{Double#,Double} #-}
-showFloat:: (RealFloat a) => a -> ShowS
-showFloat x =
-    if x == 0 then showString ("0." ++ take (m-1) zeros)
-	      else if e >= m-1 || e < 0 then showSci else showFix
-    where
-    showFix	= showString whole . showChar '.' . showString frac
-		  where (whole,frac) = splitAt (e+1) (show sig)
-    showSci	= showChar d . showChar '.' . showString frac
-		      . showChar 'e' . shows e
-    		  where (d:frac) = show sig
-    (m, sig, e) = if b == 10 then (w,  	s,   n+w-1)
-		  	     else (m', sig', e'   )
-    m'		= ceiling
-		      ((fromInt w * log (fromInteger b)) / log 10 :: Double)
-		  + 1
-    (sig', e')	= if	  sig1 >= 10^m'     then (round (t/10), e1+1)
-		  else if sig1 <  10^(m'-1) then (round (t*10), e1-1)
-		  			    else (sig1,		 e1  )
-    sig1	= round t
-    t		= s%1 * (b%1)^^n * 10^^(m'-e1-1)
-    e1		= floor (logBase 10 x)
-    (s, n)	= decodeFloat x
-    b		= floatRadix x
-    w		= floatDigits x
-
----------------------------------------------------------
--- definitions of the boxed PrimOps; these will be
--- used in the case of partial applications, etc.
-
-plusInt	(I# x) (I# y) = I# (plusInt# x y)
-minusInt(I# x) (I# y) = I# (minusInt# x y)
-timesInt(I# x) (I# y) = I# (timesInt# 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)
-gtInt	(I# x) (I# y) = gtInt# x y
-geInt	(I# x) (I# y) = geInt# x y
-eqInt	(I# x) (I# y) = eqInt# x y
-neInt	(I# x) (I# y) = neInt# x y
-ltInt	(I# x) (I# y) = ltInt# x y
-leInt	(I# x) (I# y) = leInt# x y
-
--- definitions of the boxed PrimOps; these will be
--- used in the case of partial applications, etc.
-
-plusFloat   (F# x) (F# y) = F# (plusFloat# x y)
-minusFloat  (F# x) (F# y) = F# (minusFloat# x y)
-timesFloat  (F# x) (F# y) = F# (timesFloat# x y)
-divideFloat (F# x) (F# y) = F# (divideFloat# x y)
-negateFloat (F# x)        = F# (negateFloat# x)
-
-gtFloat	    (F# x) (F# y) = gtFloat# x y
-geFloat	    (F# x) (F# y) = geFloat# x y
-eqFloat	    (F# x) (F# y) = eqFloat# x y
-neFloat	    (F# x) (F# y) = neFloat# x y
-ltFloat	    (F# x) (F# y) = ltFloat# x y
-leFloat	    (F# x) (F# y) = leFloat# x y
-
-float2Int   (F# x) = I# (float2Int# x)
-int2Float   (I# x) = F# (int2Float# x)
-
-expFloat    (F# x) = F# (expFloat# x)
-logFloat    (F# x) = F# (logFloat# x)
-sqrtFloat   (F# x) = F# (sqrtFloat# x)
-sinFloat    (F# x) = F# (sinFloat# x)
-cosFloat    (F# x) = F# (cosFloat# x)
-tanFloat    (F# x) = F# (tanFloat# x)
-asinFloat   (F# x) = F# (asinFloat# x)
-acosFloat   (F# x) = F# (acosFloat# x)
-atanFloat   (F# x) = F# (atanFloat# x)
-sinhFloat   (F# x) = F# (sinhFloat# x)
-coshFloat   (F# x) = F# (coshFloat# x)
-tanhFloat   (F# x) = F# (tanhFloat# x)
-
-powerFloat  (F# x) (F# y) = F# (powerFloat# x y)
-
--- definitions of the boxed PrimOps; these will be
--- used in the case of partial applications, etc.
-
-plusDouble   (D# x) (D# y) = D# (plusDouble# x y)
-minusDouble  (D# x) (D# y) = D# (minusDouble# x y)
-timesDouble  (D# x) (D# y) = D# (timesDouble# x y)
-divideDouble (D# x) (D# y) = D# (divideDouble# x y)
-negateDouble (D# x)        = D# (negateDouble# x)
-
-gtDouble    (D# x) (D# y) = gtDouble# x y
-geDouble    (D# x) (D# y) = geDouble# x y
-eqDouble    (D# x) (D# y) = eqDouble# x y
-neDouble    (D# x) (D# y) = neDouble# x y
-ltDouble    (D# x) (D# y) = ltDouble# x y
-leDouble    (D# x) (D# y) = leDouble# x y
-
-double2Int   (D# x) = I# (double2Int#   x)
-int2Double   (I# x) = D# (int2Double#   x)
-double2Float (D# x) = F# (double2Float# x)
-float2Double (F# x) = D# (float2Double# x)
-
-expDouble    (D# x) = D# (expDouble# x)
-logDouble    (D# x) = D# (logDouble# x)
-sqrtDouble   (D# x) = D# (sqrtDouble# x)
-sinDouble    (D# x) = D# (sinDouble# x)
-cosDouble    (D# x) = D# (cosDouble# x)
-tanDouble    (D# x) = D# (tanDouble# x)
-asinDouble   (D# x) = D# (asinDouble# x)
-acosDouble   (D# x) = D# (acosDouble# x)
-atanDouble   (D# x) = D# (atanDouble# x)
-sinhDouble   (D# x) = D# (sinhDouble# x)
-coshDouble   (D# x) = D# (coshDouble# x)
-tanhDouble   (D# x) = D# (tanhDouble# x)
-
-powerDouble  (D# x) (D# y) = D# (powerDouble# x y)
-
----------------------------------------------------------
-{-
-[In response to a request by simonpj, Joe Fasel writes:]
-
-A quite reasonable request!  This code was added to the Prelude just
-before the 1.2 release, when Lennart, working with an early version
-of hbi, noticed that (read . show) was not the identity for
-floating-point numbers.	 (There was a one-bit error about half the time.)
-The original version of the conversion function was in fact simply
-a floating-point divide, as you suggest above.	The new version is,
-I grant you, somewhat denser.
-
-How's this?
-
-Joe
--}
-
-{-# GENERATE_SPECS fromRational__ a{Double#,Double} #-}
-fromRational__ :: (RealFloat a) => Rational -> a
-fromRational__ x = x'
-	where x' = f e
-
---		If the exponent of the nearest floating-point number to x 
---		is e, then the significand is the integer nearest xb^(-e),
---		where b is the floating-point radix.  We start with a good
---		guess for e, and if it is correct, the exponent of the
---		floating-point number we construct will again be e.  If
---		not, one more iteration is needed.
-
-	      f e   = if e' == e then y else f e'
-		      where y	   = encodeFloat (round (x * (1 % b)^^e)) e
-			    (_,e') = decodeFloat y
-	      b	    = floatRadix x'
-
---		We obtain a trial exponent by doing a floating-point
---		division of x's numerator by its denominator.  The
---		result of this division may not itself be the ultimate
---		result, because of an accumulation of three rounding
---		errors.
-
-	      (s,e) = decodeFloat (fromInteger (numerator x) `asTypeOf` x'
-					/ fromInteger (denominator x))
-
--------------------------------------------------------------------------
--- from/by Lennart, 94/09/26
-
--- Convert a Rational to a string that looks like a floating point number,
--- but without converting to any floating type (because of the possible overflow).
-showRational :: Int -> Rational -> String
-showRational n r =
-    if r == 0 then
-    	"0.0"
-    else
-	let (r', e) = normalize r
-	in  prR n r' e
-
-startExpExp = 4 :: Int
-
--- make sure 1 <= r < 10
-normalize :: Rational -> (Rational, Int)
-normalize r = if r < 1 then
-		  case norm startExpExp (1 / r) 0 of (r', e) -> (10 / r', -e-1)
-	      else
-		  norm startExpExp r 0
-	where norm :: Int -> Rational -> Int -> (Rational, Int)
-	      -- Invariant: r*10^e == original r
-	      norm 0  r e = (r, e)
-	      norm ee r e =
-		let n = 10^ee
-		    tn = 10^n
-		in  if r >= tn then norm ee (r/tn) (e+n) else norm (ee-1) r e
-
-drop0 "" = ""
-drop0 (c:cs) = c : reverse (dropWhile (=='0') (reverse cs))
-
-prR :: Int -> Rational -> Int -> String
-prR n r e | r <  1  = prR n (r*10) (e-1)		-- final adjustment
-prR n r e | r >= 10 = prR n (r/10) (e+1)
-prR n r e0 =
-	let s = show ((round (r * 10^n))::Integer)
-	    e = e0+1
-	in  if e > 0 && e < 8 then
-		take e s ++ "." ++ drop0 (drop e s)
-	    else if e <= 0 && e > -3 then
-	        "0." ++ take (-e) (repeat '0') ++ drop0 s
-	    else
-	        head s : "."++ drop0 (tail s) ++ "e" ++ show e0
diff --git a/ghc/lib/prelude/GHCerr.hs b/ghc/lib/prelude/GHCerr.hs
deleted file mode 100644
index 202fee26be..0000000000
--- a/ghc/lib/prelude/GHCerr.hs
+++ /dev/null
@@ -1,66 +0,0 @@
-{- The GHCerr module defines the code for the
-   wired-in error functions, which have a special
-   type in the compiler (with "open tyvars").
-   
-   We cannot define these functions in a module where they might be
-   used (e.g., GHCbase), because the magical wired-in type will get
-   confused with what the typechecker figures out.
--}
-module GHCerr where
-
-import GHCbase (error__)
-
----------------------------------------------------------------
--- HACK: Magic unfoldings not implemented for unboxed lists
---	 Need to define a "build" to avoid undefined symbol
--- in this module to avoid .hi proliferation.
-
-build   = error "GHCbase.build"
-augment = error "GHCbase.augment"
---{-# GENERATE_SPECS build a #-}
---build 		:: ((a -> [a] -> [a]) -> [a] -> [a]) -> [a]
---build g 	= g (:) []
-
-
----------------------------------------------------------------
-cannon_fodder_to_avoid_empty__versions__ = (1::Int)
-
--- Used for compiler-generated error message;
--- encoding saves bytes of string junk.
-
-absentErr, parError :: a
-irrefutPatError
- , noDefaultMethodError
- , noExplicitMethodError
- , nonExhaustiveGuardsError
- , patError
- , recConError
- , recUpdError :: String -> a
-
-absentErr = error "Oops! The program has entered an `absent' argument!\n"
-parError  = error "Oops! Entered GHCbase.parError (a GHC bug -- please report it!)\n"
-
-noDefaultMethodError     s = error ("noDefaultMethodError:"++s)
-noExplicitMethodError    s = error ("noExplicitMethodError:"++s)
-
-irrefutPatError s	    = patError__ (untangle s "irrefutable pattern")
-nonExhaustiveGuardsError s  = patError__ (untangle s "non-exhaustive guards")
-patError s		    = patError__ (untangle s "pattern-matching")
-
-patError__ = error__ (\ x -> _ccall_ PatErrorHdrHook x)
-
-recConError s = error (untangle s "record constructor")
-recUpdError s = error (untangle s "record update")
-
-untangle coded in_str
-  =  "In "     ++ in_str
-  ++ (if null msg then "" else (": " ++ msg))
-  ++ "; at "   ++ file
-  ++ ", line " ++ line
-  ++ "\n"
-  where
-    (file,line,msg)
-      = case (span not_bar coded) of { (f, (_:rest)) ->
-	case (span not_bar rest)  of { (l, (_:m)) ->
-	(f,l,m) }}
-    not_bar c = c /= '|'
diff --git a/ghc/lib/prelude/GHCio.hs b/ghc/lib/prelude/GHCio.hs
deleted file mode 100644
index a902ec00ca..0000000000
--- a/ghc/lib/prelude/GHCio.hs
+++ /dev/null
@@ -1,950 +0,0 @@
-{-
-%
-% (c) The AQUA Project, Glasgow University, 1994-1996
-%
-
-This module defines Haskell {\em handles} and the basic operations
-which are supported for them.
--}
-
-#include "error.h"
-
-module GHCio where
-
-import GHCbase
-import qualified GHCps ( unpackPS, packCString )
-import Ix (Ix(..))
-
----------------------------------
-infixr 1 `stThen`
-
--- a useful little number for doing _ccall_s in IO-land:
-
-stThen :: PrimIO a -> (a -> IO b) -> IO b
-{-# INLINE stThen   #-}
-
-stThen (ST m) k = IO $ ST $ \ s ->
-    case (m s)     of { (m_res, new_s)    ->
-    case (k m_res) of { (IO (ST k_m_res)) ->
-    k_m_res new_s }}
-
----------------------------------
--- this one didn't make it into the 1.3 defn
-
--- The construct $try comp$ exposes errors which occur within a
--- computation, and which are not fully handled.  It always succeeds.
-
-tryIO :: IO a -> IO (Either IOError a) 
-tryIO p = catch (p >>= (return . Right)) (return . Left)
-
----------------------------------
-
-data Handle__
-  = ErrorHandle		IOError
-  | ClosedHandle
-  | SemiClosedHandle	Addr (Addr, Int)
-  | ReadHandle		Addr (Maybe BufferMode) Bool
-  | WriteHandle		Addr (Maybe BufferMode) Bool
-  | AppendHandle	Addr (Maybe BufferMode) Bool
-  | ReadWriteHandle	Addr (Maybe BufferMode) Bool
-
-instance Eq Handle{-partain:????-}
-
-{-# INLINE newHandle   #-}
-{-# INLINE readHandle  #-}
-{-# INLINE writeHandle #-}
-
-newHandle   :: Handle__ -> IO Handle
-readHandle  :: Handle   -> IO Handle__
-writeHandle :: Handle -> Handle__ -> IO ()
-
-#if defined(__CONCURRENT_HASKELL__)
-
-type Handle = MVar Handle__
-
-newHandle   = newMVar
-readHandle  = takeMVar
-writeHandle = putMVar
-
-#else
-type Handle = MutableVar RealWorld Handle__
-
-newHandle v     = stToIO (newVar   v)
-readHandle h    = stToIO (readVar  h)
-writeHandle h v = stToIO (writeVar h v)
-
-#endif {- __CONCURRENT_HASKELL__ -}
-
-type FilePath = String
-
-filePtr :: Handle__ -> Addr
-filePtr (SemiClosedHandle fp _)  = fp
-filePtr (ReadHandle fp _ _)	 = fp
-filePtr (WriteHandle fp _ _)	 = fp
-filePtr (AppendHandle fp _ _)	 = fp
-filePtr (ReadWriteHandle fp _ _) = fp
-
-bufferMode :: Handle__ -> Maybe BufferMode
-bufferMode (ReadHandle _ m _)      = m
-bufferMode (WriteHandle _ m _)     = m
-bufferMode (AppendHandle _ m _)    = m
-bufferMode (ReadWriteHandle _ m _) = m
-
-markHandle :: Handle__ -> Handle__
-markHandle h@(ReadHandle fp m b)
-  | b = h
-  | otherwise = ReadHandle fp m True
-markHandle h@(WriteHandle fp m b)
-  | b = h
-  | otherwise = WriteHandle fp m True
-markHandle h@(AppendHandle fp m b)
-  | b = h
-  | otherwise = AppendHandle fp m True
-markHandle h@(ReadWriteHandle fp m b)
-  | b = h
-  | otherwise = ReadWriteHandle fp m True
-
--------------------------------------------
-
-stdin, stdout, stderr :: Handle
-
-stdin = unsafePerformPrimIO (
-    _ccall_ getLock (``stdin''::Addr) 0		>>= \ rc ->
-    (case rc of
-       0 -> new_handle ClosedHandle
-       1 -> new_handle (ReadHandle ``stdin'' Nothing False)
-       _ -> constructError "stdin"		>>= \ ioError -> 
-            new_handle (ErrorHandle ioError)
-    )						>>= \ handle ->
-    returnPrimIO handle
-  )
-  where
-    new_handle x = ioToST (newHandle x)
-
-stdout = unsafePerformPrimIO (
-    _ccall_ getLock (``stdout''::Addr) 1	>>= \ rc ->
-    (case rc of
-       0 -> new_handle ClosedHandle
-       1 -> new_handle (WriteHandle ``stdout'' Nothing False)
-       _ -> constructError "stdout"		>>= \ ioError -> 
-            new_handle (ErrorHandle ioError)
-    )						>>= \ handle ->
-    returnPrimIO handle
-  )
-  where
-    new_handle x = ioToST (newHandle x)
-
-stderr = unsafePerformPrimIO (
-    _ccall_ getLock (``stderr''::Addr) 1	>>= \ rc ->
-    (case rc of
-       0 -> new_handle ClosedHandle
-       1 -> new_handle (WriteHandle ``stderr'' (Just NoBuffering) False)	
-       _ -> constructError "stderr"		>>= \ ioError -> 
-            new_handle (ErrorHandle ioError)
-    )						>>= \ handle ->
-    returnPrimIO handle
-  )
-  where
-    new_handle x = ioToST (newHandle x)
-{-
-\end{code}
-
-Three handles are allocated during program initialisation.  The first
-two manage input or output from the Haskell program's standard input
-or output channel respectively.  The third manages output to the
-standard error channel. These handles are initially open.
-
-\subsubsection[OpeningClosing]{Opening and Closing Files}
-
-\begin{code}
--}
-data IOMode      =  ReadMode | WriteMode | AppendMode | ReadWriteMode
-                    deriving (Eq, Ord, Ix, Enum, Read, Show)
-
-openFile :: FilePath -> IOMode -> IO Handle
-
-openFile f m = 
-    stToIO (_ccall_ openFile f m')		    >>= \ ptr ->
-    if ptr /= ``NULL'' then
-        newHandle (htype ptr Nothing False)
-    else
-	stToIO (constructError "openFile")	    >>= \ ioError -> 
-	let
-	    improved_error -- a HACK, I guess
-	      = case ioError of
-		  AlreadyExists    msg -> AlreadyExists	   (msg ++ ": " ++ f)
-		  NoSuchThing      msg -> NoSuchThing	   (msg ++ ": " ++ f)
-		  PermissionDenied msg -> PermissionDenied (msg ++ ": " ++ f)
-		  _		       -> ioError
-	in
-        fail improved_error
-  where
-    m' = case m of 
-           ReadMode      -> "r"
-           WriteMode     -> "w"
-           AppendMode    -> "a"
-           ReadWriteMode -> "r+"
-
-    htype = case m of 
-              ReadMode      -> ReadHandle
-              WriteMode     -> WriteHandle
-              AppendMode    -> AppendHandle
-              ReadWriteMode -> ReadWriteHandle
-{-
-\end{code}
-
-Computation $openFile file mode$ allocates and returns a new, open
-handle to manage the file {\em file}.  It manages input if {\em mode}
-is $ReadMode$, output if {\em mode} is $WriteMode$ or $AppendMode$,
-and both input and output if mode is $ReadWriteMode$.
-
-If the file does not exist and it is opened for output, it should be
-created as a new file.  If {\em mode} is $WriteMode$ and the file
-already exists, then it should be truncated to zero length.  The
-handle is positioned at the end of the file if {\em mode} is
-$AppendMode$, and otherwise at the beginning (in which case its
-internal position is 0).
-
-Implementations should enforce, locally to the Haskell process,
-multiple-reader single-writer locking on files, which is to say that
-there may either be many handles on the same file which manage input,
-or just one handle on the file which manages output.  If any open or
-semi-closed handle is managing a file for output, no new handle can be
-allocated for that file.  If any open or semi-closed handle is
-managing a file for input, new handles can only be allocated if they
-do not manage output.
-
-Two files are the same if they have the same absolute name.  An
-implementation is free to impose stricter conditions.
-
-\begin{code}
--}
-hClose :: Handle -> IO ()
-
-hClose handle =
-    readHandle handle				    >>= \ htype ->
-    writeHandle handle ClosedHandle		    >>
-    case htype of 
-      ErrorHandle ioError ->
-	  fail ioError
-      ClosedHandle -> 
-	  fail (IllegalOperation "handle is closed")
-      SemiClosedHandle fp (buf,_) ->
-          (if buf /= ``NULL'' then
-	      _ccall_ free buf
-           else			    
-              returnPrimIO ())			    `stThen` \ () ->
-          if fp /= ``NULL'' then
-              _ccall_ closeFile fp		    `stThen` \ rc ->
-              if rc == 0 then 
-	          return ()
-              else
-	          constructErrorAndFail "hClose"
-          else			    
-              return ()
-      other -> 
-          _ccall_ closeFile (filePtr other)	    `stThen` \ rc ->
-          if rc == 0 then 
-	      return ()
-          else
-	      constructErrorAndFail "hClose"
-{-
-\end{code}
-
-Computation $hClose hdl$ makes handle {\em hdl} closed.  Before the
-computation finishes, any items buffered for output and not already
-sent to the operating system are flushed as for $flush$.
-
-\subsubsection[EOF]{Detecting the End of Input}
-
-\begin{code}
--}
-hFileSize :: Handle -> IO Integer
-hFileSize handle =
-    readHandle handle				    >>= \ htype ->
-    case htype of 
-      ErrorHandle ioError ->
-	  writeHandle handle htype			    >>
-	  fail ioError
-      ClosedHandle -> 
-	  writeHandle handle htype			    >>
-          fail (IllegalOperation "handle is closed")
-      SemiClosedHandle _ _ -> 
-	  writeHandle handle htype			    >>
-          fail (IllegalOperation "handle is closed")
-      other ->
-          -- HACK!  We build a unique MP_INT of the right shape to hold
-          -- a single unsigned word, and we let the C routine change the data bits
-          _casm_ ``%r = 1;''			    `stThen` \ (I# hack#) ->
-          case int2Integer# hack# of
-            result@(J# _ _ d#) ->
-		let
-		    bogus_bounds = (error "fileSize"::(Int,Int))
-		in
-                _ccall_ fileSize (filePtr other) (ByteArray bogus_bounds d#)
-                                                    `stThen` \ rc ->
-               writeHandle handle htype		    >>
-               if rc == 0 then
-		   return result
-               else
-		    constructErrorAndFail "hFileSize"
-{-
-\end{code}
-
-For a handle {\em hdl} which attached to a physical file, $hFileSize
-hdl$ returns the size of {\em hdl} in terms of the number of items
-which can be read from {\em hdl}.
-
-\begin{code}
--}
-hIsEOF :: Handle -> IO Bool
-hIsEOF handle =
-    readHandle handle				    >>= \ htype ->
-    case htype of 
-      ErrorHandle ioError ->
-	  writeHandle handle htype		    >>
-	  fail ioError
-      ClosedHandle -> 
-	  writeHandle handle htype		    >>
-          fail (IllegalOperation "handle is closed")
-      SemiClosedHandle _ _ -> 
-	  writeHandle handle htype		    >>
-          fail (IllegalOperation "handle is closed")
-      WriteHandle _ _ _ -> 
-	  writeHandle handle htype		    >>
-          fail (IllegalOperation "handle is not open for reading")
-      AppendHandle _ _ _ -> 
-	  writeHandle handle htype		    >>
-          fail (IllegalOperation "handle is not open for reading")
-      other -> 
-          _ccall_ fileEOF (filePtr other)	    `stThen` \ rc ->
-	  writeHandle handle (markHandle htype)	    >>
-	  case rc of
-            0 -> return False
-            1 -> return True
-            _ -> constructErrorAndFail "hIsEOF"
-
-isEOF :: IO Bool
-isEOF = hIsEOF stdin
-{-
-\end{code}
-
-For a readable handle {\em hdl}, computation $hIsEOF hdl$ returns
-$True$ if no further input can be taken from {\em hdl} or for a
-physical file, if the current I/O position is equal to the length of
-the file.  Otherwise, it returns $False$.
-
-\subsubsection[Buffering]{Buffering Operations}
-
-Three kinds of buffering are supported: line-buffering, 
-block-buffering or no-buffering.  These modes have the following effects.
-For output, items are written out from the internal buffer 
-according to the buffer mode:
-\begin{itemize}
-\item[line-buffering]  the entire output buffer is written
-out whenever a newline is output, the output buffer overflows, 
-a flush is issued, or the handle is closed.
-
-\item[block-buffering] the entire output buffer is written out whenever 
-it overflows, a flush is issued, or the handle
-is closed.
-
-\item[no-buffering] output is written immediately, and never stored
-in the output buffer.
-\end{itemize}
-
-The output buffer is emptied as soon as it has been written out.
-
-Similarly, input occurs according to the buffer mode for handle {\em hdl}.
-\begin{itemize}
-\item[line-buffering] when the input buffer for {\em hdl} is not empty,
-the next item is obtained from the buffer;
-otherwise, when the input buffer is empty,
-characters up to and including the next newline
-character are read into the buffer.  No characters
-are available until the newline character is
-available.
-\item[block-buffering] when the input buffer for {\em hdl} becomes empty,
-the next block of data is read into this buffer.
-\item[no-buffering] the next input item is read and returned.
-\end{itemize}
-For most implementations, physical files will normally be block-buffered 
-and terminals will normally be line-buffered.
-
-\begin{code}
--}
-data BufferMode  =  NoBuffering | LineBuffering | BlockBuffering (Maybe Int)
-                    deriving (Eq, Ord, Read, Show)
-
-hSetBuffering :: Handle -> BufferMode -> IO ()
-
-hSetBuffering handle mode =
-    case mode of
-      (BlockBuffering (Just n)) 
-        | n <= 0 -> fail (InvalidArgument "illegal buffer size")
-      other ->
-	  readHandle handle			    >>= \ htype ->
-          if isMarked htype then
-              writeHandle handle htype		    >>
-              fail (UnsupportedOperation "can't set buffering for a dirty handle")
-          else
-              case htype of
-	        ErrorHandle ioError ->
-	            writeHandle handle htype	    >>
-	            fail ioError
-                ClosedHandle ->
-		    writeHandle handle htype	    >>
-		    fail (IllegalOperation "handle is closed")
-                SemiClosedHandle _ _ ->
-		    writeHandle handle htype	    >>
-		    fail (IllegalOperation "handle is closed")
-                other ->
-                    _ccall_ setBuffering (filePtr other) bsize
-						    `stThen` \ rc -> 
-                    if rc == 0 then
-                        writeHandle handle ((hcon other) (filePtr other) (Just mode) True)
-						    >>
-		        return ()
-                    else
-			writeHandle handle htype	 >>
-		        constructErrorAndFail "hSetBuffering"
-		
-  where
-    isMarked :: Handle__ -> Bool
-    isMarked (ReadHandle fp m b) = b
-    isMarked (WriteHandle fp m b) = b
-    isMarked (AppendHandle fp m b) = b
-    isMarked (ReadWriteHandle fp m b) = b
-
-    bsize :: Int
-    bsize = case mode of
-              NoBuffering -> 0
-              LineBuffering -> -1
-              BlockBuffering Nothing -> -2
-              BlockBuffering (Just n) -> n
-
-    hcon :: Handle__ -> (Addr -> (Maybe BufferMode) -> Bool -> Handle__)
-    hcon (ReadHandle _ _ _) = ReadHandle
-    hcon (WriteHandle _ _ _) = WriteHandle
-    hcon (AppendHandle _ _ _) = AppendHandle
-    hcon (ReadWriteHandle _ _ _) = ReadWriteHandle
-{-
-\end{code}
-
-Computation $hSetBuffering hdl mode$ sets the mode of buffering for
-handle {\em hdl} on subsequent reads and writes.
-
-\begin{itemize}
-\item
-If {\em mode} is $LineBuffering$, line-buffering should be
-enabled if possible.
-\item
-If {\em mode} is $BlockBuffering$ {\em size}, then block-buffering
-should be enabled if possible.  The size of the buffer is {\em n} items
-if {\em size} is $Just${\em n} and is otherwise implementation-dependent.
-\item
-If {\em mode} is $NoBuffering$, then buffering is disabled if possible.
-\end{itemize}
-
-If the buffer mode is changed from $BlockBuffering$ or $LineBuffering$
-to $NoBuffering$, then any items in the output buffer are written to
-the device, and any items in the input buffer are discarded.  The
-default buffering mode when a handle is opened is
-implementation-dependent and may depend on the object which is
-attached to that handle.
-
-\begin{code}
--}
-hFlush :: Handle -> IO () 
-hFlush handle = 
-    readHandle handle				    >>= \ htype ->
-    case htype of 
-      ErrorHandle ioError ->
-	  writeHandle handle htype		    >>
-	  fail ioError
-      ClosedHandle ->
-	  writeHandle handle htype		    >>
-	  fail (IllegalOperation "handle is closed")
-      SemiClosedHandle _ _ ->
-	  writeHandle handle htype		    >>
-	  fail (IllegalOperation "handle is closed")
-      other ->
-	  _ccall_ flushFile (filePtr other)	    `stThen` \ rc ->
-	  writeHandle handle (markHandle htype)   >>
-               if rc == 0 then 
-		   return ()
-               else
-		    constructErrorAndFail "hFlush"
-{-
-\end{code}
-
-Computation $flush hdl$ causes any items
-buffered for output in handle {\em hdl} to be sent immediately to
-the operating system.
-
-\subsubsection[Seeking]{Repositioning Handles}
-
-\begin{code}
--}
-data HandlePosn = HandlePosn Handle Int
-
-instance Eq HandlePosn{-partain-}
-
-hGetPosn :: Handle -> IO HandlePosn
-hGetPosn handle = 
-    readHandle handle				    >>= \ htype ->
-    case htype of 
-      ErrorHandle ioError ->
-	  writeHandle handle htype		    >>
-	  fail ioError
-      ClosedHandle ->
-	  writeHandle handle htype		    >>
-	  fail (IllegalOperation "handle is closed")
-      SemiClosedHandle _ _ ->
-	  writeHandle handle htype		    >>
-	  fail (IllegalOperation "handle is closed")
-      other -> 
-          _ccall_ getFilePosn (filePtr other)      `stThen` \ posn ->
-          writeHandle handle htype		    >>
-          if posn /= -1 then
-	      return (HandlePosn handle posn)
-          else
-	      constructErrorAndFail "hGetPosn"
-
-hSetPosn :: HandlePosn -> IO () 
-hSetPosn (HandlePosn handle posn) = 
-    readHandle handle				    >>= \ htype ->
-    case htype of 
-      ErrorHandle ioError ->
-	  writeHandle handle htype		    >>
-	  fail ioError
-      ClosedHandle ->
-	  writeHandle handle htype		    >>
-	  fail (IllegalOperation "handle is closed")
-      SemiClosedHandle _ _ ->
-	  writeHandle handle htype		    >>
-	  fail (IllegalOperation "handle is closed")
-      AppendHandle _ _ _ ->
-	  writeHandle handle htype		    >>
-	  fail (IllegalOperation "handle is not seekable")
-      other -> 
-	  _ccall_ setFilePosn (filePtr other) posn `stThen` \ rc ->
-	  writeHandle handle (markHandle htype)    >>
-               if rc == 0 then 
-		   return ()
-               else
-		   constructErrorAndFail "hSetPosn"
-{-
-\end{code}
-
-Computation $hGetPosn hdl$ returns the current I/O
-position of {\em hdl} as an abstract position.  Computation
-$hSetPosn p$ sets the position of {\em hdl}
-to a previously obtained position {\em p}.
-
-\begin{code}
--}
-data SeekMode    =  AbsoluteSeek | RelativeSeek | SeekFromEnd
-                    deriving (Eq, Ord, Ix, Enum, Read, Show)
-
-hSeek :: Handle -> SeekMode -> Integer -> IO () 
-hSeek handle mode offset@(J# _ s# d#) = 
-    readHandle handle				    >>= \ htype ->
-    case htype of 
-      ErrorHandle ioError ->
-	  writeHandle handle htype		    >>
-	  fail ioError
-      ClosedHandle ->
-	  writeHandle handle htype		    >>
-	  fail (IllegalOperation "handle is closed")
-      SemiClosedHandle _ _ ->
-	  writeHandle handle htype		    >>
-	  fail (IllegalOperation "handle is closed")
-      AppendHandle _ _ _ ->
-	  writeHandle handle htype		    >>
-	  fail (IllegalOperation "handle is not seekable")
-      other -> 
-	  _ccall_ seekFile (filePtr other) whence (I# s#) (ByteArray (0,0) d#)
-                                        	    `stThen` \ rc ->
-	  writeHandle handle (markHandle htype)   >>
-               if rc == 0 then 
-		   return ()
-               else
-		    constructErrorAndFail "hSeek"
-  where
-    whence :: Int
-    whence = case mode of
-               AbsoluteSeek -> ``SEEK_SET''
-               RelativeSeek -> ``SEEK_CUR''
-               SeekFromEnd -> ``SEEK_END''
-{-
-\end{code}
-
-Computation $hSeek hdl mode i$ sets the position of handle
-{\em hdl} depending on $mode$.  If {\em mode} is
-\begin{itemize}
-\item[{\bf AbsoluteSeek}] The position of {\em hdl} is set to {\em i}.
-\item[{\bf RelativeSeek}] The position of {\em hdl} is set to offset {\em i} from
-the current position.
-\item[{\bf SeekToEnd}] The position of {\em hdl} is set to offset {\em i} from
-the end of the file.
-\item[{\bf SeekFromBeginning}] The position of {\em hdl} is set to offset {\em i} from
-the beginning of the file.
-\end{itemize}
-
-Some handles may not be seekable $hIsSeekable$, or only support a
-subset of the possible positioning operations (e.g. it may only be
-possible to seek to the end of a tape, or to a positive offset from
-the beginning or current position).
-
-It is not possible to set a negative I/O position, or for a physical
-file, an I/O position beyond the current end-of-file. 
-
-\subsubsection[Query]{Handle Properties}
-
-\begin{code}
--}
-hIsOpen :: Handle -> IO Bool
-hIsOpen handle = 
-    readHandle handle				    >>= \ htype ->
-    case htype of 
-      ErrorHandle ioError ->
-	  writeHandle handle htype		    >>
-          fail ioError
-      ClosedHandle ->
-	  writeHandle handle htype		    >>
-	  return False
-      SemiClosedHandle _ _ ->
-	  writeHandle handle htype		    >>
-	  return False
-      other ->
-	  writeHandle handle htype		    >>
-	  return True
-
-hIsClosed :: Handle -> IO Bool
-hIsClosed handle = 
-    readHandle handle				    >>= \ htype ->
-    case htype of 
-      ErrorHandle ioError ->
-	  writeHandle handle htype		    >>
-          fail ioError
-      ClosedHandle ->
-	  writeHandle handle htype		    >>
-	  return True
-      other ->
-	  writeHandle handle htype		    >>
-	  return False
-
-hIsReadable :: Handle -> IO Bool
-hIsReadable handle = 
-    readHandle handle				    >>= \ htype ->
-    case htype of 
-      ErrorHandle ioError ->
-	  writeHandle handle htype		    >>
-          fail ioError
-      ClosedHandle ->
-	  writeHandle handle htype		    >>
-	  fail (IllegalOperation "handle is closed")
-      SemiClosedHandle _ _ ->
-	  writeHandle handle htype		    >>
-	  fail (IllegalOperation "handle is closed")
-      other ->
-	  writeHandle handle htype		    >>
-	  return (isReadable other)
-  where
-    isReadable (ReadHandle _ _ _) = True
-    isReadable (ReadWriteHandle _ _ _) = True
-    isReadable _ = False
-
-hIsWritable :: Handle -> IO Bool
-hIsWritable handle = 
-    readHandle handle			    >>= \ htype ->
-    case htype of 
-      ErrorHandle ioError ->
-	  writeHandle handle htype	    >>
-          fail ioError
-      ClosedHandle ->
-	  writeHandle handle htype	    >>
-	  fail (IllegalOperation "handle is closed")
-      SemiClosedHandle _ _ ->
-	  writeHandle handle htype	    >>
-	  fail (IllegalOperation "handle is closed")
-      other ->
-	  writeHandle handle htype	    >>
-	  return (isWritable other)
-  where
-    isWritable (AppendHandle _ _ _) = True
-    isWritable (WriteHandle _ _ _) = True
-    isWritable (ReadWriteHandle _ _ _) = True
-    isWritable _ = False
-
-getBufferMode :: Handle__ -> PrimIO Handle__
-getBufferMode htype =
-    case bufferMode htype of
-      Just x -> returnPrimIO htype
-      Nothing ->
-	_ccall_ getBufferMode (filePtr htype)	    `thenPrimIO` \ rc ->
-	let 
-	    mode = 
-		case rc of
-                  0  -> Just NoBuffering
-                  -1 -> Just LineBuffering
-	          -2 -> Just (BlockBuffering Nothing)
-                  -3 -> Nothing
-                  n  -> Just (BlockBuffering (Just n))
-	in
-	returnPrimIO (case htype of
-	  ReadHandle      fp _ b -> ReadHandle      fp mode b
-	  WriteHandle     fp _ b -> WriteHandle     fp mode b
-	  AppendHandle    fp _ b -> AppendHandle    fp mode b
-	  ReadWriteHandle fp _ b -> ReadWriteHandle fp mode b)
-
-hIsBlockBuffered :: Handle -> IO (Bool,Maybe Int)
-hIsBlockBuffered handle =
-    readHandle handle				    >>= \ htype ->
-    case htype of 
-      ErrorHandle ioError ->
-	  writeHandle handle htype		    >>
-          fail ioError
-      ClosedHandle ->
-	  writeHandle handle htype		    >>
-	  fail (IllegalOperation "handle is closed")
-      SemiClosedHandle _ _ ->
-	  writeHandle handle htype		    >>
-	  fail (IllegalOperation "handle is closed")
-      other ->
-          getBufferMode other			    `stThen` \ other ->
-          case bufferMode other of
-            Just (BlockBuffering size) ->
-	        writeHandle handle other	    >>
-                return (True, size)
-            Just _ ->
-	        writeHandle handle other	    >>
-                return (False, Nothing)
-    	    Nothing -> 
-		constructErrorAndFail "hIsBlockBuffered"
-
-hIsLineBuffered :: Handle -> IO Bool
-hIsLineBuffered handle =
-    readHandle handle				    >>= \ htype ->
-    case htype of 
-      ErrorHandle ioError ->
-	  writeHandle handle htype		    >>
-          fail ioError
-      ClosedHandle ->
-	  writeHandle handle htype		    >>
-	  fail (IllegalOperation "handle is closed")
-      SemiClosedHandle _ _ ->
-	  writeHandle handle htype		    >>
-	  fail (IllegalOperation "handle is closed")
-      other ->
-	  getBufferMode other			    `stThen` \ other ->
-          case bufferMode other of
-            Just LineBuffering ->
-	        writeHandle handle other	    >>
-                return True
-            Just _ ->
-	        writeHandle handle other	    >>
-                return False
-    	    Nothing -> 
-		constructErrorAndFail "hIsLineBuffered"
-
-hIsNotBuffered :: Handle -> IO Bool
-hIsNotBuffered handle =
-    readHandle handle				    >>= \ htype ->
-    case htype of 
-      ErrorHandle ioError ->
-	  writeHandle handle htype		    >>
-          fail ioError
-      ClosedHandle ->
-	  writeHandle handle htype		    >>
-	  fail (IllegalOperation "handle is closed")
-      SemiClosedHandle _ _ ->
-	  writeHandle handle htype		    >>
-	  fail (IllegalOperation "handle is closed")
-      other ->
-	  getBufferMode other			    `stThen` \ other ->
-          case bufferMode other of
-            Just NoBuffering ->
-	        writeHandle handle other	    >>
-                return True
-            Just _ ->
-	        writeHandle handle other	    >>
-                return False
-    	    Nothing -> 
-		constructErrorAndFail "hIsNotBuffered"
-
-hGetBuffering :: Handle -> IO BufferMode
-hGetBuffering hndl =
-    readHandle hndl				    >>= \ htype ->
-    case htype of 
-      ErrorHandle ioError ->
-	  writeHandle hndl htype		    >>
-          fail ioError
-      ClosedHandle ->
-	  writeHandle hndl htype		    >>
-	  fail (IllegalOperation "handle is closed")
-      SemiClosedHandle _ _ ->
-	  writeHandle hndl htype		    >>
-	  fail (IllegalOperation "handle is closed")
-      other ->
-	  getBufferMode other			    `stThen` \ other ->
-          case bufferMode other of
-            Just v ->
-	        writeHandle hndl other	            >>
-                return v
-    	    Nothing -> 
-		constructErrorAndFail "hGetBuffering"
-
-hIsSeekable :: Handle -> IO Bool
-hIsSeekable handle = 
-    readHandle handle				    >>= \ htype ->
-    case htype of 
-      ErrorHandle ioError ->
-	  writeHandle handle htype		    >>
-          fail ioError
-      ClosedHandle ->
-	  writeHandle handle htype		    >>
-	  fail (IllegalOperation "handle is closed")
-      SemiClosedHandle _ _ ->
-	  writeHandle handle htype		    >>
-	  fail (IllegalOperation "handle is closed")
-      AppendHandle _ _ _ ->
-	  writeHandle handle htype		    >>
-	  return False
-      other ->
-	  _ccall_ seekFileP (filePtr other)   	    `stThen` \ rc ->
-	  writeHandle handle htype		    >>
-	  case rc of
-            0 -> return False
-            1 -> return True
-            _ -> constructErrorAndFail "hIsSeekable"
-{-
-\end{code}
-
-A number of operations return information about the properties of a
-handle.  Each of these operations returns $True$ if the
-handle has the specified property, and $False$
-otherwise.
-
-Computation $hIsBlockBuffered hdl$ returns $( False, Nothing )$ if
-{\em hdl} is not block-buffered.  Otherwise it returns 
-$( True, size )$, where {\em size} is $Nothing$ for default buffering, and 
-$( Just n )$ for block-buffering of {\em n} bytes.
--}
-
--------------------------------------------------------------------
-data IOError
-  = AlreadyExists		String
-  | HardwareFault		String
-  | IllegalOperation		String
-  | InappropriateType		String
-  | Interrupted			String
-  | InvalidArgument		String
-  | NoSuchThing			String
-  | OtherError			String
-  | PermissionDenied		String
-  | ProtocolError		String
-  | ResourceBusy		String
-  | ResourceExhausted		String
-  | ResourceVanished		String
-  | SystemError			String
-  | TimeExpired			String
-  | UnsatisfiedConstraints	String
-  | UnsupportedOperation	String
-  | UserError			String
-  | EOF
-
-instance Eq IOError where
-    -- I don't know what the (pointless) idea is here,
-    -- presumably just compare them by their tags (WDP)
-    a == b = tag a == tag b
-      where
-	tag (AlreadyExists _)		= (1::Int)
-	tag (HardwareFault _)		= 2
-	tag (IllegalOperation _)	= 3
-	tag (InappropriateType _)	= 4
-	tag (Interrupted _)		= 5
-	tag (InvalidArgument _)		= 6
-	tag (NoSuchThing _)		= 7
-	tag (OtherError _)		= 8
-	tag (PermissionDenied _)	= 9
-	tag (ProtocolError _)		= 10
-	tag (ResourceBusy _)		= 11
-	tag (ResourceExhausted _)	= 12
-	tag (ResourceVanished _)	= 13
-	tag (SystemError _)		= 14
-	tag (TimeExpired _)		= 15
-	tag (UnsatisfiedConstraints _)	= 16
-	tag (UnsupportedOperation _)	= 17
-	tag (UserError _)		= 18
-	tag EOF				= 19
-
-instance Show IOError where
-    showsPrec p (AlreadyExists s)	= show2 "AlreadyExists: "	s
-    showsPrec p (HardwareFault s)	= show2 "HardwareFault: "	s
-    showsPrec p (IllegalOperation s)	= show2 "IllegalOperation: "	s
-    showsPrec p (InappropriateType s)	= show2 "InappropriateType: "	s
-    showsPrec p (Interrupted s)		= show2 "Interrupted: "		s
-    showsPrec p (InvalidArgument s)	= show2 "InvalidArgument: "	s
-    showsPrec p (NoSuchThing s)		= show2 "NoSuchThing: "		s
-    showsPrec p (OtherError s)		= show2 "OtherError: "		s
-    showsPrec p (PermissionDenied s)	= show2 "PermissionDenied: "	s
-    showsPrec p (ProtocolError s)	= show2 "ProtocolError: "	s
-    showsPrec p (ResourceBusy s)	= show2 "ResourceBusy: "	s
-    showsPrec p (ResourceExhausted s)	= show2 "ResourceExhausted: "	s
-    showsPrec p (ResourceVanished s)	= show2 "ResourceVanished: "	s
-    showsPrec p (SystemError s)		= show2 "SystemError: "		s
-    showsPrec p (TimeExpired s)		= show2 "TimeExpired: "		s
-    showsPrec p (UnsatisfiedConstraints s) = show2 "UnsatisfiedConstraints: " s
-    showsPrec p (UnsupportedOperation s)= show2 "UnsupportedOperation: " s
-    showsPrec p (UserError s)		= showString s
-    showsPrec p EOF			= showString "EOF"
-
-show2 x y = showString x . showString y
-
-{-
-
-The @String@ part of an @IOError@ is platform-dependent.  However, to
-provide a uniform mechanism for distinguishing among errors within
-these broad categories, each platform-specific standard shall specify
-the exact strings to be used for particular errors.  For errors not
-explicitly mentioned in the standard, any descriptive string may be
-used.
-
-  SOF 4/96 - added argument to indicate function that flagged error
--}
-constructErrorAndFail :: String -> IO a
-constructError	      :: String -> PrimIO IOError
-
-constructErrorAndFail call_site
-  = stToIO (constructError call_site) >>= \ io_error ->
-    fail io_error
-
-constructError call_site
-  = _casm_ ``%r = ghc_errtype;''    >>= \ (I# errtype#) ->
-    _casm_ ``%r = ghc_errstr;''	    >>= \ str ->
-    let
-	msg = call_site ++ ':' : ' ' : GHCps.unpackPS (GHCps.packCString str)
-    in
-    return (case errtype# of
-	ERR_ALREADYEXISTS#		-> AlreadyExists msg
-	ERR_HARDWAREFAULT#		-> HardwareFault msg
-	ERR_ILLEGALOPERATION#		-> IllegalOperation msg
-	ERR_INAPPROPRIATETYPE#		-> InappropriateType msg
-	ERR_INTERRUPTED#		-> Interrupted msg
-	ERR_INVALIDARGUMENT#		-> InvalidArgument msg
-	ERR_NOSUCHTHING#		-> NoSuchThing msg
-	ERR_OTHERERROR#			-> OtherError msg
-	ERR_PERMISSIONDENIED#		-> PermissionDenied msg
-	ERR_PROTOCOLERROR#		-> ProtocolError msg
-	ERR_RESOURCEBUSY#		-> ResourceBusy msg
-	ERR_RESOURCEEXHAUSTED#		-> ResourceExhausted msg
-	ERR_RESOURCEVANISHED#		-> ResourceVanished msg
-	ERR_SYSTEMERROR#		-> SystemError msg
-	ERR_TIMEEXPIRED#		-> TimeExpired msg
-	ERR_UNSATISFIEDCONSTRAINTS#	-> UnsatisfiedConstraints msg
-	ERR_UNSUPPORTEDOPERATION#	-> UnsupportedOperation msg
-	ERR_EOF#			-> EOF
-	_				-> OtherError "bad error construct"
-    )
diff --git a/ghc/lib/prelude/GHCmain.hs b/ghc/lib/prelude/GHCmain.hs
deleted file mode 100644
index bb8f19f2ee..0000000000
--- a/ghc/lib/prelude/GHCmain.hs
+++ /dev/null
@@ -1,29 +0,0 @@
--- This is the mainPrimIO that must be used for Haskell~1.3.
-
-module GHCmain ( mainPrimIO ) where
-
-import qualified Main	-- for type of "Main.main"
-import GHCbase
-
-mainPrimIO :: PrimIO ()
-
-mainPrimIO = ST $ \ s ->
-    case Main.main   of { IO (ST main_guts) ->
-    case main_guts s of { (result, s2@(S# _)) ->
-    case result   of
-      Right ()  -> ( (), s2 )
-      Left  err -> error ("I/O error: "++showsPrec 0 err "\n")
-    }}
-
-{-
-OLD COMMENT:
-
-Nota Bene!  @mainIO@ is written as an explicit function, rather than
-by saying: @mainIO = requestToIO main@ so that the code generator
-recognises @mainIO@ as a {\em function} (hence HNF, hence not
-updatable), rather than a zero-arity CAF (hence updatable).  If it is
-updated, then we have a mega-space leak, because the entire action
-(@requestToIO main@) is retained indefinitely.
-
-(This doesn't waste work because @mainIO@ is only used once.)
--}
diff --git a/ghc/lib/prelude/GHCps.hs b/ghc/lib/prelude/GHCps.hs
deleted file mode 100644
index 1d1255f077..0000000000
--- a/ghc/lib/prelude/GHCps.hs
+++ /dev/null
@@ -1,1007 +0,0 @@
-{-
-%
-% (c) The GRASP/AQUA Project, Glasgow University, 1993-1996
-%
-\section{Packed strings}
-
-This sits on top of the sequencing/arrays world, notably @ByteArray#@s.
-
-Glorious hacking (all the hard work) by Bryan O'Sullivan.
-
-\begin{code}
--}
-module GHCps (
-
-	packString,        -- :: [Char] -> PackedString
-	packStringST,      -- :: [Char] -> ST s PackedString
-	packCString,       -- :: Addr  -> PackedString
-	packCBytes,        -- :: Int -> Addr -> PackedString
-	packCBytesST,      -- :: Int -> Addr -> ST s PackedString
-	packStringForC,    -- :: [Char] -> ByteArray#
-        packBytesForC,     -- :: [Char] -> ByteArray Int
-        packBytesForCST,   -- :: [Char] -> ST s (ByteArray Int)
-	nilPS,             -- :: PackedString
-	consPS,            -- :: Char -> PackedString -> PackedString
-
-	byteArrayToPS,       -- :: ByteArray Int -> PackedString
-	unsafeByteArrayToPS, -- :: ByteArray a   -> Int -> PackedString
-	psToByteArray,       -- :: PackedString  -> ByteArray Int
-
-	unpackPS,    -- :: PackedString -> [Char]
-{-LATER:
-	hPutPS,      -- :: Handle -> PackedString -> IO ()
-        putPS,       -- :: FILE -> PackedString -> PrimIO () -- ToDo: more sensible type
-	getPS,       -- :: FILE -> Int -> PrimIO PackedString
--}
-	headPS,      -- :: PackedString -> Char
-	tailPS,      -- :: PackedString -> PackedString
-	nullPS,      -- :: PackedString -> Bool
-	appendPS,    -- :: PackedString -> PackedString -> PackedString
-	lengthPS,    -- :: PackedString -> Int
-          {- 0-origin indexing into the string -}
-	indexPS,     -- :: PackedString -> Int -> Char
-	mapPS,       -- :: (Char -> Char) -> PackedString -> PackedString
-	filterPS,    -- :: (Char -> Bool) -> PackedString -> PackedString
-	foldlPS,     -- :: (a -> Char -> a) -> a -> PackedString -> a
-	foldrPS,     -- :: (Char -> a -> a) -> a -> PackedString -> a
-	takePS,      -- :: Int -> PackedString -> PackedString
-	dropPS,      -- :: Int -> PackedString -> PackedString
-	splitAtPS,   -- :: Int -> PackedString -> (PackedString, PackedString)
-	takeWhilePS, -- :: (Char -> Bool) -> PackedString -> PackedString
-	dropWhilePS, -- :: (Char -> Bool) -> PackedString -> PackedString
-	spanPS,      -- :: (Char -> Bool) -> PackedString -> (PackedString, PackedString)
-	breakPS,     -- :: (Char -> Bool) -> PackedString -> (PackedString, PackedString)
-	linesPS,     -- :: PackedString -> [PackedString]
-
-	wordsPS,     -- :: PackedString -> [PackedString]
-	reversePS,   -- :: PackedString -> PackedString
-	splitPS,     -- :: Char -> PackedString -> [PackedString]
-	splitWithPS, -- :: (Char -> Bool) -> PackedString -> [PackedString]
-	joinPS,      -- :: PackedString -> [PackedString] -> PackedString
-	concatPS,    -- :: [PackedString] -> PackedString
-	elemPS,      -- :: Char -> PackedString -> Bool
-
-	 {-
-           pluck out a piece of a PS start and end
-	   chars you want; both 0-origin-specified
-         -}
-	substrPS,    -- :: PackedString -> Int -> Int -> PackedString
-
-	comparePS
-    ) where
-
-import Ix	( Ix(..) )
-import Char	( isSpace )
-import GHCbase
-{-
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection{@PackedString@ type declaration}
-%*									*
-%************************************************************************
-
-The type comes from GHCbase; we re-export it abstractly.
-
-%************************************************************************
-%*									*
-\subsection{@PackedString@ instances}
-%*									*
-%************************************************************************
-
-We try hard to make this go fast:
-\begin{code}
--}
-comparePS :: PackedString -> PackedString -> Ordering
-
-comparePS (PS  bs1 len1 has_null1) (PS  bs2 len2 has_null2)
-  | not has_null1 && not has_null2
-  = unsafePerformPrimIO (
-    _ccall_ strcmp ba1 ba2  >>= \ (I# res) ->
-    return (
-    if      res <#  0# then LT
-    else if res ==# 0# then EQ
-    else		    GT
-    ))
-  where
-    ba1 = ByteArray (0, I# (len1 -# 1#)) bs1
-    ba2 = ByteArray (0, I# (len2 -# 1#)) bs2
-
-comparePS (PS  bs1 len1 has_null1) (CPS bs2 len2)
-  | not has_null1
-  = unsafePerformPrimIO (
-    _ccall_ strcmp ba1 ba2  >>= \ (I# res) ->
-    return (
-    if      res <#  0# then LT
-    else if res ==# 0# then EQ
-    else		    GT
-    ))
-  where
-    ba1 = ByteArray (0, I# (len1 -# 1#)) bs1
-    ba2 = A# bs2
-
-comparePS (CPS bs1 len1) (CPS bs2 len2)
-  = unsafePerformPrimIO (
-    _ccall_ strcmp ba1 ba2  >>= \ (I# res) ->
-    return (
-    if      res <#  0# then LT
-    else if res ==# 0# then EQ
-    else		    GT
-    ))
-  where
-    ba1 = A# bs1
-    ba2 = A# bs2
-
-comparePS a@(CPS _ _) b@(PS _ _ has_null2)
-  | not has_null2
-  = -- try them the other way 'round
-    case (comparePS b a) of { LT -> GT; EQ -> EQ; GT -> LT }
-
-comparePS ps1 ps2 -- slow catch-all case (esp for "has_null" True)
-  = looking_at 0#
-  where
-    end1 = lengthPS# ps1 -# 1#
-    end2 = lengthPS# ps2 -# 1#
-
-    looking_at char#
-      = if char# ># end1 then
-	   if char# ># end2 then -- both strings ran out at once
-	      EQ
-	   else	-- ps1 ran out before ps2
-	      LT
-	else if char# ># end2 then
-	   GT	-- ps2 ran out before ps1
-	else
-	   let
-	      ch1 = indexPS# ps1 char#
-	      ch2 = indexPS# ps2 char#
-	   in
-	   if ch1 `eqChar#` ch2 then
-	      looking_at (char# +# 1#)
-	   else if ch1 `ltChar#` ch2 then LT
-				     else GT
-
-{-
-\end{code}
-%************************************************************************
-%*									*
-\subsection{Constructor functions}
-%*									*
-%************************************************************************
-
-Easy ones first.  @packString@ requires getting some heap-bytes and
-scribbling stuff into them.
-
-\begin{code}
--}
-packCString	 :: Addr  -> PackedString
-packCString (A# a#) =	-- the easy one; we just believe the caller
- CPS a# len
- where
-  len = case (strlen# a#) of { I# x -> x }
-
-nilPS :: PackedString
-nilPS = CPS ""# 0#
-
-consPS :: Char -> PackedString -> PackedString
-consPS c cs = packString (c : (unpackPS cs)) -- ToDo:better
-
-packStringForC :: [Char] -> ByteArray#
-packStringForC = packStringForC__ -- from GHCbase
-
-packBytesForC :: [Char] -> ByteArray Int
-packBytesForC str = psToByteArray (packString str)
-
-packBytesForCST :: [Char] -> ST s (ByteArray Int)
-packBytesForCST str =
-  packStringST str	>>= \ (PS bytes n has_null) -> 
-   --later? ASSERT(not has_null)
-  return (ByteArray (0, I# (n -# 1#)) bytes)
-
-packNBytesForCST :: Int -> [Char] -> ST s (ByteArray Int)
-packNBytesForCST len str =
-  packNCharsST len str	>>= \ (PS bytes n has_null) -> 
-  return (ByteArray (0, I# (n -# 1#)) bytes)
-
-packString :: [Char] -> PackedString
-packString str = runST (packStringST str)
-
-packStringST :: [Char] -> ST s PackedString
-packStringST str =
-  let len = length str  in
-  packNCharsST len str
-
-packNCharsST :: Int -> [Char] -> ST s PackedString
-packNCharsST len@(I# length#) str =
-  {- 
-   allocate an array that will hold the string
-   (not forgetting the NUL byte at the end)
-  -}
- new_ps_array (length# +# 1#) >>= \ ch_array ->
-   -- fill in packed string from "str"
- fill_in ch_array 0# str   >>
-   -- freeze the puppy:
- freeze_ps_array ch_array >>= \ (ByteArray _ frozen#) ->
- let has_null = byteArrayHasNUL# frozen# length# in
- return (PS frozen# length# has_null)
- where
-  fill_in :: MutableByteArray s Int -> Int# -> [Char] -> ST s ()
-  fill_in arr_in# idx [] =
-   write_ps_array arr_in# idx (chr# 0#) >>
-   return ()
-
-  fill_in arr_in# idx (C# c : cs) =
-   write_ps_array arr_in# idx c	 >>
-   fill_in arr_in# (idx +# 1#) cs
-
-packCBytes :: Int -> Addr -> PackedString
-packCBytes len addr = runST (packCBytesST len addr)
-
-packCBytesST :: Int -> Addr -> ST s PackedString
-packCBytesST len@(I# length#) (A# addr) =
-  {- 
-    allocate an array that will hold the string
-    (not forgetting the NUL byte at the end)
-  -}
-  new_ps_array (length# +# 1#)  >>= \ ch_array ->
-   -- fill in packed string from "addr"
-  fill_in ch_array 0#   >>
-   -- freeze the puppy:
-  freeze_ps_array ch_array >>= \ (ByteArray _ frozen#) ->
-  let has_null = byteArrayHasNUL# frozen# length# in
-  return (PS frozen# length# has_null)
-  where
-    fill_in :: MutableByteArray s Int -> Int# -> ST s ()
-
-    fill_in arr_in# idx
-      | idx ==# length#
-      = write_ps_array arr_in# idx (chr# 0#) >>
-	return ()
-      | otherwise
-      = case (indexCharOffAddr# addr idx) of { ch ->
-	write_ps_array arr_in# idx ch >>
-	fill_in arr_in# (idx +# 1#) }
-
-byteArrayToPS :: ByteArray Int -> PackedString
-byteArrayToPS (ByteArray ixs@(_, ix_end) frozen#) =
- let
-  n# = 
-   case (
-	 if null (range ixs)
-	  then 0
-	  else ((index ixs ix_end) + 1)
-        ) of { I# x -> x }
- in
- PS frozen# n# (byteArrayHasNUL# frozen# n#)
-
-unsafeByteArrayToPS :: ByteArray a -> Int -> PackedString
-unsafeByteArrayToPS (ByteArray _ frozen#) (I# n#)
-  = PS frozen# n# (byteArrayHasNUL# frozen# n#)
-
-psToByteArray	 :: PackedString -> ByteArray Int
-psToByteArray (PS bytes n has_null)
-  = ByteArray (0, I# (n -# 1#)) bytes
-
-psToByteArray (CPS addr len#)
-  = let
-	len		= I# len#
-	byte_array_form = packCBytes len (A# addr)
-    in
-    case byte_array_form of { PS bytes _ _ ->
-    ByteArray (0, len - 1) bytes }
-{-
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection{Destructor functions (taking @PackedStrings@ apart)}
-%*									*
-%************************************************************************
-
-\begin{code}
--}
--- OK, but this code gets *hammered*:
--- unpackPS ps
---   = [ indexPS ps n | n <- [ 0::Int .. lengthPS ps - 1 ] ]
-
-unpackPS :: PackedString -> [Char]
-unpackPS (PS bytes len has_null)
- = unpack 0#
- where
-    unpack nh
-      | nh >=# len  = []
-      | otherwise   = C# ch : unpack (nh +# 1#)
-      where
-	ch = indexCharArray# bytes nh
-
-unpackPS (CPS addr len)
-  = unpack 0#
-  where
-    unpack nh
-      | ch `eqChar#` '\0'# = []
-      | otherwise	   = C# ch : unpack (nh +# 1#)
-      where
-	ch = indexCharOffAddr# addr nh
-{-
-\end{code}
-
-Output a packed string via a handle:
-
-\begin{code}
--}
-{- LATER:
-hPutPS :: Handle -> PackedString -> IO ()
-hPutPS handle ps = 
- let
-  len = 
-   case ps of
-    PS  _ len _ -> len
-    CPS _ len   -> len
- in
- if len ==# 0# then
-    return ()
- else
-    _readHandle handle				    >>= \ htype ->
-    case htype of 
-      _ErrorHandle ioError ->
-	  _writeHandle handle htype		    >>
-          failWith ioError
-      _ClosedHandle ->
-	  _writeHandle handle htype		    >>
-	  failWith (IllegalOperation "handle is closed")
-      _SemiClosedHandle _ _ ->
-	  _writeHandle handle htype		    >>
-	  failWith (IllegalOperation "handle is closed")
-      _ReadHandle _ _ _ ->
-	  _writeHandle handle htype		    >>
-	  failWith (IllegalOperation "handle is not open for writing")
-      other -> 
-          _getBufferMode other			    >>= \ other ->
-          (case _bufferMode other of
-            Just LineBuffering ->
-		writeLines (_filePtr other)
-            Just (BlockBuffering (Just size)) ->
-	        writeBlocks (_filePtr other) size
-            Just (BlockBuffering Nothing) ->
-	        writeBlocks (_filePtr other) ``BUFSIZ''
-            _ -> -- Nothing is treated pessimistically as NoBuffering
-	        writeChars (_filePtr other) 0#
-	  )    					    >>= \ success ->
-	    _writeHandle handle (_markHandle other) >>
-          if success then
-              return ()
-          else
-              _constructError "hPutStr"   	    >>= \ ioError ->
-	      failWith ioError
-
-  where
-    pslen = lengthPS# ps
-
-    writeLines :: Addr -> PrimIO Bool
-    writeLines = writeChunks ``BUFSIZ'' True 
-
-    writeBlocks :: Addr -> Int -> PrimIO Bool
-    writeBlocks fp size = writeChunks size False fp
- 
-     {-
-       The breaking up of output into lines along \n boundaries
-       works fine as long as there are newlines to split by.
-       Avoid the splitting up into lines altogether (doesn't work
-       for overly long lines like the stuff that showsPrec instances
-       normally return). Instead, we split them up into fixed size
-       chunks before blasting them off to the Real World.
-
-       Hacked to avoid multiple passes over the strings - unsightly, but
-       a whole lot quicker. -- SOF 3/96
-     -}
-
-    writeChunks :: Int -> Bool -> Addr -> PrimIO Bool
-    writeChunks (I# bufLen) chopOnNewLine fp =
-     newCharArray (0,I# bufLen) >>= \ arr@(MutableByteArray _ arr#) ->
-     let
-      shoveString :: Int# -> Int# -> PrimIO Bool
-      shoveString n i 
-       | i ==# pslen =   -- end of string
-	   if n ==# 0# then
-	      return True
-	   else
-             _ccall_ writeFile arr fp (I# n) >>= \rc ->
-             return (rc==0)
-       | otherwise =
-	   (\ (S# s#) ->
-              case writeCharArray# arr# n (indexPS# ps i) s# of
-	        s1# -> 
-		   {- Flushing lines - should we bother? -}
-		  (if n ==# bufLen then
-                     _ccall_ writeFile arr fp (I# (n +# 1#)) >>= \rc ->
-	             if rc == 0 then
-	                shoveString 0# (i +# 1#)
-	              else
-	                return False
-                   else
-                      shoveString (n +# 1#) (i +# 1#)) (S# s1#))
-     in
-     shoveString 0# 0#
-
-    writeChars :: Addr -> Int# -> PrimIO Bool
-    writeChars fp i 
-      | i ==# pslen = return True
-      | otherwise  =
-	_ccall_ filePutc fp (ord (C# (indexPS# ps i)))  >>= \ rc ->
-        if rc == 0 then
-	    writeChars fp (i +# 1#)
-	else
-	    return False
-
----------------------------------------------
-
-putPS :: _FILE -> PackedString -> PrimIO ()
-putPS file ps@(PS bytes len has_null)
-  | len ==# 0#
-  = return ()
-  | otherwise
-  = let
-	byte_array = ByteArray (0, I# (len -# 1#)) bytes
-    in
-    _ccall_ fwrite byte_array (1::Int){-size-} (I# len) file
-					>>= \ (I# written) ->
-    if written ==# len then
-	return ()
-    else
-	error "GHCps.putPS: fwrite failed!\n"
-
-putPS file (CPS addr len)
-  | len ==# 0#
-  = return ()
-  | otherwise
-  = _ccall_ fputs (A# addr) file >>= \ (I# _){-force type-} ->
-    return ()
-{-
-\end{code}
-
-The dual to @_putPS@, note that the size of the chunk specified
-is the upper bound of the size of the chunk returned.
-
-\begin{code}
--}
-getPS :: _FILE -> Int -> PrimIO PackedString
-getPS file len@(I# len#)
- | len# <=# 0# = return nilPS -- I'm being kind here.
- | otherwise   =
-    -- Allocate an array for system call to store its bytes into.
-   new_ps_array len#      >>= \ ch_arr ->
-   freeze_ps_array ch_arr >>= \ (ByteArray _ frozen#) ->
-   let
-    byte_array = ByteArray (0, I# len#) frozen#
-   in
-   _ccall_ fread byte_array (1::Int) len file >>= \  (I# read#) ->
-   if read# ==# 0# then -- EOF or other error
-      error "GHCps.getPS: EOF reached or other error"
-   else
-     {-
-       The system call may not return the number of
-       bytes requested. Instead of failing with an error
-       if the number of bytes read is less than requested,
-       a packed string containing the bytes we did manage
-       to snarf is returned.
-     -}
-     let
-      has_null = byteArrayHasNUL# frozen# read#
-     in 
-     return (PS frozen# read# has_null)
-END LATER -}
-{-
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection{List-mimicking functions for @PackedStrings@}
-%*									*
-%************************************************************************
-
-First, the basic functions that do look into the representation;
-@indexPS@ is the most important one.
-\begin{code}
--}
-lengthPS   :: PackedString -> Int
-lengthPS ps = I# (lengthPS# ps)
-
-{-# INLINE lengthPS# #-}
-
-lengthPS# (PS  _ i _) = i
-lengthPS# (CPS _ i)   = i
-
-{-# INLINE strlen# #-}
-
-strlen# :: Addr# -> Int
-strlen# a
-  = unsafePerformPrimIO (
-    _ccall_ strlen (A# a)  >>= \ len@(I# _) ->
-    return len
-    )
-
-byteArrayHasNUL# :: ByteArray# -> Int#{-length-} -> Bool
-byteArrayHasNUL# bs len
-  = unsafePerformPrimIO (
-    _ccall_ byteArrayHasNUL__ ba (I# len)  >>= \ (I# res) ->
-    return (
-    if res ==# 0# then False else True
-    ))
-  where
-    ba = ByteArray (0, I# (len -# 1#)) bs
-
------------------------
-
-indexPS :: PackedString -> Int -> Char
-indexPS ps (I# n) = C# (indexPS# ps n)
-
-{-# INLINE indexPS# #-}
-
-indexPS# (PS bs i _) n
-  = --ASSERT (n >=# 0# && n <# i)	-- error checking: my eye!  (WDP 94/10)
-    indexCharArray# bs n
-
-indexPS# (CPS a _) n
-  = indexCharOffAddr# a n
-{-
-\end{code}
-
-Now, the rest of the functions can be defined without digging
-around in the representation.
-
-\begin{code}
--}
-headPS :: PackedString -> Char
-headPS ps
-  | nullPS ps = error "GHCps.headPS: head []"
-  | otherwise  = C# (indexPS# ps 0#)
-
-tailPS :: PackedString -> PackedString
-tailPS ps
-  | len <=# 0# = error "GHCps.tailPS: tail []"
-  | len ==# 1# = nilPS
-  | otherwise  = substrPS# ps 1# (len -# 1#)
-  where
-    len = lengthPS# ps
-
-nullPS :: PackedString -> Bool
-nullPS (PS  _ i _) = i ==# 0#
-nullPS (CPS _ i)   = i ==# 0#
-
-{- (ToDo: some non-lousy implementations...)
-
-    Old : _appendPS xs  ys = packString (unpackPS xs ++ unpackPS ys)
-
--}
-appendPS :: PackedString -> PackedString -> PackedString
-appendPS xs ys
-  | nullPS xs = ys
-  | nullPS ys = xs
-  | otherwise  = concatPS [xs,ys]
-
-{- OLD: mapPS f xs = packString (map f (unpackPS xs)) -}
-
-mapPS :: (Char -> Char) -> PackedString -> PackedString {-or String?-}
-mapPS f xs = 
-  if nullPS xs then
-     xs
-  else
-     runST (
-       new_ps_array (length +# 1#)         >>= \ ps_arr ->
-       whizz ps_arr length 0#              >>
-       freeze_ps_array ps_arr	           >>= \ (ByteArray _ frozen#) ->
-       let has_null = byteArrayHasNUL# frozen# length in
-       return (PS frozen# length has_null))
-  where
-   length = lengthPS# xs
-
-   whizz :: MutableByteArray s Int -> Int# -> Int# -> ST s ()
-   whizz arr# n i 
-    | n ==# 0#
-      = write_ps_array arr# i (chr# 0#) >>
-	return ()
-    | otherwise
-      = let
-	 ch = indexPS# xs i
-	in
-	write_ps_array arr# i (case f (C# ch) of { (C# x) -> x})     >>
-	whizz arr# (n -# 1#) (i +# 1#)
-
-filterPS :: (Char -> Bool) -> PackedString -> PackedString {-or String?-}
-filterPS pred ps = 
-  if nullPS ps then
-     ps
-  else
-     {-
-      Filtering proceeds as follows:
-      
-       * traverse the list, applying the pred. to each element,
-	 remembering the positions where it was satisfied.
-
-	 Encode these positions using a run-length encoding of the gaps
-	 between the matching positions. 
- 
-       * Allocate a MutableByteArray in the heap big enough to hold
-         all the matched entries, and copy the elements that matched over.
-
-      A better solution that merges the scan&copy passes into one,
-      would be to copy the filtered elements over into a growable
-      buffer. No such operation currently supported over
-      MutableByteArrays (could of course use malloc&realloc)
-      But, this solution may in the case of repeated realloc's
-      be worse than the current solution.
-     -}
-     runST (
-       let
-        (rle,len_filtered) = filter_ps len# 0# 0# []
-	len_filtered#      = case len_filtered of { I# x# -> x#}
-       in
-       if len# ==# len_filtered# then 
-         {- not much filtering as everything passed through. -}
-         return ps
-       else if len_filtered# ==# 0# then
-	 return nilPS
-       else
-         new_ps_array (len_filtered# +# 1#) >>= \ ps_arr ->
-         copy_arr ps_arr rle 0# 0#          >>
-         freeze_ps_array ps_arr	            >>= \ (ByteArray _ frozen#) ->
-         let has_null = byteArrayHasNUL# frozen# len_filtered# in
-         return (PS frozen# len_filtered# has_null))
-  where
-   len# = lengthPS# ps
-
-   matchOffset :: Int# -> [Char] -> (Int,[Char])
-   matchOffset off [] = (I# off,[])
-   matchOffset off (C# c:cs) =
-    let
-     x    = ord# c
-     off' = off +# x
-    in
-    if x==# 0# then -- escape code, add 255#
-       matchOffset off' cs
-    else
-       (I# off', cs)
-
-   copy_arr :: MutableByteArray s Int -> [Char] -> Int# -> Int# -> ST s ()
-   copy_arr arr# [_] _ _ = return ()
-   copy_arr arr# ls  n i =
-     let
-      (x,ls') = matchOffset 0# ls
-      n'      = n +# (case x of { (I# x#) -> x#}) -# 1#
-      ch      = indexPS# ps n'
-     in
-     write_ps_array arr# i ch                >>
-     copy_arr arr# ls' (n' +# 1#) (i +# 1#)
-
-   esc :: Int# -> Int# -> [Char] -> [Char]
-   esc v 0# ls = (C# (chr# v)):ls
-   esc v n  ls = esc v (n -# 1#) (C# (chr# 0#):ls)
-
-   filter_ps :: Int# -> Int# -> Int# -> [Char] -> ([Char],Int)
-   filter_ps n hits run acc
-    | n <# 0# = 
-        let
-	 escs = run `quotInt#` 255#
-	 v    = run `remInt#`  255#
-        in
-       (esc (v +# 1#) escs acc, I# hits)
-    | otherwise
-       = let
-          ch = indexPS# ps n
-          n' = n -# 1#
-	 in
-         if pred (C# ch) then
-	    let
-	     escs = run `quotInt#` 255#
-	     v    = run `remInt#`  255#
-	     acc' = esc (v +# 1#) escs acc
-	    in
-	    filter_ps n' (hits +# 1#) 0# acc'
-	 else
-	    filter_ps n' hits (run +# 1#) acc
-
-
-foldlPS :: (a -> Char -> a) -> a -> PackedString -> a
-foldlPS f b ps 
- = if nullPS ps then
-      b 
-   else
-      whizzLR b 0#
-   where
-    len = lengthPS# ps
-
-    --whizzLR :: a -> Int# -> a
-    whizzLR b idx
-     | idx ==# len = b
-     | otherwise   = whizzLR (f b (C# (indexPS# ps idx))) (idx +# 1#)
- 
-
-foldrPS :: (Char -> a -> a) -> a -> PackedString -> a
-foldrPS f b ps  
- = if nullPS ps then
-      b
-   else
-      whizzRL b len
-   where
-    len = lengthPS# ps
-
-    --whizzRL :: a -> Int# -> a
-    whizzRL b idx
-     | idx <# 0# = b
-     | otherwise = whizzRL (f (C# (indexPS# ps idx)) b) (idx -# 1#)
-
-takePS :: Int -> PackedString -> PackedString
-takePS (I# n) ps 
-  | n ==# 0#   = nilPS
-  | otherwise  = substrPS# ps 0# (n -# 1#)
-
-dropPS	:: Int -> PackedString -> PackedString
-dropPS (I# n) ps
-  | n ==# len = ps
-  | otherwise = substrPS# ps n  (lengthPS# ps -# 1#)
-  where
-    len = lengthPS# ps
-
-splitAtPS :: Int -> PackedString -> (PackedString, PackedString)
-splitAtPS  n ps  = (takePS n ps, dropPS n ps)
-
-takeWhilePS :: (Char -> Bool) -> PackedString -> PackedString
-takeWhilePS pred ps
-  = let
-	break_pt = char_pos_that_dissatisfies
-			(\ c -> pred (C# c))
-			ps
-			(lengthPS# ps)
-			0#
-    in
-    if break_pt ==# 0# then
-       nilPS
-    else
-       substrPS# ps 0# (break_pt -# 1#)
-
-dropWhilePS :: (Char -> Bool) -> PackedString -> PackedString
-dropWhilePS pred ps
-  = let
-	len	 = lengthPS# ps
-	break_pt = char_pos_that_dissatisfies
-			(\ c -> pred (C# c))
-			ps
-			len
-			0#
-    in
-    if len ==# break_pt then
-       nilPS
-    else
-       substrPS# ps break_pt (len -# 1#)
-
-elemPS :: Char -> PackedString -> Bool
-elemPS (C# ch) ps
-  = let
-	len	 = lengthPS# ps
-	break_pt = first_char_pos_that_satisfies
-			(`eqChar#` ch)
-			ps
-			len
-			0#
-    in
-    break_pt <# len
-
-char_pos_that_dissatisfies :: (Char# -> Bool) -> PackedString -> Int# -> Int# -> Int#
-
-char_pos_that_dissatisfies p ps len pos
-  | pos >=# len		= pos -- end
-  | p (indexPS# ps pos) = -- predicate satisfied; keep going
-			  char_pos_that_dissatisfies p ps len (pos +# 1#)
-  | otherwise		= pos -- predicate not satisfied
-
-char_pos_that_dissatisfies p ps len pos -- dead code: HACK to avoid badly-typed error msg
-  = 0#
-
-first_char_pos_that_satisfies :: (Char# -> Bool) -> PackedString -> Int# -> Int# -> Int#
-first_char_pos_that_satisfies p ps len pos
-  | pos >=# len		= pos -- end
-  | p (indexPS# ps pos) = pos -- got it!
-  | otherwise		= first_char_pos_that_satisfies p ps len (pos +# 1#)
-
--- ToDo: could certainly go quicker
-spanPS :: (Char -> Bool) -> PackedString -> (PackedString, PackedString)
-spanPS  p ps = (takeWhilePS p ps, dropWhilePS p ps)
-
-breakPS :: (Char -> Bool) -> PackedString -> (PackedString, PackedString)
-breakPS p ps = spanPS (not . p) ps
-
-linesPS :: PackedString -> [PackedString]
-linesPS ps = splitPS '\n' ps
-
-wordsPS :: PackedString -> [PackedString]
-wordsPS ps = splitWithPS isSpace ps
-
-reversePS :: PackedString -> PackedString
-reversePS ps =
-  if nullPS ps then -- don't create stuff unnecessarily. 
-     ps
-  else
-    runST (
-      new_ps_array (length +# 1#)    >>= \ arr# -> -- incl NUL byte!
-      fill_in arr# (length -# 1#) 0# >>
-      freeze_ps_array arr#	     >>= \ (ByteArray _ frozen#) ->
-      let has_null = byteArrayHasNUL# frozen# length in
-      return (PS frozen# length has_null))
- where
-  length = lengthPS# ps
-  
-  fill_in :: MutableByteArray s Int -> Int# -> Int# -> ST s ()
-  fill_in arr_in# n i =
-   let
-    ch = indexPS# ps n
-   in
-   write_ps_array arr_in# i ch		         >>
-   if n ==# 0# then
-      write_ps_array arr_in# (i +# 1#) (chr# 0#) >>
-      return ()
-   else
-      fill_in arr_in# (n -# 1#) (i +# 1#)
-     
-concatPS :: [PackedString] -> PackedString
-concatPS [] = nilPS
-concatPS pss
-  = let
-	tot_len# = case (foldr ((+) . lengthPS) 0 pss) of { I# x -> x }
-	tot_len	 = I# tot_len#
-    in
-    runST (
-    new_ps_array (tot_len# +# 1#)   >>= \ arr# -> -- incl NUL byte!
-    packum arr# pss 0#		    >>
-    freeze_ps_array arr#	    >>= \ (ByteArray _ frozen#) ->
-
-    let has_null = byteArrayHasNUL# frozen# tot_len# in
-	  
-    return (PS frozen# tot_len# has_null)
-    )
-  where
-    packum :: MutableByteArray s Int -> [PackedString] -> Int# -> ST s ()
-
-    packum arr [] pos
-      = write_ps_array arr pos (chr# 0#) >>
-	return ()
-    packum arr (ps : pss) pos
-      = fill arr pos ps 0# (lengthPS# ps)  >>= \ (I# next_pos) ->
-	packum arr pss next_pos
-
-    fill :: MutableByteArray s Int -> Int# -> PackedString -> Int# -> Int# -> ST s Int
-
-    fill arr arr_i ps ps_i ps_len
-     | ps_i ==# ps_len
-       = return (I# (arr_i +# ps_len))
-     | otherwise
-       = write_ps_array arr (arr_i +# ps_i) (indexPS# ps ps_i) >>
-	 fill arr arr_i ps (ps_i +# 1#) ps_len
-
-------------------------------------------------------------
-joinPS :: PackedString -> [PackedString] -> PackedString
-joinPS filler pss = concatPS (splice pss)
- where
-  splice []  = []
-  splice [x] = [x]
-  splice (x:y:xs) = x:filler:splice (y:xs)
-
--- ToDo: the obvious generalisation
-{-
-  Some properties that hold:
-
-  * splitPS x ls = ls'   
-      where False = any (map (x `elemPS`) ls')
-            False = any (map (nullPS) ls')
-
-    * all x's have been chopped out.
-    * no empty PackedStrings in returned list. A conseq.
-      of this is:
-           splitPS x nilPS = []
-         
-
-  * joinPS (packString [x]) (_splitPS x ls) = ls
-
--}
-
-splitPS :: Char -> PackedString -> [PackedString]
-splitPS (C# ch) = splitWithPS (\ (C# c) -> c `eqChar#` ch)
-
-splitWithPS :: (Char -> Bool) -> PackedString -> [PackedString]
-splitWithPS pred ps =
- splitify 0#
- where
-  len = lengthPS# ps
-  
-  splitify n 
-   | n >=# len = []
-   | otherwise =
-      let
-       break_pt = 
-         first_char_pos_that_satisfies
-	    (\ c -> pred (C# c))
-	    ps
-	    len
-	    n
-      in
-      if break_pt ==# n then -- immediate match, no substring to cut out.
-         splitify (break_pt +# 1#)
-      else 
-         substrPS# ps n (break_pt -# 1#): -- leave out the matching character
-         splitify (break_pt +# 1#)
-{-
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection{Local utility functions}
-%*									*
-%************************************************************************
-
-The definition of @_substrPS@ is essentially:
-@take (end - begin + 1) (drop begin str)@.
-\begin{code}
--}
-substrPS :: PackedString -> Int -> Int -> PackedString
-substrPS ps (I# begin) (I# end) = substrPS# ps begin end
-
-substrPS# ps s e
-  | s <# 0# || e <# s
-  = error "GHCps.substrPS: bounds out of range"
-
-  | s >=# len || result_len# <=# 0#
-  = nilPS
-
-  | otherwise
-  = runST (
-	new_ps_array (result_len# +# 1#) >>= \ ch_arr -> -- incl NUL byte!
-	fill_in ch_arr 0#	         >>
-	freeze_ps_array ch_arr	         >>= \ (ByteArray _ frozen#) ->
-
-	let has_null = byteArrayHasNUL# frozen# result_len# in
-	  
-	return (PS frozen# result_len# has_null)
-    )
-  where
-    len = lengthPS# ps
-
-    result_len# = (if e <# len then (e +# 1#) else len) -# s
-    result_len  = I# result_len#
-
-    -----------------------
-    fill_in :: MutableByteArray s Int -> Int# -> ST s ()
-
-    fill_in arr_in# idx
-      | idx ==# result_len#
-      = write_ps_array arr_in# idx (chr# 0#) >>
-	return ()
-      | otherwise
-      = let
-	    ch = indexPS# ps (s +# idx)
-	in
-	write_ps_array arr_in# idx ch	     >>
-	fill_in arr_in# (idx +# 1#)
-{-
-\end{code}
-
-(Very :-) ``Specialised'' versions of some CharArray things...
-\begin{code}
--}
-new_ps_array	:: Int# -> ST s (MutableByteArray s Int)
-write_ps_array	:: MutableByteArray s Int -> Int# -> Char# -> ST s () 
-freeze_ps_array :: MutableByteArray s Int -> ST s (ByteArray Int)
-
-new_ps_array size = ST $ \ (S# s) ->
-    case (newCharArray# size s)	  of { StateAndMutableByteArray# s2# barr# ->
-    (MutableByteArray bot barr#, S# s2#)}
-  where
-    bot = error "new_ps_array"
-
-write_ps_array (MutableByteArray _ barr#) n ch = ST $ \ (S# s#) ->
-    case writeCharArray# barr# n ch s#	of { s2#   ->
-    ((), S# s2#)}
-
--- same as unsafeFreezeByteArray
-freeze_ps_array (MutableByteArray ixs arr#) = ST $ \ (S# s#) ->
-    case unsafeFreezeByteArray# arr# s# of { StateAndByteArray# s2# frozen# ->
-    (ByteArray ixs frozen#, S# s2#) }
diff --git a/ghc/lib/prelude/Main.mc_hi b/ghc/lib/prelude/Main.mc_hi
deleted file mode 100644
index 8ed9e1ae99..0000000000
--- a/ghc/lib/prelude/Main.mc_hi
+++ /dev/null
@@ -1,5 +0,0 @@
-interface Main 1
-__exports__
-Main main (..)
-__declarations__
-Main.main :: GHCbase.IO Prelude.();
diff --git a/ghc/lib/prelude/Main.mg_hi b/ghc/lib/prelude/Main.mg_hi
deleted file mode 100644
index 8ed9e1ae99..0000000000
--- a/ghc/lib/prelude/Main.mg_hi
+++ /dev/null
@@ -1,5 +0,0 @@
-interface Main 1
-__exports__
-Main main (..)
-__declarations__
-Main.main :: GHCbase.IO Prelude.();
diff --git a/ghc/lib/prelude/Main.mp_hi b/ghc/lib/prelude/Main.mp_hi
deleted file mode 100644
index 8ed9e1ae99..0000000000
--- a/ghc/lib/prelude/Main.mp_hi
+++ /dev/null
@@ -1,5 +0,0 @@
-interface Main 1
-__exports__
-Main main (..)
-__declarations__
-Main.main :: GHCbase.IO Prelude.();
diff --git a/ghc/lib/prelude/Main.p_hi b/ghc/lib/prelude/Main.p_hi
deleted file mode 100644
index 8ed9e1ae99..0000000000
--- a/ghc/lib/prelude/Main.p_hi
+++ /dev/null
@@ -1,5 +0,0 @@
-interface Main 1
-__exports__
-Main main (..)
-__declarations__
-Main.main :: GHCbase.IO Prelude.();
diff --git a/ghc/lib/prelude/Prelude.hs b/ghc/lib/prelude/Prelude.hs
deleted file mode 100644
index 7bf33a923f..0000000000
--- a/ghc/lib/prelude/Prelude.hs
+++ /dev/null
@@ -1,1710 +0,0 @@
-module Prelude (
-
-#include "../includes/ieee-flpt.h"
-
---partain:    module PreludeList,
-   head, last, tail, init, null, length, (!!),
-   foldl, foldl1, scanl, scanl1, foldr, foldr1, scanr, scanr1,
-   iterate, repeat, replicate, cycle,
-   take, drop, splitAt, takeWhile, dropWhile, span, break,
-   lines, words, unlines, unwords, reverse, and, or,
-   any, all, elem, notElem, lookup,
-   sum, product, maximum, minimum, concatMap, 
-   zip, zip3, zipWith, zipWith3, unzip, unzip3,
-
---partain:module PreludeText,
-        ReadS, ShowS,
-        Read(readsPrec, readList),
-        Show(showsPrec, showList),
-        reads, shows, show, read, lex,
-        showChar, showString, readParen, showParen,
---partain:module PreludeIO,
-      FilePath, IOError, fail, userError, catch,
-      putChar, putStr, putStrLn, print,
-      getChar, getLine, getContents, interact,
-      readFile, writeFile, appendFile, readIO, readLn,
-
-    Bool(False, True),
-    Maybe(Nothing, Just),
-    Either(Left, Right), either,
-    Ordering(LT, EQ, GT),
-    Char, String, Int, Integer, Float, Double, IO, Void,
-    [](..), --  List type
-    ()(..), --  Trivial type
-    --  Tuple types: (,), (,,), etc.
-    (,)(..),
-    (,,)(..),
-    (,,,)(..),
-    (,,,,)(..),
-    (,,,,,)(..),
-    (,,,,,,)(..),
-    (,,,,,,,)(..),
-    (,,,,,,,,)(..),
-    (,,,,,,,,,)(..),
-    (,,,,,,,,,,)(..),
-    (,,,,,,,,,,,)(..),
-    (,,,,,,,,,,,,)(..),
-    (,,,,,,,,,,,,,)(..),
-    (,,,,,,,,,,,,,,)(..),
-    (,,,,,,,,,,,,,,,)(..),
-    (,,,,,,,,,,,,,,,,)(..),
-    (,,,,,,,,,,,,,,,,,)(..),
-    (,,,,,,,,,,,,,,,,,,)(..),
-    (,,,,,,,,,,,,,,,,,,,)(..),
-    (,,,,,,,,,,,,,,,,,,,,)(..),
-    (,,,,,,,,,,,,,,,,,,,,,)(..),
-    (,,,,,,,,,,,,,,,,,,,,,,)(..),
-    (,,,,,,,,,,,,,,,,,,,,,,,)(..),
-    (,,,,,,,,,,,,,,,,,,,,,,,,)(..),
-    (,,,,,,,,,,,,,,,,,,,,,,,,,)(..),
-    (,,,,,,,,,,,,,,,,,,,,,,,,,,)(..),
-    (,,,,,,,,,,,,,,,,,,,,,,,,,,,)(..),
-    (,,,,,,,,,,,,,,,,,,,,,,,,,,,,)(..),
-    (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)(..),
-    (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)(..),
-    (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)(..),
-    (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)(..),
-    (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)(..),
-    (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)(..),
-    (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)(..),
-    (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)(..),
---  Functions: (->)
-    Eq((==), (/=)),
-    Ord(compare, (<), (<=), (>=), (>), max, min),
-    Enum(toEnum, fromEnum, enumFrom, enumFromThen,
-         enumFromTo, enumFromThenTo),
-    Bounded(minBound, maxBound),
-    Eval(..{-seq, strict-}), seq, strict, -- NB: glasgow hack
-    Num((+), (-), (*), negate, abs, signum, fromInteger, fromInt{-partain-}),
-    Real(toRational),
-    Integral(quot, rem, div, mod, quotRem, divMod, toInteger, toInt{-partain-}),
-    Fractional((/), recip, fromRational),
-    Floating(pi, exp, log, sqrt, (**), logBase, sin, cos, tan,
-             asin, acos, atan, sinh, cosh, tanh, asinh, acosh, atanh),
-    RealFrac(properFraction, truncate, round, ceiling, floor),
-    RealFloat(floatRadix, floatDigits, floatRange, decodeFloat,
-              encodeFloat, exponent, significand, scaleFloat, isNaN,
-              isInfinite, isDenormalized, isIEEE, isNegativeZero),
-    Monad((>>=), (>>), return),
-    MonadZero(zero),
-    MonadPlus((++)),
-    Functor(map),
-    succ, pred,
-    mapM, mapM_, guard, accumulate, sequence, filter, concat, applyM,
-    maybe,
-    (&&), (||), not, otherwise,
-    subtract, even, odd, gcd, lcm, (^), (^^), 
-    fromIntegral, fromRealFrac, atan2,
-    fst, snd, curry, uncurry, id, const, (.), flip, ($), until,
-    asTypeOf, error, undefined ) where
-
-import GHCbase	-- all the GHC basics
-import GHCio	-- I/O basics
-import Ratio(Ratio, Rational, (%), numerator, denominator)
-
---PreludeText:
-import Char	( isSpace )
-import IO	( hPutChar, hPutStr, hGetChar, hGetContents )
-
-infixl 9  !!
-infix  4 `elem`, `notElem`
-{- :PreludeList -}
-
-infixr 9  .
-infixr 8  ^, ^^, **
-infixl 7  *, /, `quot`, `rem`, `div`, `mod`
-infixl 6  +, -
-infixr 5  :, ++
-infix  4  ==, /=, <, <=, >=, >
-infixr 3  &&
-infixr 2  ||
-infixr 1  >>, >>=
-infixr 0  $
-
--- Standard types, classes, instances and related functions
-
--- Equality and Ordered classes
-
-class  Eq a  where
-    (==), (/=)		:: a -> a -> Bool
-
-    x /= y		=  not (x == y)
-
-class  (Eq a) => Ord a  where
-    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  = 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 }
-
--- Enumeration and Bounded classes
-
-class  (Ord a) => 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      =  takeWhile (<= m) (enumFrom n)
-    enumFromThenTo n n' m
-                        =  takeWhile (if n' >= n then (<= m) else (>= m))
-                                     (enumFromThen n n')
-
-succ, pred              :: Enum a => a -> a
-succ                    =  toEnum . (+1) . fromEnum
-pred                    =  toEnum . (subtract 1) . fromEnum
-
-class  Bounded a  where
-    minBound, maxBound :: a
-
--- Numeric classes
-
-class  (Eq a, Show a, Eval 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		= fromInteger (int2Integer i)
-			where
-			  int2Integer (I# i#) = int2Integer# i#
-					-- Go via the standard class-op if the
-					-- non-standard one ain't provided
-
-class  (Num a, Ord a) => Real a  where
-    toRational		::  a -> Rational
-
-class  (Real a, Enum a) => Integral a  where
-    quot, rem, div, mod	:: a -> a -> a
-    quotRem, divMod	:: a -> a -> (a,a)
-    toInteger		:: a -> Integer
-    toInt		:: a -> Int -- partain: Glasgow extension
-
-    n `quot` d		=  q  where (q,r) = quotRem n d
-    n `rem` d		=  r  where (q,r) = quotRem n d
-    n `div` d		=  q  where (q,r) = divMod n d
-    n `mod` d		=  r  where (q,r) = divMod n d
-    divMod n d 		=  if signum r == negate (signum d) then (q-1, r+d) else qr
-			   where qr@(q,r) = quotRem n d
-
-class  (Num a) => Fractional a  where
-    (/)			:: a -> a -> a
-    recip		:: a -> a
-    fromRational	:: Rational -> a
-
-    recip x		=  1 / x
-
-class  (Fractional a) => Floating a  where
-    pi			:: a
-    exp, log, sqrt	:: a -> a
-    (**), logBase	:: a -> a -> a
-    sin, cos, tan	:: a -> a
-    asin, acos, atan	:: a -> a
-    sinh, cosh, tanh	:: a -> a
-    asinh, acosh, atanh :: a -> a
-
-    x ** y		=  exp (log x * y)
-    logBase x y		=  log y / log x
-    sqrt x		=  x ** 0.5
-    tan  x		=  sin  x / cos  x
-    tanh x		=  sinh x / cosh x
-
-class  (Real a, Fractional a) => RealFrac a  where
-    properFraction	:: (Integral b) => a -> (b,a)
-    truncate, round	:: (Integral b) => a -> b
-    ceiling, floor	:: (Integral b) => a -> b
-
-    truncate x		=  m  where (m,_) = properFraction x
-    
-    round x		=  let (n,r) = properFraction x
-    			       m     = if r < 0 then n - 1 else n + 1
-    			   in case signum (abs r - 0.5) of
-    				-1 -> n
-    			 	0  -> if even n then n else m
-    				1  -> m
-    
-    ceiling x		=  if r > 0 then n + 1 else n
-    			   where (n,r) = properFraction x
-    
-    floor x		=  if r < 0 then n - 1 else n
-    			   where (n,r) = properFraction x
-
-class  (RealFrac a, Floating a) => RealFloat a  where
-    floatRadix		:: a -> Integer
-    floatDigits		:: a -> Int
-    floatRange		:: a -> (Int,Int)
-    decodeFloat		:: a -> (Integer,Int)
-    encodeFloat		:: Integer -> Int -> a
-    exponent		:: a -> Int
-    significand		:: a -> a
-    scaleFloat		:: Int -> a -> a
-    isNaN, isInfinite, isDenormalized, isNegativeZero, isIEEE
-                        :: a -> Bool
-
-    exponent x		=  if m == 0 then 0 else n + floatDigits x
-			   where (m,n) = decodeFloat x
-
-    significand x	=  encodeFloat m (negate (floatDigits x))
-			   where (m,_) = decodeFloat x
-
-    scaleFloat k x	=  encodeFloat m (n+k)
-			   where (m,n) = decodeFloat x
-
--- Numeric functions
-
-{-# GENERATE_SPECS subtract a{Int#,Double#,Int,Double,Complex(Double#),Complex(Double)} #-}
-subtract	:: (Num a) => a -> a -> a
-subtract x y	=  y - x
-
-even, odd	:: (Integral a) => a -> Bool
-even n		=  n `rem` 2 == 0
-odd		=  not . even
-
-{-# GENERATE_SPECS gcd a{Int#,Int,Integer} #-}
-gcd		:: (Integral a) => a -> a -> a
-gcd 0 0		=  error "Prelude.gcd: gcd 0 0 is undefined"
-gcd x y		=  gcd' (abs x) (abs y)
-		   where gcd' x 0  =  x
-			 gcd' x y  =  gcd' y (x `rem` y)
-
-{-# GENERATE_SPECS lcm a{Int#,Int,Integer} #-}
-lcm		:: (Integral a) => a -> a -> a
-lcm _ 0		=  0
-lcm 0 _		=  0
-lcm x y		=  abs ((x `quot` (gcd x y)) * y)
-
-(^)		:: (Num a, Integral b) => a -> b -> a
-x ^ 0		=  1
-x ^ n | n > 0	=  f x (n-1) x
-		   where f _ 0 y = y
-		         f x n y = g x n  where
-			           g x n | even n  = g (x*x) (n `quot` 2)
-				         | otherwise = f x (n-1) (x*y)
-_ ^ _		= error "Prelude.^: negative exponent"
-
-(^^)		:: (Fractional a, Integral b) => a -> b -> a
-x ^^ n		=  if n >= 0 then x^n else recip (x^(negate n))
-
-fromIntegral	:: (Integral a, Num b) => a -> b
-fromIntegral	=  fromInteger . toInteger
-
-fromRealFrac	:: (RealFrac a, Fractional b) => a -> b
-fromRealFrac	=  fromRational . toRational
-
-atan2		:: (RealFloat a) => a -> a -> a
-atan2 y x	=  case (signum y, signum x) of
-			( 0, 1) ->  0
-			( 1, 0) ->  pi/2
-			( 0,-1) ->  pi
-			(-1, 0) ->  (negate pi)/2
-			( _, 1) ->  atan (y/x)
-			( _,-1) ->  atan (y/x) + pi
-			( 0, 0) ->  error "Prelude.atan2: atan2 of origin"
-
-
--- Monadic classes
-
-class  Functor f  where
-    map         :: (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
-
-    m >> k      =  m >>= \_ -> k
-
-class  (Monad m) => MonadZero m  where
-    zero        :: m a
-
-class  (MonadZero m) => MonadPlus m where
-   (++)         :: m a -> m a -> m a
-
-accumulate      :: Monad m => [m a] -> m [a] 
-accumulate []     = return []
-accumulate (m:ms) = do { x <- m; xs <- accumulate ms; return (x:xs) }
-{- partain: this may be right, but I'm going w/ a more-certainly-right version
-accumulate      =  foldr mcons (return [])
-                   where mcons p q = p >>= \x -> q >>= \y -> return (x:y)
--}
-sequence        :: Monad m => [m a] -> m () 
-sequence        =  foldr (>>) (return ())
-
-mapM            :: Monad m => (a -> m b) -> [a] -> m [b]
-mapM f as       =  accumulate (map f as)
-
-mapM_           :: Monad m => (a -> m b) -> [a] -> m ()
-mapM_ f as      =  sequence (map f as)
-
-guard           :: MonadZero m => Bool -> m ()
-guard p         =  if p then return () else zero
-
--- This subsumes the list-based filter function.
-
-filter          :: MonadZero m => (a -> Bool) -> m a -> m a
-filter p        =  applyM (\x -> if p x then return x else zero)
-
--- This subsumes the list-based concat function.
-
-concat          :: MonadPlus m => [m a] -> m a
-concat          =  foldr (++) zero
- 
-applyM          :: Monad m => (a -> m b) -> m a -> m b
-applyM f x      =  x >>= f
-
-
--- Eval Class
-
-class Eval a {-not Glasgow: where
-   seq         :: a -> b -> b
-   strict      :: (a -> b) -> a -> b
-   strict f x  =  x `seq` f x -}
-
--- seq: in GHCbase
-strict      :: Eval a => (a -> b) -> a -> b
-strict f x  = x `seq` f x
-
----------------------------------------------------------------
--- Trivial type
-
-data  ()  =  ()  --easier to do explicitly: deriving (Eq, Ord, Enum, Bounded)
-		 -- (avoids weird-named functions, e.g., con2tag_()#
-
-instance CReturnable () -- Why, exactly?
-
-instance Eq () where
-    () == () = True
-    () /= () = False
-
-instance Ord () where
-    () <= () = True
-    () <  () = False
-    () >= () = True
-    () >  () = False
-    max () () = ()
-    min () () = ()
-    compare () () = EQ
-
-instance Enum () where
-    toEnum 0    = ()
-    toEnum _	= error "Prelude.Enum.().toEnum: argument not 0"
-    fromEnum () = 0
-    enumFrom () 	= [()]
-    enumFromThen () () 	= [()]
-    enumFromTo () () 	= [()]
-    enumFromThenTo () () () = [()]
-
-instance Bounded () where
-    minBound = ()
-    maxBound = ()
-
-instance  Show ()  where
-    showsPrec p () = showString "()"
-
-instance Read () where
-    readsPrec p    = readParen False
-                            (\r -> [((),t) | ("(",s) <- lex r,
-                                             (")",t) <- lex s ] )
-
----------------------------------------------------------------
--- Function type
-
---data a -> b  -- No constructor for functions is exported.
-
-instance  Show (a -> b)  where
-    showsPrec p f  =  showString "<<function>>"
-    showList	   = showList__ (showsPrec 0)
-
----------------------------------------------------------------
--- Empty type
-
---partain:data Void      -- No constructor for Void is exported.  Import/Export
-               -- lists must use Void instead of Void(..) or Void()
-
----------------------------------------------------------------
--- Boolean type
-
-data  Bool  =  False | True	deriving (Eq, Ord, Enum, Read, Show, Bounded)
-
--- Boolean functions
-
-(&&), (||)		:: Bool -> Bool -> Bool
-True  && x		=  x
-False && _		=  False
-True  || _		=  True
-False || x		=  x
-
-not			:: Bool -> Bool
-not True		=  False
-not False		=  True
-
-otherwise		:: Bool
-otherwise 		=  True
-
----------------------------------------------------------------
--- Character type
-
-data Char = C# Char# deriving (Eq, Ord)
---partain:data Char = ... 'a' | 'b' ... -- 265 ISO values
-instance CCallable Char
-instance CReturnable Char
-
-instance  Enum Char  where
-    toEnum   (I# i) | i >=# 0# && i <=# 255# =  C# (chr# i)
-		    | otherwise = error "Prelude.Enum.Char.toEnum:out of range"
-    fromEnum (C# c)     =  I# (ord# c)
-    enumFrom c		=  map toEnum [fromEnum c .. fromEnum (maxBound::Char)]
-    enumFromThen c c'	=  map toEnum [fromEnum c,
-                                       fromEnum c' .. fromEnum lastChar]
-			   where lastChar :: Char
-                                 lastChar | c' < c    = minBound
-                                          | otherwise = maxBound
-
-instance  Bounded Char  where
-    minBound            =  '\0'
-    maxBound            =  '\255'
-
-instance  Read Char  where
-    readsPrec p      = readParen False
-    	    	    	    (\r -> [(c,t) | ('\'':s,t)<- lex r,
-					    (c,_)     <- readLitChar s])
-
-    readList = readParen False (\r -> [(l,t) | ('"':s, t) <- lex r,
-					       (l,_)      <- readl s ])
-	       where readl ('"':s)	= [("",s)]
-		     readl ('\\':'&':s)	= readl s
-		     readl s		= [(c:cs,u) | (c ,t) <- readLitChar s,
-						      (cs,u) <- readl t	      ]
-instance  Show Char  where
-    showsPrec p '\'' = showString "'\\''"
-    showsPrec p c    = showChar '\'' . showLitChar c . showChar '\''
-
-    showList cs = showChar '"' . showl cs
-		 where showl ""       = showChar '"'
-		       showl ('"':cs) = showString "\\\"" . showl cs
-		       showl (c:cs)   = showLitChar c . showl cs
-
-type  String = [Char]
-
----------------------------------------------------------------
--- Maybe type
-
-data  Maybe a  =  Nothing | Just a	deriving (Eq, Ord, Read, Show)
-
-maybe                   :: b -> (a -> b) -> Maybe a -> b
-maybe n f Nothing       =  n
-maybe n f (Just x)      =  f x
-
-instance  Functor Maybe  where
-    map f Nothing       = Nothing
-    map f (Just a)      = Just (f a)
-
-instance  Monad Maybe  where
-    (Just x) >>= k      = k x
-    Nothing  >>= k      = Nothing
-    return              = Just
-
-instance  MonadZero Maybe  where
-    zero                = Nothing
-
-instance  MonadPlus Maybe  where
-    Nothing ++ ys       = ys
-    xs      ++ ys       = xs
-
----------------------------------------------------------------
--- Either type
-
-data  Either a b  =  Left a | Right b	deriving (Eq, Ord, Read, Show)
-
-either                  :: (a -> c) -> (b -> c) -> Either a b -> c
-either f g (Left x)     =  f x
-either f g (Right y)    =  g y
-
----------------------------------------------------------------
--- IO type: moved to GHCbase
-
---partain: data IO a =  -- abstract
-
----------------------------------------------------------------
--- Ordering type
-
-data Ordering = LT | EQ | GT  deriving (Eq, Ord, Enum, Read, Show, Bounded)
-
----------------------------------------------------------------
--- Standard numeric types.  The data declarations for these types
--- cannot be expressed directly in (standard) Haskell since the
--- constructor lists would be far too large.
-
----------------------------------------------------------------
-data Int = I# Int# deriving (Eq,Ord)
---partain:data Int  =  minBound ... -1 | 0 | 1 ... maxBound
-
-instance CCallable   Int
-instance CReturnable Int
-
-instance  Bounded Int where
-    minBound =  negate 2147483647   -- **********************
-    maxBound =  2147483647	    -- **********************
-
-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  Real Int  where
-    toRational x	=  toInteger x % 1
-
-instance  Integral Int	where
-    a@(I# _) `quotRem` b@(I# _)	= (a `quotInt` b, a `remInt` b)
-    -- OK, so I made it a little stricter.  Shoot me.  (WDP 94/10)
-
-    -- following chks for zero divisor are non-standard (WDP)
-    a `quot` b		=  if b /= 0
-			   then a `quotInt` b
-			   else error "Integral.Int.quot{PreludeCore}: divide by 0\n"
-    a `rem` b		=  if b /= 0
-			   then a `remInt` b
-			   else error "Integral.Int.rem{PreludeCore}: divide by 0\n"
-
-    x `div` y = if x > 0 && y < 0	then quotInt (x-y-1) y
-		else if x < 0 && y > 0	then quotInt (x-y+1) y
-		else quotInt x y
-    x `mod` y = if x > 0 && y < 0 || x < 0 && y > 0 then
-		    if r/=0 then r+y else 0
-	    	else
-		    r
-	      where r = remInt x y
-
-    divMod x@(I# _) y@(I# _) = (x `div` y, x `mod` y)
-    -- Stricter.  Sorry if you don't like it.  (WDP 94/10)
-
---OLD:   even x = eqInt (x `mod` 2) 0
---OLD:   odd x  = neInt (x `mod` 2) 0
-
-    toInteger (I# n#) = int2Integer# n#  -- give back a full-blown Integer
-    toInt x	      = x
-
-instance  Enum Int  where
-    toEnum   x = x
-    fromEnum x = x
-#ifndef USE_FOLDR_BUILD
-    enumFrom x           =  x : enumFrom (x `plusInt` 1)
-    enumFromTo n m       =  takeWhile (<= m) (enumFrom n)
-#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
-    enumFromThen m n     =  en' m (n `minusInt` m)
-	                    where en' m n = m : en' (m `plusInt` n) n
-    enumFromThenTo n m p =  takeWhile (if m >= n then (<= p) else (>= p))
-				      (enumFromThen n m)
-
-instance  Read Int  where
-    readsPrec p x = readSigned readDec x
-    readList = readList__ (readsPrec 0)
-
-instance  Show Int  where
-    showsPrec x   = showSigned showInt x
-    showList = showList__ (showsPrec 0) 
-
----------------------------------------------------------------
-data Integer = J# Int# Int# ByteArray#
---partain:data Integer = ... -1 | 0 | 1 ...
-
-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#
-
-instance  Ord 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#
-
-    (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#
-
-    x@(J# a1 s1 d1) `max` y@(J# a2 s2 d2)
-      = if ((cmpInteger# a1 s1 d1 a2 s2 d2) ># 0#) then x else y
-
-    x@(J# a1 s1 d1) `min` y@(J# a2 s2 d2)
-      = if ((cmpInteger# a1 s1 d1 a2 s2 d2) <# 0#) then x else y
-
-    compare (J# a1 s1 d1) (J# a2 s2 d2)
-       = case cmpInteger# a1 s1 d1 a2 s2 d2 of { res# ->
-	 if res# <# 0# then LT else 
-	 if res# ># 0# then GT else EQ
-	 }
-
-instance  Num Integer  where
-    (+) (J# a1 s1 d1) (J# a2 s2 d2)
-      = plusInteger# a1 s1 d1 a2 s2 d2
-
-    (-) (J# a1 s1 d1) (J# a2 s2 d2)
-      = minusInteger# a1 s1 d1 a2 s2 d2
-
-    negate (J# a s d) = negateInteger# a s d
-
-    (*) (J# a1 s1 d1) (J# a2 s2 d2)
-      = timesInteger# a1 s1 d1 a2 s2 d2
-
-    -- ORIG: abs n = if n >= 0 then n else -n
-
-    abs n@(J# a1 s1 d1)
-      = case 0 of { J# a2 s2 d2 ->
-	if (cmpInteger# a1 s1 d1 a2 s2 d2) >=# 0#
-	then n
-	else negateInteger# a1 s1 d1
-	}
-
-    signum n@(J# a1 s1 d1)
-      = case 0 of { J# a2 s2 d2 ->
-	let
-	    cmp = cmpInteger# a1 s1 d1 a2 s2 d2
-	in
-	if      cmp >#  0# then 1
-	else if cmp ==# 0# then 0
-	else			(negate 1)
-	}
-
-    fromInteger	x	=  x
-
-    fromInt (I# n#)	=  int2Integer# n# -- gives back a full-blown Integer
-
-instance  Real Integer  where
-    toRational x	=  x % 1
-
-instance  Integral Integer where
-    quotRem (J# a1 s1 d1) (J# a2 s2 d2)
-      = case (quotRemInteger# a1 s1 d1 a2 s2 d2) of
-	  Return2GMPs a3 s3 d3 a4 s4 d4
-	    -> (J# a3 s3 d3, J# a4 s4 d4)
-
-{- USING THE UNDERLYING "GMP" CODE IS DUBIOUS FOR NOW:
-
-    divMod (J# a1 s1 d1) (J# a2 s2 d2)
-      = case (divModInteger# a1 s1 d1 a2 s2 d2) of
-	  Return2GMPs a3 s3 d3 a4 s4 d4
-	    -> (J# a3 s3 d3, J# a4 s4 d4)
--}
-    toInteger n	     = n
-    toInt (J# a s d) = case (integer2Int# a s d) of { n# -> I# n# }
-
-    -- the rest are identical to the report default methods;
-    -- you get slightly better code if you let the compiler
-    -- see them right here:
-    n `quot` d	=  q  where (q,r) = quotRem n d
-    n `rem` d	=  r  where (q,r) = quotRem n d
-    n `div` d	=  q  where (q,r) = divMod n d
-    n `mod` d	=  r  where (q,r) = divMod n d
-
-    divMod n d 	=  case (quotRem n d) of { qr@(q,r) ->
-		   if signum r == negate (signum d) then (q - 1, r+d) else qr }
-		   -- Case-ified by WDP 94/10
-
-instance  Enum Integer  where
-    enumFrom n           =  n : enumFrom (n + 1)
-    enumFromThen m n     =  en' m (n - m)
-	                    where en' m n = m : en' (m + n) n
-    enumFromTo n m       =  takeWhile (<= m) (enumFrom n)
-    enumFromThenTo n m p =  takeWhile (if m >= n then (<= p) else (>= p))
-				      (enumFromThen n m)
-
-instance  Read Integer  where
-    readsPrec p x = readSigned readDec x
-    readList = readList__ (readsPrec 0)
-
-instance  Show Integer  where
-    showsPrec   x = showSigned showInt x
-    showList = showList__ (showsPrec 0) 
-
----------------------------------------------------------------
-data Float  = F# Float# deriving (Eq, Ord)
-instance CCallable   Float
-instance CReturnable Float
-
----------------------------------------------------------------
-
-instance  Num Float  where
-    (+)		x y 	=  plusFloat x y
-    (-)		x y 	=  minusFloat x y
-    negate	x  	=  negateFloat x
-    (*)		x y 	=  timesFloat x y
-    abs x | x >= 0.0	=  x
-	  | otherwise	=  negateFloat x
-    signum x | x == 0.0	 = 0
-	     | x > 0.0	 = 1
-	     | otherwise = negate 1
-    fromInteger n	=  encodeFloat n 0
-    fromInt i		=  int2Float i
-
-instance  Real Float  where
-    toRational x	=  (m%1)*(b%1)^^n
-			   where (m,n) = decodeFloat x
-				 b     = floatRadix  x
-
-instance  Fractional Float  where
-    (/) x y		=  divideFloat x y
-    fromRational x	=  fromRational__ x
-    recip x		=  1.0 / x
-
-instance  Floating Float  where
-    pi			=  3.141592653589793238
-    exp x		=  expFloat x
-    log	x	 	=  logFloat x
-    sqrt x		=  sqrtFloat x
-    sin	x		=  sinFloat x
-    cos	x		=  cosFloat x
-    tan	x		=  tanFloat x
-    asin x		=  asinFloat x
-    acos x		=  acosFloat x
-    atan x		=  atanFloat x
-    sinh x		=  sinhFloat x
-    cosh x	 	=  coshFloat x
-    tanh x		=  tanhFloat x
-    (**) x y		=  powerFloat x y
-    logBase x y		=  log y / log x
-
-    asinh x = log (x + sqrt (1.0+x*x))
-    acosh x = log (x + (x+1.0) * sqrt ((x-1.0)/(x+1.0)))
-    atanh x = log ((x+1.0) / sqrt (1.0-x*x))
-
-instance  RealFrac Float  where
-
-    {-# SPECIALIZE properFraction :: Float -> (Int, Float) #-}
-    {-# SPECIALIZE truncate :: Float -> Int #-}
-    {-# SPECIALIZE round    :: Float -> Int #-}
-    {-# SPECIALIZE ceiling  :: Float -> Int #-}
-    {-# SPECIALIZE floor    :: Float -> Int #-}
-
-    {-# SPECIALIZE properFraction :: Float -> (Integer, Float) #-}
-    {-# SPECIALIZE truncate :: Float -> Integer #-}
-    {-# SPECIALIZE round    :: Float -> Integer #-}
-    {-# SPECIALIZE ceiling  :: Float -> Integer #-}
-    {-# SPECIALIZE floor    :: Float -> Integer #-}
-
-    properFraction x
-      = case (decodeFloat x)      of { (m,n) ->
-    	let  b = floatRadix x     in
-    	if n >= 0 then
-	    (fromInteger m * fromInteger b ^ n, 0.0)
-    	else
-	    case (quotRem m (b^(negate n))) of { (w,r) ->
-	    (fromInteger w, encodeFloat r n)
-	    }
-        }
-
-    truncate x	= case properFraction x of
-		     (n,_) -> n
-
-    round x	= case properFraction x of
-		     (n,r) -> let
-			      	m         = if r < 0.0 then n - 1 else n + 1
-		  	      	half_down = abs r - 0.5
-    		   	      in
-    		   	      case (compare half_down 0.0) of
-      		     		LT -> n
-      		     		EQ -> if even n then n else m
-      		     		GT -> m
-
-    ceiling x   = case properFraction x of
-		    (n,r) -> if r > 0.0 then n + 1 else n
-
-    floor x	= case properFraction x of
-		    (n,r) -> if r < 0.0 then n - 1 else n
-
-instance  RealFloat Float  where
-    floatRadix _	=  FLT_RADIX	    -- from float.h
-    floatDigits _	=  FLT_MANT_DIG	    -- ditto
-    floatRange _	=  (FLT_MIN_EXP, FLT_MAX_EXP) -- ditto
-
-    decodeFloat (F# f#)
-      = case decodeFloat# f#	of
-	  ReturnIntAndGMP exp# a# s# d# ->
-	    (J# a# s# d#, I# exp#)
-
-    encodeFloat (J# a# s# d#) (I# e#)
-      = case encodeFloat# a# s# d# e# of { flt# -> F# flt# }
-
-    exponent x		= case decodeFloat x of
-			    (m,n) -> if m == 0 then 0 else n + floatDigits x
-
-    significand x	= case decodeFloat x of
-			    (m,_) -> encodeFloat m (negate (floatDigits x))
-
-    scaleFloat k x	= case decodeFloat x of
-			    (m,n) -> encodeFloat m (n+k)
-
-instance  Read Float  where
-    readsPrec p x = readSigned readFloat x
-    readList = readList__ (readsPrec 0)
-
-instance  Show Float  where
-    showsPrec   x = showSigned showFloat x
-    showList = showList__ (showsPrec 0) 
-
----------------------------------------------------------------
-data Double = D# Double# deriving (Eq, Ord)
-instance CCallable   Double
-instance CReturnable Double
-
----------------------------------------------------------------
-
-instance  Num Double  where
-    (+)		x y 	=  plusDouble x y
-    (-)		x y 	=  minusDouble x y
-    negate	x  	=  negateDouble x
-    (*)		x y 	=  timesDouble x y
-    abs x | x >= 0.0	=  x
-	  | otherwise	=  negateDouble x
-    signum x | x == 0.0	 = 0
-	     | x > 0.0	 = 1
-	     | otherwise = negate 1
-    fromInteger n	=  encodeFloat n 0
-    fromInt (I# n#)	=  case (int2Double# n#) of { d# -> D# d# }
-
-instance  Real Double  where
-    toRational x	=  (m%1)*(b%1)^^n
-			   where (m,n) = decodeFloat x
-				 b     = floatRadix  x
-
-instance  Fractional Double  where
-    (/) x y		=  divideDouble x y
-    fromRational x	=  fromRational__ x
-    recip x		=  1.0 / x
-
-instance  Floating Double  where
-    pi			=  3.141592653589793238
-    exp	x		=  expDouble x
-    log	x		=  logDouble x
-    sqrt x		=  sqrtDouble x
-    sin	 x		=  sinDouble x
-    cos	 x		=  cosDouble x
-    tan	 x		=  tanDouble x
-    asin x		=  asinDouble x
-    acos x	 	=  acosDouble x
-    atan x		=  atanDouble x
-    sinh x		=  sinhDouble x
-    cosh x		=  coshDouble x
-    tanh x		=  tanhDouble x
-    (**) x y		=  powerDouble x y
-    logBase x y		=  log y / log x
-
-    asinh x = log (x + sqrt (1.0+x*x))
-    acosh x = log (x + (x+1.0) * sqrt ((x-1.0)/(x+1.0)))
-    atanh x = log ((x+1.0) / sqrt (1.0-x*x))
-
-instance  RealFrac Double  where
-
-    {-# SPECIALIZE properFraction :: Double -> (Int, Double) #-}
-    {-# SPECIALIZE truncate :: Double -> Int #-}
-    {-# SPECIALIZE round    :: Double -> Int #-}
-    {-# SPECIALIZE ceiling  :: Double -> Int #-}
-    {-# SPECIALIZE floor    :: Double -> Int #-}
-
-    {-# SPECIALIZE properFraction :: Double -> (Integer, Double) #-}
-    {-# SPECIALIZE truncate :: Double -> Integer #-}
-    {-# SPECIALIZE round    :: Double -> Integer #-}
-    {-# SPECIALIZE ceiling  :: Double -> Integer #-}
-    {-# SPECIALIZE floor    :: Double -> Integer #-}
-
-#if defined(__UNBOXED_INSTANCES__)
-    {-# SPECIALIZE properFraction :: Double -> (Int#, Double) #-}
-    {-# SPECIALIZE truncate :: Double -> Int# #-}
-    {-# SPECIALIZE round    :: Double -> Int# #-}
-    {-# SPECIALIZE ceiling  :: Double -> Int# #-}
-    {-# SPECIALIZE floor    :: Double -> Int# #-}
-#endif
-
-    properFraction x
-      = case (decodeFloat x)      of { (m,n) ->
-    	let  b = floatRadix x     in
-    	if n >= 0 then
-	    (fromInteger m * fromInteger b ^ n, 0.0)
-    	else
-	    case (quotRem m (b^(negate n))) of { (w,r) ->
-	    (fromInteger w, encodeFloat r n)
-	    }
-        }
-
-    truncate x	= case properFraction x of
-		     (n,_) -> n
-
-    round x	= case properFraction x of
-		     (n,r) -> let
-			      	m         = if r < 0.0 then n - 1 else n + 1
-		  	      	half_down = abs r - 0.5
-    		   	      in
-    		   	      case (compare half_down 0.0) of
-      		     		LT -> n
-      		     		EQ -> if even n then n else m
-      		     		GT -> m
-
-    ceiling x   = case properFraction x of
-		    (n,r) -> if r > 0.0 then n + 1 else n
-
-    floor x	= case properFraction x of
-		    (n,r) -> if r < 0.0 then n - 1 else n
-
-instance  RealFloat Double  where
-    floatRadix _	=  FLT_RADIX	    -- from float.h
-    floatDigits _	=  DBL_MANT_DIG	    -- ditto
-    floatRange _	=  (DBL_MIN_EXP, DBL_MAX_EXP) -- ditto
-
-    decodeFloat (D# d#)
-      = case decodeDouble# d#	of
-	  ReturnIntAndGMP exp# a# s# d# ->
-	    (J# a# s# d#, I# exp#)
-
-    encodeFloat (J# a# s# d#) (I# e#)
-      = case encodeDouble# a# s# d# e#	of { dbl# -> D# dbl# }
-
-    exponent x		= case decodeFloat x of
-			    (m,n) -> if m == 0 then 0 else n + floatDigits x
-
-    significand x	= case decodeFloat x of
-			    (m,_) -> encodeFloat m (negate (floatDigits x))
-
-    scaleFloat k x	= case decodeFloat x of
-			    (m,n) -> encodeFloat m (n+k)
-
-instance  Read Double  where
-    readsPrec p x = readSigned readFloat x
-    readList = readList__ (readsPrec 0)
-
-instance  Show Double  where
-    showsPrec   x = showSigned showFloat x
-    showList = showList__ (showsPrec 0) 
-
----------------------------------------------------------------
--- The Enum instances for Floats and Doubles are slightly unusual.
--- The `toEnum' function truncates numbers to Int.  The definitions
--- of enumFrom and enumFromThen allow floats to be used in arithmetic
--- series: [0,0.1 .. 1.0].  However, roundoff errors make these somewhat
--- dubious.  This example may have either 10 or 11 elements, depending on
--- how 0.1 is represented.
-
-instance  Enum Float  where
-    toEnum              =  fromIntegral
-    fromEnum            =  fromInteger . truncate   -- may overflow
-    enumFrom		=  numericEnumFrom
-    enumFromThen	=  numericEnumFromThen
-
-instance  Enum Double  where
-    toEnum              =  fromIntegral
-    fromEnum            =  fromInteger . truncate   -- may overflow
-    enumFrom		=  numericEnumFrom
-    enumFromThen	=  numericEnumFromThen
-
-numericEnumFrom		:: (Real a) => a -> [a]
-numericEnumFromThen	:: (Real a) => a -> a -> [a]
-numericEnumFrom		=  iterate (+1)
-numericEnumFromThen n m	=  iterate (+(m-n)) n
-
----------------------------------------------------------------
--- Lists
-
-data [] a = [] | a : [a]  -- do explicitly: deriving (Eq, Ord)
-			  -- to avoid weird names like con2tag_[]#
-
-instance CCallable   [Char]
-instance CReturnable [Char]
-
-instance (Eq a) => Eq [a]  where
-    []     == []     = True	
-    (x:xs) == (y:ys) = x == y && xs == ys
-    []     == ys     = False			
-    xs     == []     = False			
-    xs     /= ys     = if (xs == ys) then False else True
-
-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  }
-
-    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 (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
-
-instance  Monad []  where
-    m >>= k             = concat (map k m)
-    return x            = [x]
-
-instance  MonadZero []  where
-    zero                = []
-
-instance  MonadPlus []  where
-    xs ++ ys            =  foldr (:) ys xs
-    
-instance  (Show a) => Show [a]  where
-    showsPrec p         = showList
-    showList		= showList__ (showsPrec 0)
-
-instance  (Read a) => Read [a]  where
-    readsPrec p         = readList
-    readList		= readList__ (readsPrec 0)
-
----------------------------------------------------------------
--- Tuples
-
-data (,) a b = (,) a b   deriving (Eq, Ord, Bounded)
-data (,,) a b c = (,,) a b c deriving (Eq, Ord, Bounded)
-data (,,,) a b c d = (,,,) a b c d deriving (Eq, Ord, Bounded)
-data (,,,,) a b c d e = (,,,,) a b c d e deriving (Eq, Ord, Bounded)
-data (,,,,,) a b c d e f = (,,,,,) a b c d e f
-data (,,,,,,) a b c d e f g = (,,,,,,) a b c d e f g
-data (,,,,,,,) a b c d e f g h = (,,,,,,,) a b c d e f g h
-data (,,,,,,,,) a b c d e f g h i = (,,,,,,,,) a b c d e f g h i
-data (,,,,,,,,,) a b c d e f g h i j = (,,,,,,,,,) a b c d e f g h i j
-data (,,,,,,,,,,) a b c d e f g h i j k = (,,,,,,,,,,) a b c d e f g h i j k
-data (,,,,,,,,,,,) a b c d e f g h i j k l = (,,,,,,,,,,,) a b c d e f g h i j k l
-data (,,,,,,,,,,,,) a b c d e f g h i j k l m = (,,,,,,,,,,,,) a b c d e f g h i j k l m
-data (,,,,,,,,,,,,,) a b c d e f g h i j k l m n = (,,,,,,,,,,,,,) a b c d e f g h i j k l m n
-data (,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o = (,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o
-data (,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p = (,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p
-data (,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q
- = (,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q
-data (,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r
- = (,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r
-data (,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s
- = (,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s
-data (,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t
- = (,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t
-data (,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u
- = (,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u
-data (,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v
- = (,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v
-data (,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w
- = (,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w
-data (,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x
- = (,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x
-data (,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y
- = (,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y
-data (,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z
- = (,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z
-data (,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_
- = (,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_
-data (,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_
- = (,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_
-data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_
- = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_
-data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_
- = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_
-data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_
- = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_
-data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_
- = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_
-data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_
- = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_
-data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_
- = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_
-data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_
- = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_
-data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_
- = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_
-data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_
- = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_
- -- if you add more tuples, you need to change the compiler, too
- -- (it has a wired-in number: 37)
-
-instance  (Read a, Read b) => Read (a,b)  where
-    readsPrec p = readParen False
-                            (\r -> [((x,y), w) | ("(",s) <- lex r,
-                                                 (x,t)   <- reads s,
-                                                 (",",u) <- lex t,
-                                                 (y,v)   <- reads u,
-                                                 (")",w) <- lex v ] )
-    readList	= readList__ (readsPrec 0)
-
-instance (Read a, Read b, Read c) => Read (a, b, c) where
-    readsPrec p = readParen False
-			(\a -> [((x,y,z), h) | ("(",b) <- lex a,
-					       (x,c)   <- readsPrec 0 b,
-					       (",",d) <- lex c,
-					       (y,e)   <- readsPrec 0 d,
-					       (",",f) <- lex e,
-					       (z,g)   <- readsPrec 0 f,
-					       (")",h) <- lex g ] )
-    readList	= readList__ (readsPrec 0)
-
-instance (Read a, Read b, Read c, Read d) => Read (a, b, c, d) where
-    readsPrec p = readParen False
-		    (\a -> [((w,x,y,z), j) | ("(",b) <- lex a,
-					     (w,c)   <- readsPrec 0 b,
-					     (",",d) <- lex c,
-					     (x,e)   <- readsPrec 0 d,
-					     (",",f) <- lex e,
-					     (y,g)   <- readsPrec 0 f,
-					     (",",h) <- lex g,
-					     (z,i)   <- readsPrec 0 h,
-					     (")",j) <- lex i ] )
-    readList	= readList__ (readsPrec 0)
-
-instance (Read a, Read b, Read c, Read d, Read e) => Read (a, b, c, d, e) where
-    readsPrec p = readParen False
-		    (\a -> [((w,x,y,z,v), l) | ("(",b) <- lex a,
-					       (w,c)   <- readsPrec 0 b,
-					       (",",d) <- lex c,
-					       (x,e)   <- readsPrec 0 d,
-					       (",",f) <- lex e,
-					       (y,g)   <- readsPrec 0 f,
-					       (",",h) <- lex g,
-					       (z,i)   <- readsPrec 0 h,
-					       (",",j) <- lex i,
-					       (v,k)   <- readsPrec 0 j,
-					       (")",l) <- lex k ] )
-    readList	= readList__ (readsPrec 0)
-
-instance  (Show a, Show b) => Show (a,b)  where
-    showsPrec p (x,y) = showChar '(' . shows x . showString ", " .
-                                       shows y . showChar ')'
-    showList	= showList__ (showsPrec 0) 
-
-instance (Show a, Show b, Show c) => Show (a, b, c) where
-    showsPrec p (x,y,z) = showChar '(' . showsPrec 0 x . showString ", " .
-					 showsPrec 0 y . showString ", " .
-					 showsPrec 0 z . showChar ')'
-    showList	= showList__ (showsPrec 0) 
-
-instance (Show a, Show b, Show c, Show d) => Show (a, b, c, d) where
-    showsPrec p (w,x,y,z) = showChar '(' . showsPrec 0 w . showString ", " .
-					   showsPrec 0 x . showString ", " .
-					   showsPrec 0 y . showString ", " .
-					   showsPrec 0 z . showChar ')'
-
-    showList	= showList__ (showsPrec 0) 
-
-instance (Show a, Show b, Show c, Show d, Show e) => Show (a, b, c, d, e) where
-    showsPrec p (v,w,x,y,z) = showChar '(' . showsPrec 0 v . showString ", " .
-					     showsPrec 0 w . showString ", " .
-					     showsPrec 0 x . showString ", " .
-					     showsPrec 0 y . showString ", " .
-					     showsPrec 0 z . showChar ')'
-    showList	= showList__ (showsPrec 0) 
-
----------------------------------------------------------------------
--- component projections for pairs:
--- (NB: not provided for triples, quadruples, etc.)
-fst			:: (a,b) -> a
-fst (x,y)		=  x
-
-snd			:: (a,b) -> b
-snd (x,y)		=  y
-
--- curry converts an uncurried function to a curried function;
--- uncurry converts a curried function to a function on pairs.
-curry                   :: ((a, b) -> c) -> a -> b -> c
-curry f x y             =  f (x, y)
-
-uncurry                 :: (a -> b -> c) -> ((a, b) -> c)
-uncurry f p             =  f (fst p) (snd p)
-
--- Functions
-
--- Standard value bindings
-
--- identity function
-id			:: a -> a
-id x			=  x
-
--- constant function
-const			:: a -> b -> a
-const x _		=  x
-
--- function composition
-{-# INLINE (.) #-}
-{-# GENERATE_SPECS (.) a b c #-}
-(.)			:: (b -> c) -> (a -> b) -> a -> c
-f . g			=  \ x -> f (g x)
-
--- flip f  takes its (first) two arguments in the reverse order of f.
-flip			:: (a -> b -> c) -> b -> a -> c
-flip f x y		=  f y x
-
--- right-associating infix application operator (useful in continuation-
--- passing style)
-($)			:: (a -> b) -> a -> b
-f $ x			=  f x
-
--- until p f  yields the result of applying f until p holds.
-until			:: (a -> Bool) -> (a -> a) -> a -> a
-until p f x | p x	=  x
-	    | otherwise =  until p f (f x)
-
--- asTypeOf is a type-restricted version of const.  It is usually used
--- as an infix operator, and its typing forces its first argument
--- (which is usually overloaded) to have the same type as the second.
-asTypeOf		:: a -> a -> a
-asTypeOf		=  const
-
--- error stops execution and displays an error message
-
-error :: String -> a
-error s = error__ ( \ x -> _ccall_ ErrorHdrHook x ) s
-
--- It is expected that compilers will recognize this and insert error
--- messages which are more appropriate to the context in which undefined 
--- appears. 
-
-undefined               :: a
-undefined               =  error "Prelude.undefined"
-
--- ============================================================
--- Standard list functions
--- ============================================================
-
-{- module PreludeList -}
-
--- head and tail extract the first element and remaining elements,
--- respectively, of a list, which must be non-empty.  last and init
--- are the dual functions working from the end of a finite list,
--- rather than the beginning.
-
-head                    :: [a] -> a
-head (x:_)              =  x
-head []                 =  error "PreludeList.head: empty list"
-
-last                    :: [a] -> a
-last [x]                =  x
-last (_:xs)             =  last xs
-last []                 =  error "PreludeList.last: empty list"
-
-tail                    :: [a] -> [a]
-tail (_:xs)             =  xs
-tail []                 =  error "PreludeList.tail: empty list"
-
-init                    :: [a] -> [a]
-init [x]                =  []
-init (x:xs)             =  x : init xs
-init []                 =  error "PreludeList.init: empty list"
-
-null                    :: [a] -> Bool
-null []                 =  True
-null (_:_)              =  False
-
--- length returns the length of a finite list as an Int; it is an instance
--- of the more general genericLength, the result type of which may be
--- any kind of number.
-length                  :: [a] -> Int
-length []               =  0
-length (_:l)            =  1 + length l
-
--- List index (subscript) operator, 0-origin
-(!!)                    :: [a] -> Int -> a
-(x:_)  !! 0             =  x
-(_:xs) !! n | n > 0     =  xs !! (n-1)
-(_:_)  !! _             =  error "PreludeList.!!: negative index"
-[]     !! _             =  error "PreludeList.!!: index too large"
-
--- foldl, applied to a binary operator, a starting value (typically the
--- left-identity of the operator), and a list, reduces the list using
--- the binary operator, from left to right:
---  foldl f z [x1, x2, ..., xn] == (...((z `f` x1) `f` x2) `f`...) `f` xn
--- foldl1 is a variant that has no starting value argument, and  thus must
--- be applied to non-empty lists.  scanl is similar to foldl, but returns
--- a list of successive reduced values from the left:
---      scanl f z [x1, x2, ...] == [z, z `f` x1, (z `f` x1) `f` x2, ...]
--- Note that  last (scanl f z xs) == foldl f z xs.
--- scanl1 is similar, again without the starting element:
---      scanl1 f [x1, x2, ...] == [x1, x1 `f` x2, ...]
-
-foldl                   :: (a -> b -> a) -> a -> [b] -> a
-foldl f z []            =  z
-foldl f z (x:xs)        =  foldl f (f z x) xs
-
-foldl1                  :: (a -> a -> a) -> [a] -> a
-foldl1 f (x:xs)         =  foldl f x xs
-foldl1 _ []             =  error "PreludeList.foldl1: empty list"
-
-scanl                   :: (a -> b -> a) -> a -> [b] -> [a]
-scanl f q xs            =  q : (case xs of
-                                []   -> []
-                                x:xs -> scanl f (f q x) xs)
-
-scanl1                  :: (a -> a -> a) -> [a] -> [a]
-scanl1 f (x:xs)         =  scanl f x xs
-scanl1 _ []             =  error "PreludeList.scanl1: empty list"
-
--- foldr, foldr1, scanr, and scanr1 are the right-to-left duals of the
--- above functions.
-
-foldr                   :: (a -> b -> b) -> b -> [a] -> b
-foldr f z []            =  z
-foldr f z (x:xs)        =  f x (foldr f z xs)
-
-foldr1                  :: (a -> a -> a) -> [a] -> a
-foldr1 f [x]            =  x
-foldr1 f (x:xs)         =  f x (foldr1 f xs)
-foldr1 _ []             =  error "PreludeList.foldr1: empty list"
-
-scanr                   :: (a -> b -> b) -> b -> [a] -> [b]
-scanr f q0 []           =  [q0]
-scanr f q0 (x:xs)       =  f x q : qs
-                           where qs@(q:_) = scanr f q0 xs 
-
-scanr1                  :: (a -> a -> a) -> [a] -> [a]
-scanr1 f  [x]           =  [x]
-scanr1 f  (x:xs)        =  f x q : qs
-                           where qs@(q:_) = scanr1 f xs 
-scanr1 _ []             =  error "PreludeList.scanr1: empty list"
-
--- iterate f x returns an infinite list of repeated applications of f to x:
--- iterate f x == [x, f x, f (f x), ...]
-iterate                 :: (a -> a) -> a -> [a]
-iterate f x             =  x : iterate f (f x)
-
--- repeat x is an infinite list, with x the value of every element.
-repeat                  :: a -> [a]
-repeat x                =  xs where xs = x:xs
-
--- replicate n x is a list of length n with x the value of every element
-replicate               :: Int -> a -> [a]
-replicate n x           =  take n (repeat x)
-
--- cycle ties a finite list into a circular one, or equivalently,
--- the infinite repetition of the original list.  It is the identity
--- on infinite lists.
-
-cycle                   :: [a] -> [a]
-cycle xs                =  xs' where xs' = xs ++ xs'
-
--- take n, applied to a list xs, returns the prefix of xs of length n,
--- or xs itself if n > length xs.  drop n xs returns the suffix of xs
--- after the first n elements, or [] if n > length xs.  splitAt n xs
--- is equivalent to (take n xs, drop n xs).
-
-take                   :: Int -> [a] -> [a]
-take 0 _               =  []
-take _ []              =  []
-take n (x:xs) | n > 0  =  x : take (n-1) xs
-take _     _           =  error "PreludeList.take: negative argument"
-
-drop                   :: Int -> [a] -> [a]
-drop 0 xs              =  xs
-drop _ []              =  []
-drop n (_:xs) | n > 0  =  drop (n-1) xs
-drop _     _           =  error "PreludeList.drop: negative argument"
-
-splitAt                   :: Int -> [a] -> ([a],[a])
-splitAt 0 xs              =  ([],xs)
-splitAt _ []              =  ([],[])
-splitAt n (x:xs) | n > 0  =  (x:xs',xs'') where (xs',xs'') = splitAt (n-1) xs
-splitAt _     _           =  error "PreludeList.splitAt: negative argument"
-
--- 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
-
-span, break             :: (a -> Bool) -> [a] -> ([a],[a])
-span p []               =  ([],[])
-span p xs@(x:xs')
-         | p x          =  let (ys,zs) = span p xs' in (x:ys,zs)
-         | otherwise    =  ([],xs)
-break p                 =  span (not . p)
-
--- lines breaks a string up into a list of strings at newline characters.
--- The resulting strings do not contain newlines.  Similary, words
--- breaks a string up into a list of words, which were delimited by
--- white space.  unlines and unwords are the inverse operations.
--- unlines joins lines with terminating newlines, and unwords joins
--- words with separating spaces.
-
-lines			:: String -> [String]
-lines ""		=  []
-lines s			=  let (l, s') = break (== '\n') s
-			   in  l : case s' of
-					[]     	-> []
-					(_:s'') -> lines s''
-
-words			:: String -> [String]
-words s			=  case dropWhile {-partain:Char.-}isSpace s of
-				"" -> []
-				s' -> w : words s''
-				      where (w, s'') = 
-                                             break {-partain:Char.-}isSpace s'
-
-unlines			:: [String] -> String
-unlines			=  concatMap (++ "\n")
-
-unwords			:: [String] -> String
-unwords []		=  ""
-unwords ws		=  foldr1 (\w s -> w ++ ' ':s) ws
-
--- reverse xs returns the elements of xs in reverse order.  xs must be finite.
-reverse                 :: [a] -> [a]
-reverse                 =  foldl (flip (:)) []
-
--- and returns the conjunction of a Boolean list.  For the result to be
--- True, the list must be finite; False, however, results from a False
--- value at a finite index of a finite or infinite list.  or is the
--- disjunctive dual of and.
-and, or                 :: [Bool] -> Bool
-and                     =  foldr (&&) True
-or                      =  foldr (||) False
-
--- Applied to a predicate and a list, any determines if any element
--- of the list satisfies the predicate.  Similarly, for all.
-any, all                :: (a -> Bool) -> [a] -> Bool
-any p                   =  or . map p
-all p                   =  and . map p
-
--- elem is the list membership predicate, usually written in infix form,
--- e.g., x `elem` xs.  notElem is the negation.
-elem, notElem           :: (Eq a) => a -> [a] -> Bool
-elem x                  =  any (== x)
-notElem x               =  all (not . (/= x))
-
--- lookup key assocs looks up a key in an association list.
-lookup                  :: (Eq a) => a -> [(a,b)] -> Maybe b
-lookup key []           =  Nothing
-lookup key ((x,y):xys)
-    | key == x          =  Just y
-    | otherwise         =  lookup key xys
-
--- sum and product compute the sum or product of a finite list of numbers.
-sum, product            :: (Num a) => [a] -> a
-sum                     =  foldl (+) 0  
-product                 =  foldl (*) 1
-
--- maximum and minimum return the maximum or minimum value from a list,
--- which must be non-empty, finite, and of an ordered type.
-maximum, minimum        :: (Ord a) => [a] -> a
-maximum []              =  error "PreludeList.maximum: empty list"
-maximum xs              =  foldl1 max xs
-
-minimum []              =  error "PreludeList.minimum: empty list"
-minimum xs              =  foldl1 min xs
-
-concatMap               :: (a -> [b]) -> [a] -> [b]
-concatMap f             =  concat . map f
-
--- zip takes two lists and returns a list of corresponding pairs.  If one
--- input list is short, excess elements of the longer list are discarded.
--- zip3 takes three lists and returns a list of triples.  Zips for larger
--- tuples are in the List library
-
-zip                     :: [a] -> [b] -> [(a,b)]
-zip                     =  zipWith (,)
-
-zip3                    :: [a] -> [b] -> [c] -> [(a,b,c)]
-zip3                    =  zipWith3 (,,)
-
--- The zipWith family generalises the zip family by zipping with the
--- function given as the first argument, instead of a tupling function.
--- For example, zipWith (+) is applied to two lists to produce the list
--- of corresponding sums.
-
-zipWith                 :: (a->b->c) -> [a]->[b]->[c]
-zipWith z (a:as) (b:bs) =  z a b : zipWith z as bs
-zipWith _ _ _           =  []
-
-zipWith3                :: (a->b->c->d) -> [a]->[b]->[c]->[d]
-zipWith3 z (a:as) (b:bs) (c:cs)
-                        =  z a b c : zipWith3 z as bs cs
-zipWith3 _ _ _ _        =  []
-
-
--- unzip transforms a list of pairs into a pair of lists.  
-
-unzip                   :: [(a,b)] -> ([a],[b])
-unzip                   =  foldr (\(a,b) ~(as,bs) -> (a:as,b:bs)) ([],[])
-
-unzip3                  :: [(a,b,c)] -> ([a],[b],[c])
-unzip3                  =  foldr (\(a,b,c) ~(as,bs,cs) -> (a:as,b:bs,c:cs))
-                                 ([],[],[])
-
-{- module  PreludeText -}
-
-type  ReadS a   = String -> [(a,String)]
-type  ShowS     = String -> String
-
-class  Read a  where
-    readsPrec :: Int -> ReadS a
-    readList  :: ReadS [a]
-
-    readList    = readParen False (\r -> [pr | ("[",s)  <- lex r,
-                                               pr       <- readl s])
-                  where readl  s = [([],t)   | ("]",t)  <- lex s] ++
-                                   [(x:xs,u) | (x,t)    <- reads s,
-                                               (xs,u)   <- readl' t]
-                        readl' s = [([],t)   | ("]",t)  <- lex s] ++
-                                   [(x:xs,v) | (",",t)  <- lex s,
-                                               (x,u)    <- reads t,
-                                               (xs,v)   <- readl' u]
-
-class  Show a  where
-    showsPrec :: Int -> a -> ShowS
-    showList  :: [a] -> ShowS
-
-    showList [] = showString "[]"
-    showList (x:xs)
-                = showChar '[' . shows x . showl xs
-                  where showl []     = showChar ']'
-                        showl (x:xs) = showString ", " . shows x . showl xs
-
-reads           :: (Read a) => ReadS a
-reads           =  readsPrec 0
-
-shows           :: (Show a) => a -> ShowS
-shows           =  showsPrec 0
-
-read            :: (Read a) => String -> a
-read s          =  case [x | (x,t) <- reads s, ("","") <- lex t] of
-                        [x] -> x
-                        []  -> error "PreludeText.read: no parse"
-                        _   -> error "PreludeText.read: ambiguous parse"
-
-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
-
-readParen       :: Bool -> ReadS a -> ReadS a
-readParen b g   =  if b then mandatory else optional
-                   where optional r  = g r ++ mandatory r
-                         mandatory r = [(x,u) | ("(",s) <- lex r,
-                                                (x,t)   <- optional s,
-                                                (")",u) <- lex t    ]
-
--- lex: moved to GHCbase
-
-{- module PreludeIO -}
-
--- in GHCio: type FilePath   =  String
-
-fail            :: IOError -> IO a 
-fail err	=  IO $ ST $ \ s -> (Left err, s)
-
-userError       :: String  -> IOError
-userError str	=  UserError str
-
-catch           :: IO a    -> (IOError -> IO a) -> IO a 
-catch (IO (ST m)) k  = IO $ ST $ \ s ->
-  case (m s) of { (r, new_s) ->
-  case r of
-    Right  _ -> (r, new_s)
-    Left err -> case (k err) of { IO (ST k_err) ->
-		(k_err new_s) }}
-
-putChar         :: Char -> IO ()
-putChar c       =  hPutChar stdout c
-
-putStr          :: String -> IO ()
-putStr s        =  hPutStr stdout s
-
-putStrLn        :: String -> IO ()
-putStrLn s      =  do putStr s
-                      putChar '\n'
-
-print           :: Show a => a -> IO ()
-print x         =  putStrLn (show x)
-
-getChar         :: IO Char
-getChar         =  hGetChar stdin
-
-getLine         :: IO String
-getLine         =  do c <- getChar
-                      if c == '\n' then return "" else 
-                         do s <- getLine
-                            return (c:s)
-            
-getContents     :: IO String
-getContents     =  hGetContents stdin
-
-interact        ::  (String -> String) -> IO ()
-interact f      =   do s <- getContents
-                       putStr (f s)
-
-readFile        :: FilePath -> IO String
-readFile name	=  openFile name ReadMode >>= hGetContents
-
-writeFile       :: FilePath -> String -> IO ()
-writeFile name str
-  = openFile name WriteMode >>= \hdl -> hPutStr hdl str >> hClose hdl
-
-appendFile      :: FilePath -> String -> IO ()
-appendFile name str
-  = openFile name AppendMode >>= \hdl -> hPutStr hdl str >> hClose hdl
-
-readIO          :: Read a => String -> IO a
-  -- raises an exception instead of an error
-readIO s        =  case [x | (x,t) <- reads s, ("","") <- lex t] of
-                        [x] -> return x
-                        []  -> fail (userError "PreludeIO.readIO: no parse")
-                        _   -> fail (userError 
-                                      "PreludeIO.readIO: ambiguous parse")
-
-readLn          :: Read a => IO a
-readLn          =  do l <- getLine
-                      r <- readIO l
-                      return r
diff --git a/ghc/lib/prelude/PreludeGlaST.hs b/ghc/lib/prelude/PreludeGlaST.hs
deleted file mode 100644
index 179b648b89..0000000000
--- a/ghc/lib/prelude/PreludeGlaST.hs
+++ /dev/null
@@ -1,94 +0,0 @@
--- solely for backward-compatibility with pre-2.00 GHC systems.
-
-module PreludeGlaST (
-	Array(..), -- NB: makes internals visible
-	MutableVar,
-	ST,
-	ByteArray,
-	MutableArray,
-	MutableByteArray,
-	PrimIO,
-	Addr(..), Word(..),
-	CCallable(..), CReturnable(..),
-
-	boundsOfArray,
-	boundsOfByteArray,
-	fixPrimIO,
-	fixST,
-	forkPrimIO,
-	forkST,
-	freezeAddrArray,
-	freezeArray,
-	freezeCharArray,
-	freezeDoubleArray,
-	freezeFloatArray,
-	freezeIntArray,
-	indexAddrArray,
-	indexAddrOffAddr,
-	indexCharArray,
-	indexCharOffAddr,
-	indexDoubleArray,
-	indexDoubleOffAddr,
-	indexFloatArray,
-	indexFloatOffAddr,
-	indexIntArray,
-	indexIntOffAddr,
-	ioToST,
-	listPrimIO,
-	listST,
-	mapAndUnzipPrimIO,
-	mapAndUnzipST,
-	mapPrimIO,
-	mapST,
-	newAddrArray,
-	newArray,
-	newCharArray,
-	newDoubleArray,
-	newFloatArray,
-	newIntArray,
-	newVar,
-	readAddrArray,
-	readArray,
-	readCharArray,
-	readDoubleArray,
-	readFloatArray,
-	readIntArray,
-	readVar,
-	returnPrimIO,
-	returnST,
-	returnStrictlyST,
-	runST,
-	primIOToIO,
-	ioToPrimIO,
-	sameMutableArray,
-	sameMutableByteArray,
-	sameVar,
-	seqPrimIO,
-	seqST,
-	seqStrictlyST,
-	stToIO,
-	thawArray,
-	thenPrimIO,
-	thenST,
-	thenStrictlyST,
-	unsafeFreezeArray,
-	unsafeFreezeByteArray,
-	unsafeInterleavePrimIO,
-	unsafeInterleaveST,
-	unsafePerformPrimIO,
-	writeAddrArray,
-	writeArray,
-	writeCharArray,
-	writeDoubleArray,
-	writeFloatArray,
-	writeIntArray,
-	writeVar
-#ifndef __PARALLEL_HASKELL__
-	, makeStablePtr
-	, deRefStablePtr
-	, freeStablePtr
-	, performGC
-#endif
-    ) where
-
-import GHCbase