[project @ 1997-11-11 14:32:34 by simonm]

Library changes to:

	* remove PrimIO
	* change type of _ccall_ to IO
	* incorporate Alastair Reid's new library interfaces for
	  compatibility with Hugs.

13 files changed, 1108 insertions, 181 deletions

diff --git a/ghc/lib/glaExts/Addr.lhs b/ghc/lib/glaExts/Addr.lhs
new file mode 100644
index 0000000000..a63409415f
--- /dev/null
+++ b/ghc/lib/glaExts/Addr.lhs
@@ -0,0 +1,31 @@
+%
+% (c) The AQUA Project, Glasgow University, 1994-1996
+%
+
+\section[Addr]{Module @Addr@}
+
+\begin{code}
+{-# OPTIONS -fno-implicit-prelude #-}
+
+module Addr (
+	Addr(..), -- ToDo: nullAddr,
+   ) where
+
+import GHC
+import PrelBase
+import STBase
+import CCall
+\end{code}
+
+\begin{code}
+data Addr = A# Addr# 	deriving (Eq, Ord) -- Glasgow extension
+
+nullAddr = ``NULL'' :: Addr
+
+instance CCallable Addr
+instance CCallable Addr#
+instance CReturnable Addr
+\end{code}
+
+
+
diff --git a/ghc/lib/glaExts/Bits.lhs b/ghc/lib/glaExts/Bits.lhs
new file mode 100644
index 0000000000..3a7a3b3949
--- /dev/null
+++ b/ghc/lib/glaExts/Bits.lhs
@@ -0,0 +1,37 @@
+%
+% (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
+%
+\section[Bits]{The @Bits@ Module}
+
+\begin{code}
+{-# OPTIONS -fno-implicit-prelude #-}
+
+module Bits where
+
+import PrelBase
+
+infixl 8 `shift`, `rotate`
+infixl 7 .&.
+infixl 6 `xor`
+infixl 5 .|.
+
+class Bits a where
+  (.&.), (.|.), xor :: a -> a -> a
+  complement        :: a -> a
+  shift             :: a -> Int -> a
+  rotate            :: a -> Int -> a
+  bit               :: Int -> a
+  setBit            :: a -> Int -> a
+  clearBit          :: a -> Int -> a
+  complementBit     :: a -> Int -> a
+  testBit           :: a -> Int -> Bool
+  bitSize           :: a -> Int
+  isSigned          :: a -> Bool
+
+shiftL, shiftR   :: Bits a => a -> Int -> a
+rotateL, rotateR :: Bits a => a -> Int -> a
+shiftL  a i = shift  a i
+shiftR  a i = shift  a (-i)
+rotateL a i = rotate a i
+rotateR a i = rotate a (-i)
+\end{code}
diff --git a/ghc/lib/glaExts/ByteArray.lhs b/ghc/lib/glaExts/ByteArray.lhs
index f0f66b324d..d6326dc9ea 100644
--- a/ghc/lib/glaExts/ByteArray.lhs
+++ b/ghc/lib/glaExts/ByteArray.lhs
@@ -33,7 +33,8 @@ module ByteArray
 
 import ArrBase
 import Ix
-import Foreign (Addr, Word)
+import Foreign (Word)
+import Addr
 
 \end{code}
 
diff --git a/ghc/lib/glaExts/CCall.lhs b/ghc/lib/glaExts/CCall.lhs
new file mode 100644
index 0000000000..6de7fbf2c8
--- /dev/null
+++ b/ghc/lib/glaExts/CCall.lhs
@@ -0,0 +1,56 @@
+%
+% (c) The AQUA Project, Glasgow University, 1994-1996
+%
+
+\section[CCall]{Module @CCall@}
+
+\begin{code}
+{-# OPTIONS -fno-implicit-prelude #-}
+
+module CCall (
+	CCallable(..), CReturnable(..),
+	Word(..)
+   ) where
+
+import PrelBase
+import GHC
+\end{code}
+
+%*********************************************************
+%*							*
+\subsection{Classes @CCallable@ and @CReturnable@}
+%*							*
+%*********************************************************
+
+\begin{code}
+class CCallable   a
+class CReturnable a
+
+instance CCallable Char
+instance CCallable   Char#
+instance CReturnable Char
+
+instance CCallable   Int
+instance CCallable   Int#
+instance CReturnable Int
+
+-- DsCCall knows how to pass strings...
+instance CCallable   [Char]
+
+instance CCallable   Float
+instance CCallable   Float#
+instance CReturnable Float
+
+instance CCallable   Double
+instance CCallable   Double#
+instance CReturnable Double
+
+data Word = W# Word# 	deriving (Eq, Ord) -- Glasgow extension
+
+instance CCallable Word
+instance CCallable Word#
+instance CReturnable Word
+
+instance CReturnable () -- Why, exactly?
+\end{code}
+
diff --git a/ghc/lib/glaExts/Foreign.lhs b/ghc/lib/glaExts/Foreign.lhs
index d72e31454b..34d09908fa 100644
--- a/ghc/lib/glaExts/Foreign.lhs
+++ b/ghc/lib/glaExts/Foreign.lhs
@@ -12,93 +12,55 @@ module Foreign (
 #ifndef __PARALLEL_HASKELL__
 	ForeignObj(..),
 #endif
-	Addr(..), Word(..)
+	Word(..),
+
+#ifndef __PARALLEL_HASKELL__
+	unpackCStringFO,   -- :: ForeignObj    -> [Char]
+	unpackNBytesFO,    -- :: ForeignObj    -> Int  -> [Char]
+	unpackCStringFO#,  -- :: ForeignObj#   -> [Char]
+	unpackNBytesFO#    -- :: ForeignObj#   -> Int# -> [Char]
+#endif
    ) where
 
+import IOBase
 import STBase
-import UnsafeST	( unsafePerformPrimIO )
+import Unsafe
 import PrelBase
+import CCall
+import Addr
 import GHC
 \end{code}
 
 
 %*********************************************************
 %*							*
-\subsection{Classes @CCallable@ and @CReturnable@}
-%*							*
-%*********************************************************
-
-\begin{code}
-class CCallable   a
-class CReturnable a
-
-instance CCallable Char
-instance CCallable   Char#
-instance CReturnable Char
-
-instance CCallable   Int
-instance CCallable   Int#
-instance CReturnable Int
-
--- DsCCall knows how to pass strings...
-instance CCallable   [Char]
-
-instance CCallable   Float
-instance CCallable   Float#
-instance CReturnable Float
-
-instance CCallable   Double
-instance CCallable   Double#
-instance CReturnable Double
-
-data Addr = A# Addr# 	deriving (Eq, Ord) -- Glasgow extension
-
-instance CCallable Addr
-instance CCallable Addr#
-instance CReturnable Addr
-
-data Word = W# Word# 	deriving (Eq, Ord) -- Glasgow extension
-
-instance CCallable Word
-instance CCallable Word#
-instance CReturnable Word
-
-instance CReturnable () -- Why, exactly?
-\end{code}
-
-
-%*********************************************************
-%*							*
 \subsection{Type @ForeignObj@ and its operations}
 %*							*
 %*********************************************************
 
 \begin{code}
 #ifndef __PARALLEL_HASKELL__
---Defined in PrelBase: data ForeignObj = ForeignObj ForeignObj#
-data ForeignObj = ForeignObj ForeignObj#   -- another one
-
 instance CCallable ForeignObj
 instance CCallable ForeignObj#
 
 eqForeignObj    :: ForeignObj  -> ForeignObj -> Bool
-makeForeignObj  :: Addr        -> Addr       -> PrimIO ForeignObj
-writeForeignObj :: ForeignObj  -> Addr       -> PrimIO ()
+makeForeignObj  :: Addr        -> Addr       -> IO ForeignObj
+writeForeignObj :: ForeignObj  -> Addr       -> IO ()
 
 {- derived op - attaching a free() finaliser to a malloc() allocated reference. -}
-makeMallocPtr   :: Addr        -> PrimIO ForeignObj
+makeMallocPtr   :: Addr        -> IO ForeignObj
 
-makeForeignObj (A# obj) (A# finaliser) = ST ( \ s# ->
+makeForeignObj (A# obj) (A# finaliser) = IO ( \ s# ->
     case makeForeignObj# obj finaliser s# of
-      StateAndForeignObj# s1# fo# -> STret s1# (ForeignObj fo#))
+      StateAndForeignObj# s1# fo# -> IOok s1# (ForeignObj fo#))
 
-writeForeignObj (ForeignObj fo#) (A# datum#) = ST ( \ s# ->
-    case writeForeignObj# fo# datum# s# of { s1# -> STret s1# () } )
+writeForeignObj (ForeignObj fo#) (A# datum#) = IO ( \ s# ->
+    case writeForeignObj# fo# datum# s# of { s1# -> IOok s1# () } )
 
 makeMallocPtr a = makeForeignObj a (``&free''::Addr)
 
 eqForeignObj mp1 mp2
-  = unsafePerformPrimIO (_ccall_ eqForeignObj mp1 mp2) /= (0::Int)
+  = unsafePerformIO (_ccall_ eqForeignObj mp1 mp2) /= (0::Int)
 
 instance Eq ForeignObj where 
     p == q = eqForeignObj p q
@@ -106,7 +68,6 @@ instance Eq ForeignObj where
 #endif /* !__PARALLEL_HASKELL__ */
 \end{code}
 
-
 %*********************************************************
 %*							*
 \subsection{Type @StablePtr@ and its operations}
@@ -124,27 +85,23 @@ instance CReturnable (StablePtr a)
 -- @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 ()
+makeStablePtr  :: a -> IO (StablePtr a)
+deRefStablePtr :: StablePtr a -> IO a
+freeStablePtr  :: StablePtr a -> IO ()
 
 {-# INLINE deRefStablePtr #-}
 {-# INLINE freeStablePtr #-}
-{-# INLINE performGC #-}
 
-makeStablePtr f = ST $ \ rw1# ->
+makeStablePtr f = IO $ \ rw1# ->
     case makeStablePtr# f rw1# of
-      StateAndStablePtr# rw2# sp# -> STret rw2# (StablePtr sp#)
+      StateAndStablePtr# rw2# sp# -> IOok rw2# (StablePtr sp#)
 
-deRefStablePtr (StablePtr sp#) = ST $ \ rw1# ->
+deRefStablePtr (StablePtr sp#) = IO $ \ rw1# ->
     case deRefStablePtr# sp# rw1# of
-      StateAndPtr# rw2# a -> STret rw2# a
+      StateAndPtr# rw2# a -> IOok rw2# a
 
 freeStablePtr sp = _ccall_ freeStablePointer sp
 
-performGC = _ccall_GC_ StgPerformGarbageCollection
-
 #endif /* !__PARALLEL_HASKELL__ */
 \end{code}
 
@@ -160,3 +117,46 @@ data StateAndStablePtr# s a = StateAndStablePtr# (State# s) (StablePtr# a)
 #endif
 data StateAndForeignObj# s  = StateAndForeignObj# (State# s) ForeignObj#
 \end{code}
+
+%*********************************************************
+%*							*
+\subsection{Unpacking Foreigns}
+%*							*
+%*********************************************************
+
+Primitives for converting Foreigns pointing to external
+sequence of bytes into a list of @Char@s (a renamed version
+of the code above).
+
+\begin{code}
+#ifndef __PARALLEL_HASKELL__
+unpackCStringFO :: ForeignObj -> [Char]
+unpackCStringFO (ForeignObj fo#) = unpackCStringFO# fo#
+
+unpackCStringFO# :: ForeignObj# -> [Char]
+unpackCStringFO# fo {- ptr. to NUL terminated string-}
+  = unpack 0#
+  where
+    unpack nh
+      | ch `eqChar#` '\0'# = []
+      | otherwise	   = C# ch : unpack (nh +# 1#)
+      where
+	ch = indexCharOffForeignObj# fo nh
+
+unpackNBytesFO :: ForeignObj -> Int -> [Char]
+unpackNBytesFO (ForeignObj fo) (I# l) = unpackNBytesFO# fo l
+
+unpackNBytesFO#    :: ForeignObj# -> Int#   -> [Char]
+  -- This one is called by the compiler to unpack literal strings with NULs in them; rare.
+unpackNBytesFO# fo len
+  = unpack 0#
+    where
+     unpack i
+      | i >=# len  = []
+      | otherwise  = C# ch : unpack (i +# 1#)
+      where
+	ch = indexCharOffForeignObj# fo i
+#endif
+\end{code}
+
+
diff --git a/ghc/lib/glaExts/GlaExts.lhs b/ghc/lib/glaExts/GlaExts.lhs
index eb89c9c439..525dc92a8a 100644
--- a/ghc/lib/glaExts/GlaExts.lhs
+++ b/ghc/lib/glaExts/GlaExts.lhs
@@ -14,32 +14,15 @@ GHC interfaces - instead import the GlaExts rag bag and you should be away!
 module GlaExts
 
        (
-        -- From module STBase, the PrimIO monad 
-        -- (an instance of ST):
-	PrimIO,
         ST, RealWorld,
 
-	thenPrimIO,     -- 
-        returnPrimIO, 
-	seqPrimIO,
-        fixPrimIO, 
-	unsafePerformPrimIO, 
-	unsafeInterleavePrimIO,
+	unsafePerformIO, 
+	unsafeInterleaveIO,
         
-	-- backwards compatibility
-        listPrimIO,        -- :: [PrimIO a] -> PrimIO [a]
-	mapPrimIO,         -- :: (a -> PrimIO b) -> [a] -> PrimIO [b]
-        mapAndUnzipPrimIO, -- :: (a -> PrimIO (b,c)) -> [a] -> PrimIO ([b],[c])
-
-
-        -- operations for interfacing IO and ST/PrimIO
+        -- operations for interfacing IO and ST
         --
         stToIO,       -- :: ST RealWorld a -> IO a
-	primIOToIO,   -- :: PrimIO a       -> IO a
 	ioToST,	      -- :: IO a -> ST RealWorld a
-	ioToPrimIO,   -- :: IO a -> PrimIO       a
-        thenIO_Prim,  -- :: PrimIO a -> (a -> IO b) -> IO b
-        seqIO_Prim,   -- :: PrimIO a -> IO b -> IO b
 
         -- Everything from module ByteArray:
 	module ByteArray,
@@ -61,7 +44,7 @@ module GlaExts
 
 import GHC
 import STBase
-import UnsafeST
+import IOExts
 import PrelBase
 import ByteArray
 import MutableArray
diff --git a/ghc/lib/glaExts/IOExts.lhs b/ghc/lib/glaExts/IOExts.lhs
new file mode 100644
index 0000000000..ed8a3c169a
--- /dev/null
+++ b/ghc/lib/glaExts/IOExts.lhs
@@ -0,0 +1,31 @@
+%
+% (c) The AQUA Project, Glasgow University, 1994-1996
+%
+
+\section[IOExts]{Module @IOExts@}
+
+\begin{code}
+{-# OPTIONS -fno-implicit-prelude #-}
+
+module IOExts
+        ( fixIO
+        , unsafePerformIO
+        , unsafeInterleaveIO
+
+        , IORef
+          -- instance Eq (MutVar a)
+        , newIORef
+        , readIORef
+        , writeIORef
+
+        , trace
+        , performGC
+        ) where
+\end{code}
+
+\begin{code}
+import IOBase
+import IORef
+import STBase
+import Unsafe
+\end{code}
diff --git a/ghc/lib/glaExts/IORef.lhs b/ghc/lib/glaExts/IORef.lhs
new file mode 100644
index 0000000000..85c6520185
--- /dev/null
+++ b/ghc/lib/glaExts/IORef.lhs
@@ -0,0 +1,34 @@
+%
+% (c) The AQUA Project, Glasgow University, 1994-1996
+%
+
+\section[IORef]{Module @IORef@}
+
+\begin{code}
+{-# OPTIONS -fno-implicit-prelude #-}
+
+module IORef (
+	IORef,
+	newIORef,
+	readIORef,
+	writeIORef
+   ) where
+
+import PrelBase
+import ArrBase
+import IOBase
+import STBase
+\end{code}
+
+\begin{code}
+newtype IORef a = IORef (MutableVar RealWorld a) deriving Eq
+
+newIORef :: a -> IO (IORef a)
+newIORef v = stToIO (newVar v) >>= \ var -> return (IORef var)
+
+readIORef :: IORef a -> IO a
+readIORef (IORef var) = stToIO (readVar var)
+
+writeIORef :: IORef a -> a -> IO ()
+writeIORef (IORef var) v = stToIO (writeVar var v)
+\end{code}
diff --git a/ghc/lib/glaExts/Int.lhs b/ghc/lib/glaExts/Int.lhs
new file mode 100644
index 0000000000..b539bae77c
--- /dev/null
+++ b/ghc/lib/glaExts/Int.lhs
@@ -0,0 +1,346 @@
+%
+% (c) The AQUA Project, Glasgow University, 1994-1996
+%
+
+\section[Int]{Module @Int@}
+
+This code is largely copied from the Hugs library of the same name.
+
+\begin{code}
+{-# OPTIONS -fno-implicit-prelude #-}
+
+-----------------------------------------------------------------------------
+-- Signed Integers
+-- Suitable for use with Hugs 1.4 on 32 bit systems.
+-----------------------------------------------------------------------------
+
+module Int
+	( Int8
+	, Int16
+	, Int32
+	--, Int64
+	, int8ToInt  -- :: Int8  -> Int
+	, intToInt8  -- :: Int   -> Int8
+	, int16ToInt -- :: Int16 -> Int
+	, intToInt16 -- :: Int   -> Int16
+	, int32ToInt -- :: Int32 -> Int
+	, intToInt32 -- :: Int   -> Int32
+	-- plus Eq, Ord, Num, Bounded, Real, Integral, Ix, Enum, Read,
+	--  Show and Bits instances for each of Int8, Int16 and Int32
+	) where
+
+import PrelBase
+import PrelNum
+import PrelRead
+import Ix
+import Error
+import Bits
+import GHC
+
+-----------------------------------------------------------------------------
+-- The "official" coercion functions
+-----------------------------------------------------------------------------
+
+int8ToInt  :: Int8  -> Int
+intToInt8  :: Int   -> Int8
+int16ToInt :: Int16 -> Int
+intToInt16 :: Int   -> Int16
+int32ToInt :: Int32 -> Int
+intToInt32 :: Int   -> Int32
+
+-- And some non-exported ones
+
+int8ToInt16  :: Int8  -> Int16
+int8ToInt32  :: Int8  -> Int32
+int16ToInt8  :: Int16 -> Int8
+int16ToInt32 :: Int16 -> Int32
+int32ToInt8  :: Int32 -> Int8
+int32ToInt16 :: Int32 -> Int16
+
+int8ToInt16  = I16 . int8ToInt
+int8ToInt32  = I32 . int8ToInt
+int16ToInt8  = I8  . int16ToInt
+int16ToInt32 = I32 . int16ToInt
+int32ToInt8  = I8  . int32ToInt
+int32ToInt16 = I16 . int32ToInt
+
+-----------------------------------------------------------------------------
+-- Int8
+-----------------------------------------------------------------------------
+
+newtype Int8  = I8 Int
+
+int8ToInt (I8 x) = if x' <= 0x7f then x' else x' - 0x100
+   where x' = case x of { I# x ->
+		I# (word2Int# (int2Word# x `and#` int2Word# 0xff#))
+	      }
+intToInt8 = I8
+
+instance Eq  Int8     where (==)    = binop (==)
+instance Ord Int8     where compare = binop compare
+
+instance Num Int8 where
+    x + y         = to (binop (+) x y)
+    x - y         = to (binop (-) x y)
+    negate        = to . negate . from
+    x * y         = to (binop (*) x y)
+    abs           = absReal
+    signum        = signumReal
+    fromInteger   = to . fromInteger
+    fromInt       = to
+
+instance Bounded Int8 where
+    minBound = 0x80
+    maxBound = 0x7f 
+
+instance Real Int8 where
+    toRational x = toInteger x % 1
+
+instance Integral Int8 where
+    x `div` y     = to  (binop div x y)
+    x `quot` y    = to  (binop quot x y)
+    x `rem` y     = to  (binop rem x y)
+    x `mod` y     = to  (binop mod x y)
+    x `quotRem` y = to2 (binop quotRem x y)
+    toInteger     = toInteger . from
+    toInt         = toInt     . from
+
+instance Ix Int8 where
+    range (m,n)          = [m..n]
+    index b@(m,n) i
+	      | inRange b i = from (i - m)
+	      | otherwise   = error "index: Index out of range"
+    inRange (m,n) i      = m <= i && i <= n
+
+instance Enum Int8 where
+    toEnum         = to 
+    fromEnum       = from
+    enumFrom c       = map toEnum [fromEnum c .. fromEnum (maxBound::Int8)]
+    enumFromThen c d = map toEnum [fromEnum c, fromEnum d .. fromEnum (last::Int8)]
+			  where last = if d < c then minBound else maxBound
+
+instance Read Int8 where
+    readsPrec p s = [ (to x,r) | (x,r) <- readsPrec p s ]
+
+instance Show Int8 where
+    showsPrec p = showsPrec p . from
+
+binop8 :: (Int32 -> Int32 -> a) -> (Int8 -> Int8 -> a)
+binop8 op x y = int8ToInt32 x `op` int8ToInt32 y
+
+instance Bits Int8 where
+  x .&. y       = int32ToInt8 (binop8 (.&.) x y)
+  x .|. y       = int32ToInt8 (binop8 (.|.) x y)
+  x `xor` y     = int32ToInt8 (binop8 xor x y)
+  complement    = int32ToInt8 . complement . int8ToInt32
+  x `shift` i   = int32ToInt8 (int8ToInt32 x `shift` i)
+--  rotate      
+  bit           = int32ToInt8 . bit
+  setBit x i    = int32ToInt8 (setBit (int8ToInt32 x) i)
+  clearBit x i  = int32ToInt8 (clearBit (int8ToInt32 x) i)
+  complementBit x i = int32ToInt8 (complementBit (int8ToInt32 x) i)
+  testBit x i   = testBit (int8ToInt32 x) i
+  bitSize  _    = 8
+  isSigned _    = True
+
+-----------------------------------------------------------------------------
+-- Int16
+-----------------------------------------------------------------------------
+
+newtype Int16  = I16 Int
+
+int16ToInt (I16 x) = if x' <= 0x7fff then x' else x' - 0x10000
+   where x' = case x of { I# x ->
+		I# (word2Int# (int2Word# x `and#` int2Word# 0xffff#))
+	      }
+intToInt16 = I16
+
+instance Eq  Int16     where (==)    = binop (==)
+instance Ord Int16     where compare = binop compare
+
+instance Num Int16 where
+    x + y         = to (binop (+) x y)
+    x - y         = to (binop (-) x y)
+    negate        = to . negate . from
+    x * y         = to (binop (*) x y)
+    abs           = absReal
+    signum        = signumReal
+    fromInteger   = to . fromInteger
+    fromInt       = to
+
+instance Bounded Int16 where
+    minBound = 0x8000
+    maxBound = 0x7fff 
+
+instance Real Int16 where
+    toRational x = toInteger x % 1
+
+instance Integral Int16 where
+    x `div` y     = to  (binop div x y)
+    x `quot` y    = to  (binop quot x y)
+    x `rem` y     = to  (binop rem x y)
+    x `mod` y     = to  (binop mod x y)
+    x `quotRem` y = to2 (binop quotRem x y)
+    toInteger     = toInteger . from
+    toInt         = toInt     . from
+
+instance Ix Int16 where
+    range (m,n)          = [m..n]
+    index b@(m,n) i
+	      | inRange b i = from (i - m)
+	      | otherwise   = error "index: Index out of range"
+    inRange (m,n) i      = m <= i && i <= n
+
+instance Enum Int16 where
+    toEnum         = to 
+    fromEnum       = from
+    enumFrom c       = map toEnum [fromEnum c .. fromEnum (maxBound::Int16)]
+    enumFromThen c d = map toEnum [fromEnum c, fromEnum d .. fromEnum (last::Int16)]
+			  where last = if d < c then minBound else maxBound
+
+instance Read Int16 where
+    readsPrec p s = [ (to x,r) | (x,r) <- readsPrec p s ]
+
+instance Show Int16 where
+    showsPrec p = showsPrec p . from
+
+binop16 :: (Int32 -> Int32 -> a) -> (Int16 -> Int16 -> a)
+binop16 op x y = int16ToInt32 x `op` int16ToInt32 y
+
+instance Bits Int16 where
+  x .&. y       = int32ToInt16 (binop16 (.&.) x y)
+  x .|. y       = int32ToInt16 (binop16 (.|.) x y)
+  x `xor` y     = int32ToInt16 (binop16 xor x y)
+  complement    = int32ToInt16 . complement . int16ToInt32
+  x `shift` i   = int32ToInt16 (int16ToInt32 x `shift` i)
+--  rotate      
+  bit           = int32ToInt16 . bit
+  setBit x i    = int32ToInt16 (setBit (int16ToInt32 x) i)
+  clearBit x i  = int32ToInt16 (clearBit (int16ToInt32 x) i)
+  complementBit x i = int32ToInt16 (complementBit (int16ToInt32 x) i)
+  testBit x i   = testBit (int16ToInt32 x) i
+  bitSize  _    = 16
+  isSigned _    = True
+
+-----------------------------------------------------------------------------
+-- Int32
+-----------------------------------------------------------------------------
+
+newtype Int32  = I32 Int
+
+int32ToInt (I32 x) = x
+intToInt32 = I32
+
+instance Eq  Int32     where (==)    = binop (==)
+instance Ord Int32     where compare = binop compare
+
+instance Num Int32 where
+    x + y         = to (binop (+) x y)
+    x - y         = to (binop (-) x y)
+    negate        = to . negate . from
+    x * y         = to (binop (*) x y)
+    abs           = absReal
+    signum        = signumReal
+    fromInteger   = to . fromInteger
+    fromInt       = to
+
+instance Bounded Int32 where
+    minBound = to minBound
+    maxBound = to maxBound
+
+instance Real Int32 where
+    toRational x = toInteger x % 1
+
+instance Integral Int32 where
+    x `div` y     = to  (binop div x y)
+    x `quot` y    = to  (binop quot x y)
+    x `rem` y     = to  (binop rem x y)
+    x `mod` y     = to  (binop mod x y)
+    x `quotRem` y = to2 (binop quotRem x y)
+    toInteger     = toInteger . from
+    toInt         = toInt     . from
+
+instance Ix Int32 where
+    range (m,n)          = [m..n]
+    index b@(m,n) i
+	      | inRange b i = from (i - m)
+	      | otherwise   = error "index: Index out of range"
+    inRange (m,n) i      = m <= i && i <= n
+
+instance Enum Int32 where
+    toEnum         = to 
+    fromEnum       = from
+    enumFrom c       = map toEnum [fromEnum c .. fromEnum (maxBound::Int32)]
+    enumFromThen c d = map toEnum [fromEnum c, fromEnum d .. fromEnum (last::Int32)]
+			  where last = if d < c then minBound else maxBound
+
+instance Read Int32 where
+    readsPrec p s = [ (to x,r) | (x,r) <- readsPrec p s ]
+
+instance Show Int32 where
+    showsPrec p = showsPrec p . from
+
+instance Bits Int32 where
+  x .&. y      	= to (binop (wordop and#) x y)
+  x .|. y      	= to (binop (wordop or# ) x y)
+  x `xor` y    	= to (binop (wordop xor#) x y)
+  complement x 	= (x `xor` maxBound) + 1
+  shift (I32 (I# x)) i@(I# i#)
+	| i > 0     = I32 (I# (iShiftRL# x i#))
+	| otherwise = I32 (I# (iShiftL# x i#))
+--  rotate    	   
+  bit i        	= 1 `shift` -i
+  setBit x i    = x .|. bit i
+  clearBit x i  = x .&. complement (bit i)
+  complementBit x i = x `xor` bit i
+  testBit x i   = (x .&. bit i) /= 0
+  bitSize  _    = 32
+  isSigned _    = True
+
+{-# INLINE wordop #-}
+wordop op (I# x) (I# y) = I# (word2Int# (int2Word# x `op` int2Word# y))
+
+-----------------------------------------------------------------------------
+-- End of exported definitions
+--
+-- The remainder of this file consists of definitions which are only
+-- used in the implementation.
+-----------------------------------------------------------------------------
+
+-----------------------------------------------------------------------------
+-- Coercions - used to make the instance declarations more uniform
+-----------------------------------------------------------------------------
+
+class Coerce a where
+  to   :: Int -> a
+  from :: a -> Int
+
+instance Coerce Int32 where
+  from = int32ToInt
+  to   = intToInt32
+
+instance Coerce Int8 where
+  from = int8ToInt
+  to   = intToInt8
+
+instance Coerce Int16 where
+  from = int16ToInt
+  to   = intToInt16
+
+binop :: Coerce int => (Int -> Int -> a) -> (int -> int -> a)
+binop op x y = from x `op` from y
+
+to2 :: Coerce int => (Int, Int) -> (int, int)
+to2 (x,y) = (to x, to y)
+
+-----------------------------------------------------------------------------
+-- Code copied from the Prelude
+-----------------------------------------------------------------------------
+
+absReal x    | x >= 0    = x
+	     | otherwise = -x
+
+signumReal x | x == 0    =  0
+	     | x > 0     =  1
+	     | otherwise = -1
+\end{code}
diff --git a/ghc/lib/glaExts/LazyST.lhs b/ghc/lib/glaExts/LazyST.lhs
new file mode 100644
index 0000000000..d6fb8f6648
--- /dev/null
+++ b/ghc/lib/glaExts/LazyST.lhs
@@ -0,0 +1,104 @@
+%
+% (c) The GRASP/AQUA Project, Glasgow University, 1992-1997
+%
+
+\section[LazyST]{The Lazy State Transformer Monad, @LazyST@}
+
+This module presents an identical interface to ST, but the underlying
+implementation of the state thread is lazy.
+
+\begin{code}
+module LazyST (
+
+	STBase.ST,
+
+	unsafeInterleaveST,
+
+        -- ST is one, so you'll likely need some Monad bits
+        module Monad,
+
+	ST.STRef,
+	newSTRef, readSTRef, writeSTRef,
+
+	ST.STArray,
+	newSTArray, readSTArray, writeSTArray, Ix,
+
+	strictToLazyST, lazyToStrictST
+    ) where
+
+import qualified ST
+import qualified STBase
+import ArrBase
+import Unsafe   ( unsafeInterleaveST )
+import PrelBase	( Eq(..), Int, Bool, ($), ()(..) )
+import Monad
+import Ix
+
+newtype ST s a = ST (STBase.State s -> (a,STBase.State s))
+
+instance Monad (ST s) where
+
+        return a = ST $ \ s -> (a,s)
+        m >> k   =  m >>= \ _ -> k
+
+        (ST m) >>= k
+         = ST $ \ s ->
+           let
+             (r,new_s) = m s
+             ST k_a = k r
+           in
+           k_a new_s
+\end{code}
+
+%*********************************************************
+%*							*
+\subsection{Variables}
+%*							*
+%*********************************************************
+
+\begin{code}
+newSTRef   :: a -> ST s (ST.STRef s a)
+readSTRef  :: ST.STRef s a -> ST s a
+writeSTRef :: ST.STRef s a -> a -> ST s ()
+
+newSTRef   = strictToLazyST . ST.newSTRef
+readSTRef  = strictToLazyST . ST.readSTRef
+writeSTRef r a = strictToLazyST (ST.writeSTRef r a)
+\end{code}
+
+%*********************************************************
+%*							*
+\subsection{Arrays}
+%*							*
+%*********************************************************
+
+\begin{code}
+type STArray s ix elt = MutableArray s ix elt
+
+newSTArray 	    :: Ix ix => (ix,ix) -> elt -> ST s (STArray s ix elt)
+readSTArray   	    :: Ix ix => STArray s ix elt -> ix -> ST s elt 
+writeSTArray	    :: Ix ix => STArray s ix elt -> ix -> elt -> ST s () 
+boundsSTArray       :: Ix ix => STArray s ix elt -> (ix, ix)  
+thawSTArray 	    :: Ix ix => Array ix elt -> ST s (STArray s ix elt)
+freezeSTArray	    :: Ix ix => STArray s ix elt -> ST s (Array ix elt)
+unsafeFreezeSTArray :: Ix ix => STArray s ix elt -> ST s (Array ix elt)
+
+newSTArray ixs init   	= strictToLazyST (newArray ixs init)
+readSTArray arr ix    	= strictToLazyST (readArray arr ix)
+writeSTArray arr ix v 	= strictToLazyST (writeArray arr ix v)
+boundsSTArray     	= boundsOfArray
+thawSTArray 		= strictToLazyST . thawArray
+freezeSTArray 		= strictToLazyST . freezeArray
+unsafeFreezeSTArray 	= strictToLazyST . unsafeFreezeArray
+
+strictToLazyST :: STBase.ST s a -> ST s a
+strictToLazyST (STBase.ST m) = ST $ \s ->
+        let STBase.S# s# = s in
+	case m s# of { STBase.STret s2# r -> (r, STBase.S# s2#) }
+
+lazyToStrictST :: ST s a -> STBase.ST s a
+lazyToStrictST (ST m) = STBase.ST $ \s ->
+        case (m (STBase.S# s)) of (a, STBase.S# s') -> STBase.STret s' a
+
+
+\end{code}
diff --git a/ghc/lib/glaExts/MutVar.lhs b/ghc/lib/glaExts/MutVar.lhs
deleted file mode 100644
index c0a0f2aed4..0000000000
--- a/ghc/lib/glaExts/MutVar.lhs
+++ /dev/null
@@ -1,44 +0,0 @@
-%
-% (c) The AQUA Project, Glasgow University, 1994-1996
-%
-\section[MutVar]{Mutable variables}
-
-Mutable variables, for the @IO@ monad.
-
-\begin{code}
-module MutVar
-
-       (
-        MutVar,      -- abstract
-
-	newVar,      -- :: a -> IO (MutVar a)
-	readVar,     -- :: MutVar a -> IO a
-	writeVar,    -- :: MutVar a -> a -> IO ()
- 	sameVar      -- :: MutVar a -> MutVar a -> Bool
-
-       ) where
-
-import qualified ST
-import qualified ArrBase
-import IOBase ( IO , stToIO )
-import GHC (RealWorld)
-
-\end{code}
-
-\begin{code}
-
-newtype MutVar a = MutVar (ArrBase.MutableVar RealWorld a)
-
-newVar :: a -> IO (MutVar a)
-newVar v = stToIO (ST.newVar v) >>= \ var -> return (MutVar var)
-
-readVar :: MutVar a -> IO a
-readVar (MutVar var) = stToIO (ST.readVar var)
-
-writeVar :: MutVar a -> a -> IO ()
-writeVar (MutVar var) v = stToIO (ST.writeVar var v)
-
-sameVar :: MutVar a -> MutVar a -> Bool
-sameVar (MutVar var1) (MutVar var2) = ST.sameVar var1 var2
-
-\end{code}
diff --git a/ghc/lib/glaExts/ST.lhs b/ghc/lib/glaExts/ST.lhs
index d25dc83dfb..3e5220fd07 100644
--- a/ghc/lib/glaExts/ST.lhs
+++ b/ghc/lib/glaExts/ST.lhs
@@ -8,35 +8,27 @@
 
 module ST (
 
-	-- ToDo: review this interface; I'm avoiding gratuitous changes for now
-	--			SLPJ Jan 97
-
-
 	ST,
 
+	unsafeInterleaveST,
+
         -- ST is one, so you'll likely need some Monad bits
         module Monad,
 
-	thenST, seqST, returnST, listST, fixST, runST, unsafeInterleaveST,
-        mapST, mapAndUnzipST,
-         -- the lazy variant
-	-- returnLazyST, thenLazyST, seqLazyST,
+	STRef,
+	newSTRef, readSTRef, writeSTRef,
 
-	MutableVar,
-	newVar, readVar, writeVar, sameVar,
-
-	MutableArray,
-	newArray, readArray, writeArray, sameMutableArray
+	STArray,
+	newSTArray, readSTArray, writeSTArray, Ix
 
     ) where
 
-import IOBase	( error )	-- [Source not needed]
 import ArrBase
+import Unsafe   ( unsafeInterleaveST )
 import STBase
-import UnsafeST	( unsafeInterleaveST )
-import PrelBase	( Int, Bool, ($), ()(..) )
-import GHC	( newArray#, readArray#, writeArray#, sameMutableArray#, sameMutableByteArray# )
+import PrelBase	( Eq(..), Int, Bool, ($), ()(..) )
 import Monad
+import Ix
 
 \end{code}
 
@@ -47,39 +39,41 @@ import Monad
 %*********************************************************
 
 \begin{code}
--- in ArrBase: 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# ->
-    case (newArray# 1# init s#)     of { StateAndMutableArray# s2# arr# ->
-    STret s2# (MutableArray vAR_IXS arr#) }
-  where
-    vAR_IXS = error "newVar: Shouldn't access `bounds' of a MutableVar\n"
+newtype STRef s a = STRef (MutableVar s a) deriving Eq
 
-readVar (MutableArray _ var#) = ST $ \ s# ->
-    case readArray# var# 0# s#	of { StateAndPtr# s2# r ->
-    STret s2# r }
+newSTRef :: a -> ST s (STRef s a)
+newSTRef v = newVar v >>= \ var -> return (STRef var)
 
-writeVar (MutableArray _ var#) val = ST $ \ s# ->
-    case writeArray# var# 0# val s# of { s2# ->
-    STret s2# () }
+readSTRef :: STRef s a -> ST s a
+readSTRef (STRef var) = readVar var
 
-sameVar (MutableArray _ var1#) (MutableArray _ var2#)
-  = sameMutableArray# var1# var2#
+writeSTRef :: STRef s a -> a -> ST s ()
+writeSTRef (STRef var) v = writeVar var v
 \end{code}
 
+%*********************************************************
+%*							*
+\subsection{Arrays}
+%*							*
+%*********************************************************
 
 \begin{code}
-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#
+type STArray s ix elt = MutableArray s ix elt
+
+newSTArray 		:: Ix ix => (ix,ix) -> elt -> ST s (STArray s ix elt)
+writeSTArray	  	:: Ix ix => STArray s ix elt -> ix -> elt -> ST s () 
+readSTArray   		:: Ix ix => STArray s ix elt -> ix -> ST s elt 
+boundsSTArray     	:: Ix ix => STArray s ix elt -> (ix, ix)  
+thawSTArray 		:: Ix ix => Array ix elt -> ST s (STArray s ix elt)
+freezeSTArray	  	:: Ix ix => STArray s ix elt -> ST s (Array ix elt)
+unsafeFreezeSTArray 	:: Ix ix => STArray s ix elt -> ST s (Array ix elt)
+
+newSTArray    		= newArray
+boundsSTArray 		= boundsOfArray
+readSTArray   		= readArray
+writeSTArray  		= writeArray
+thawSTArray   		= thawArray
+freezeSTArray 		= freezeArray
+unsafeFreezeSTArray 	= unsafeFreezeArray
 \end{code}
+	
diff --git a/ghc/lib/glaExts/Word.lhs b/ghc/lib/glaExts/Word.lhs
new file mode 100644
index 0000000000..98cef49466
--- /dev/null
+++ b/ghc/lib/glaExts/Word.lhs
@@ -0,0 +1,354 @@
+%
+% (c) The AQUA Project, Glasgow University, 1994-1996
+%
+
+\section[Word]{Module @Word@}
+
+This code is largely copied from the Hugs library of the same name.
+
+\begin{code}
+{-# OPTIONS -fno-implicit-prelude #-}
+
+module Word
+	( Word8
+	, Word16
+	, Word32
+	, Word64
+	, word8ToWord32  -- :: Word8  -> Word32
+	, word32ToWord8  -- :: Word32 -> Word8
+	, word16ToWord32 -- :: Word16 -> Word32
+	, word32ToWord16 -- :: Word32 -> Word16
+	, word8ToInt     -- :: Word8  -> Int
+	, intToWord8     -- :: Int    -> Word8
+	, word16ToInt    -- :: Word16 -> Int
+	, intToWord16    -- :: Int    -> Word16
+	, word32ToInt    -- :: Word32 -> Int
+	, intToWord32    -- :: Int    -> Word32
+	) where
+
+import PrelBase
+import PrelNum
+import PrelRead
+import Ix
+import Error
+import Bits
+import GHC
+
+-----------------------------------------------------------------------------
+-- The "official" coercion functions
+-----------------------------------------------------------------------------
+
+word8ToWord32  :: Word8  -> Word32
+word32ToWord8  :: Word32 -> Word8
+word16ToWord32 :: Word16 -> Word32
+word32ToWord16 :: Word32 -> Word16
+
+word8ToInt   :: Word8  -> Int
+intToWord8   :: Int    -> Word8
+word16ToInt  :: Word16 -> Int
+intToWord16  :: Int    -> Word16
+
+word8ToInt  = word32ToInt    . word8ToWord32
+intToWord8  = word32ToWord8  . intToWord32
+word16ToInt = word32ToInt    . word16ToWord32
+intToWord16 = word32ToWord16 . intToWord32
+
+intToWord32 (I# x)   = W32# (int2Word# x)
+word32ToInt (W32# x) = I#   (word2Int# x)
+
+-----------------------------------------------------------------------------
+-- Word8
+-----------------------------------------------------------------------------
+
+newtype Word8  = W8 Word32
+
+word8ToWord32 (W8 x) = x .&. 0xff
+word32ToWord8 = W8
+
+instance Eq  Word8     where (==)    = binop (==)
+instance Ord Word8     where compare = binop compare
+
+instance Num Word8 where
+    x + y         = to (binop (+) x y)
+    x - y         = to (binop (-) x y)
+    negate        = to . negate . from
+    x * y         = to (binop (*) x y)
+    abs           = absReal
+    signum        = signumReal
+    fromInteger   = to . integer2Word
+    fromInt       = intToWord8
+
+instance Bounded Word8 where
+    minBound = 0
+    maxBound = 0xff
+
+instance Real Word8 where
+    toRational x = toInteger x % 1
+
+instance Integral Word8 where
+    x `div` y     = to  (binop div x y)
+    x `quot` y    = to  (binop quot x y)
+    x `rem` y     = to  (binop rem x y)
+    x `mod` y     = to  (binop mod x y)
+    x `quotRem` y = to2 (binop quotRem x y)
+    divMod        = quotRem
+    toInteger     = toInteger . from
+    toInt         = word8ToInt
+
+instance Ix Word8 where
+    range (m,n)          = [m..n]
+    index b@(m,n) i
+	   | inRange b i = word32ToInt (from (i - m))
+	   | otherwise   = error "index: Index out of range"
+    inRange (m,n) i      = m <= i && i <= n
+
+instance Enum Word8 where
+    toEnum         = to . intToWord32
+    fromEnum       = word32ToInt . from
+    enumFrom c       = map toEnum [fromEnum c .. fromEnum (maxBound::Word8)]
+    enumFromThen c d = map toEnum [fromEnum c, fromEnum d .. fromEnum (last::Word8)]
+		       where last = if d < c then minBound else maxBound
+
+instance Read Word8 where
+    readsPrec p = readDec
+
+instance Show Word8 where
+    showsPrec p = showsPrec p . from
+
+instance Bits Word8 where
+  x .&. y       = to (binop (.&.) x y)
+  x .|. y       = to (binop (.|.) x y)
+  x `xor` y     = to (binop xor x y)
+  complement    = to . complement . from
+  x `shift` i   = to (from x `shift` i)
+--  rotate      
+  bit           = to . bit
+  setBit x i    = to (setBit (from x) i)
+  clearBit x i  = to (clearBit (from x) i)
+  complementBit x i = to (complementBit (from x) i)
+  testBit x i   = testBit (from x) i
+  bitSize  _    = 8
+  isSigned _    = False
+
+-----------------------------------------------------------------------------
+-- Word16
+-----------------------------------------------------------------------------
+
+newtype Word16 = W16 Word32
+
+word16ToWord32 (W16 x) = x .&. 0xffff
+word32ToWord16 = W16
+
+instance Eq  Word16     where (==)    = binop (==)
+instance Ord Word16     where compare = binop compare
+
+instance Num Word16 where
+    x + y         = to (binop (+) x y)
+    x - y         = to (binop (-) x y)
+    negate        = to . negate . from
+    x * y         = to (binop (*) x y)
+    abs           = absReal
+    signum        = signumReal
+    fromInteger   = to . integer2Word
+    fromInt       = intToWord16
+
+instance Bounded Word16 where
+    minBound = 0
+    maxBound = 0xffff
+
+instance Real Word16 where
+  toRational x = toInteger x % 1
+
+instance Integral Word16 where
+  x `div` y     = to  (binop div x y)
+  x `quot` y    = to  (binop quot x y)
+  x `rem` y     = to  (binop rem x y)
+  x `mod` y     = to  (binop mod x y)
+  x `quotRem` y = to2 (binop quotRem x y)
+  divMod        = quotRem
+  toInteger     = toInteger . from
+  toInt         = word16ToInt
+
+instance Ix Word16 where
+  range (m,n)          = [m..n]
+  index b@(m,n) i
+         | inRange b i = word32ToInt (from (i - m))
+         | otherwise   = error "index: Index out of range"
+  inRange (m,n) i      = m <= i && i <= n
+
+instance Enum Word16 where
+  toEnum         = to . intToWord32
+  fromEnum       = word32ToInt . from
+  enumFrom c       = map toEnum [fromEnum c .. fromEnum (maxBound::Word16)]
+  enumFromThen c d = map toEnum [fromEnum c, fromEnum d .. fromEnum (last::Word16)]
+		       where last = if d < c then minBound else maxBound
+
+instance Read Word16 where
+  readsPrec p = readDec
+
+instance Show Word16 where
+  showsPrec p x = showsPrec p (from x)
+
+instance Bits Word16 where
+  x .&. y       = to (binop (.&.) x y)
+  x .|. y       = to (binop (.|.) x y)
+  x `xor` y     = to (binop xor x y)
+  complement    = to . complement . from
+  x `shift` i   = to (from x `shift` i)
+--  rotate      
+  bit           = to . bit
+  setBit x i    = to (setBit (from x) i)
+  clearBit x i  = to (clearBit (from x) i)
+  complementBit x i = to (complementBit (from x) i)
+  testBit x i   = testBit (from x) i
+  bitSize  _    = 16
+  isSigned _    = False
+
+-----------------------------------------------------------------------------
+-- Word32
+-----------------------------------------------------------------------------
+
+data Word32 = W32# Word# deriving (Eq, Ord)
+
+instance Num Word32 where
+    (+) = intop (+)
+    (-) = intop (-)
+    (*) = intop (*)
+    negate (W32# x) = W32# (int2Word# (negateInt# (word2Int# x)))
+    abs             = absReal
+    signum          = signumReal
+    fromInteger     = integer2Word
+    fromInt (I# x)  = W32# (int2Word# x)
+
+{-# INLINE intop #-}
+intop op x y = intToWord32 (word32ToInt x `op` word32ToInt y)
+
+instance Bounded Word32 where
+    minBound = 0
+    maxBound = 0xffffffff
+
+instance Real Word32 where
+    toRational x = toInteger x % 1
+
+instance Integral Word32 where
+    x `div` y   = if x > 0 && y < 0	then quotWord (x-y-1) y
+		  else if x < 0 && y > 0	then quotWord (x-y+1) y
+		  else quotWord x y
+    quot	=  quotWord
+    rem		=  remWord
+    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 = remWord x y
+    a `quotRem` b    = (a `quot` b, a `rem` b)
+    divMod x y       = (x `div` y,  x `mod` y)
+    toInteger (W32# x) = int2Integer# (word2Int# x)
+    toInt     (W32# x) = I# (word2Int# x)
+
+{-# INLINE quotWord #-}
+{-# INLINE remWord  #-}
+(W32# x) `quotWord` (W32# y) = 
+	W32# (int2Word# (word2Int# x `quotInt#` word2Int# y))
+(W32# x) `remWord`  (W32# y) = 
+	W32# (int2Word# (word2Int# x `remInt#`  word2Int# y))
+
+instance Ix Word32 where
+    range (m,n)          = [m..n]
+    index b@(m,n) i
+	   | inRange b i = word32ToInt (i - m)
+	   | otherwise   = error "index: Index out of range"
+    inRange (m,n) i      = m <= i && i <= n
+
+instance Enum Word32 where
+    toEnum        = intToWord32
+    fromEnum      = word32ToInt
+    enumFrom c       = map toEnum [fromEnum c .. fromEnum (maxBound::Word32)]
+    enumFromThen c d = map toEnum [fromEnum c, fromEnum d .. fromEnum (last::Word32)]
+		       where last = if d < c then minBound else maxBound
+
+instance Read Word32 where
+    readsPrec p = readDec
+
+instance Show Word32 where
+    showsPrec p x = showsPrec p (word32ToInt x)
+
+instance Bits Word32 where
+  (.&.)         = wordop and#
+  (.|.)         = wordop or#
+  xor           = wordop xor#
+  complement x  = (x `xor` maxBound) + 1
+  shift (W32# x) i@(I# i#)
+	| i > 0     = W32# (shiftL# x i#)
+	| otherwise = W32# (shiftRL# x (negateInt# i#))
+  --rotate
+  bit i             = 1 `shift` -i
+  setBit x i        = x .|. bit i
+  clearBit x i      = x .&. complement (bit i)
+  complementBit x i = x `xor` bit i
+  testBit x i       = (x .&. bit i) /= 0
+  bitSize  _        = 32
+  isSigned _        = False
+
+{-# INLINE wordop #-}
+wordop op (W32# x) (W32# y) = W32# (x `op` y)
+
+-----------------------------------------------------------------------------
+-- Word64
+-----------------------------------------------------------------------------
+
+data Word64 = W64 {lo,hi::Word32} deriving (Eq, Ord, Bounded)
+
+w64ToInteger W64{lo,hi} = toInteger lo + 0x100000000 * toInteger hi 
+integerToW64 x = case x `quotRem` 0x100000000 of 
+                 (h,l) -> W64{lo=fromInteger l, hi=fromInteger h}
+
+instance Show Word64 where
+  showsPrec p x = showsPrec p (w64ToInteger x)
+
+instance Read Word64 where
+  readsPrec p s = [ (integerToW64 x,r) | (x,r) <- readDec s ]
+
+-----------------------------------------------------------------------------
+-- End of exported definitions
+--
+-- The remainder of this file consists of definitions which are only
+-- used in the implementation.
+-----------------------------------------------------------------------------
+
+-----------------------------------------------------------------------------
+-- Coercions - used to make the instance declarations more uniform
+-----------------------------------------------------------------------------
+
+class Coerce a where
+  to   :: Word32 -> a
+  from :: a -> Word32
+
+instance Coerce Word8 where
+  from = word8ToWord32
+  to   = word32ToWord8
+
+instance Coerce Word16 where
+  from = word16ToWord32
+  to   = word32ToWord16
+
+binop :: Coerce word => (Word32 -> Word32 -> a) -> (word -> word -> a)
+binop op x y = from x `op` from y
+
+to2 :: Coerce word => (Word32, Word32) -> (word, word)
+to2 (x,y) = (to x, to y)
+
+integer2Word (J# a# s# d#) = W32# (int2Word# (integer2Int# a# s# d#))
+
+-----------------------------------------------------------------------------
+-- Code copied from the Prelude
+-----------------------------------------------------------------------------
+
+absReal x    | x >= 0    = x
+	     | otherwise = -x
+
+signumReal x | x == 0    =  0
+	     | x > 0     =  1
+	     | otherwise = -1
+
+\end{code}