[haddock @ 2002-06-21 15:50:42 by simonmar]

Add support for reading and writing interface files(!)

This turned out to be quite easy, and necessary to get decent
hyperlinks between the documentation for separate packages in the
libraries.

The functionality isn't quite complete yet: for a given package of
modules, you'd like to say "the HTML for these modules lives in
directory <dir>" (currently they are assumed to be all in the same
place).

Two new flags:

	--dump-interface=FILE   dump an interface file in FILE
	--read-interface=FILE	read interface from FILE

an interface file describes *all* the modules being processed.  Only
the exported names are kept in the interface: if you re-export a name
from a module in another interface the signature won't be copied.
This is a compromise to keep the size of the interfaces sensible.

Also, I added another useful option:

	--no-implicit-prelude

avoids trying to import the Prelude.  Previously this was the default,
but now importing the Prelude from elsewhere makes sense if you also
read in an interface containing the Prelude module, so Haddock imports
the Prelude implicitly according to the Haskell spec.

4 files changed, 724 insertions, 9 deletions

diff --git a/src/Binary.hs b/src/Binary.hs
new file mode 100644
index 00000000..9d1d11af
--- /dev/null
+++ b/src/Binary.hs
@@ -0,0 +1,549 @@
+{-# OPTIONS -cpp #-}
+--
+-- (c) The University of Glasgow 2002
+--
+-- Binary I/O library, with special tweaks for GHC
+--
+-- Based on the nhc98 Binary library, which is copyright
+-- (c) Malcolm Wallace and Colin Runciman, University of York, 1998.
+-- Under the terms of the license for that software, we must tell you
+-- where you can obtain the original version of the Binary library, namely
+--     http://www.cs.york.ac.uk/fp/nhc98/
+
+module Binary
+  ( {-type-}  Bin,
+    {-class-} Binary(..),
+    {-type-}  BinHandle,
+
+   openBinIO, 
+   openBinIO_,
+   openBinMem,
+--   closeBin,
+
+--   getUserData,
+
+   seekBin,
+   tellBin,
+   castBin,
+
+   writeBinMem,
+   readBinMem,
+
+   isEOFBin,
+
+   -- for writing instances:
+   putByte,
+   getByte,
+
+   putString,
+   getString,
+
+   -- lazy Bin I/O
+   lazyGet,
+   lazyPut,
+
+   -- GHC only:
+   ByteArray(..),
+   getByteArray,
+   putByteArray,
+
+--   getBinFileWithDict,	-- :: Binary a => FilePath -> IO a
+--   putBinFileWithDict,	-- :: Binary a => FilePath -> Module -> a -> IO ()
+
+  ) where
+
+#include "MachDeps.h"
+
+import FastMutInt
+
+import IOExts
+import Bits
+import Int
+import Word
+import Char
+import Monad
+import Exception
+import GlaExts hiding (ByteArray, newByteArray, freezeByteArray)
+import Array
+import IO
+import PrelIOBase	--	( IOError(..), IOErrorType(..) )
+import PrelReal		--	( Ratio(..) )
+import PrelIOBase	-- 	( IO(..) )
+import MArray (IOUArray)
+
+type BinArray = MutableByteArray RealWorld Int
+newArray_ bounds     = stToIO (newCharArray bounds)
+unsafeWrite arr ix e = stToIO (writeWord8Array arr ix e)
+unsafeRead  arr ix   = stToIO (readWord8Array arr ix)
+
+hPutArray h arr sz   = hPutBufBAFull h arr sz
+hGetArray h sz       = hGetBufBAFull h sz
+
+mkIOError :: IOErrorType -> String -> Maybe Handle -> Maybe FilePath -> Exception
+mkIOError t location maybe_hdl maybe_filename
+  = IOException (IOError maybe_hdl t location ""
+		         maybe_filename
+  		)
+
+eofErrorType = EOF
+
+#ifndef SIZEOF_HSINT
+#define SIZEOF_HSINT  INT_SIZE_IN_BYTES
+#endif
+
+#ifndef SIZEOF_HSWORD
+#define SIZEOF_HSWORD WORD_SIZE_IN_BYTES
+#endif
+
+--type BinArray = IOUArray Int Word8
+
+data BinHandle
+  = BinMem {		-- binary data stored in an unboxed array
+     state :: Int,	-- sigh, need parameterized modules :-)
+     off_r :: !FastMutInt,		-- the current offset
+     sz_r  :: !FastMutInt,		-- size of the array (cached)
+     arr_r :: !(IORef BinArray) 	-- the array (bounds: (0,size-1))
+    }
+	-- XXX: should really store a "high water mark" for dumping out
+	-- the binary data to a file.
+
+  | BinIO {		-- binary data stored in a file
+     state :: Int,
+     off_r :: !FastMutInt,		-- the current offset (cached)
+     hdl   :: !IO.Handle		-- the file handle (must be seekable)
+   }
+	-- cache the file ptr in BinIO; using hTell is too expensive
+	-- to call repeatedly.  If anyone else is modifying this Handle
+	-- at the same time, we'll be screwed.
+
+newtype Bin a = BinPtr Int 
+  deriving (Eq, Ord, Show, Bounded)
+
+castBin :: Bin a -> Bin b
+castBin (BinPtr i) = BinPtr i
+
+class Binary a where
+    put_   :: BinHandle -> a -> IO ()
+    put    :: BinHandle -> a -> IO (Bin a)
+    get    :: BinHandle -> IO a
+
+    -- define one of put_, put.  Use of put_ is recommended because it
+    -- is more likely that tail-calls can kick in, and we rarely need the
+    -- position return value.
+    put_ bh a = do put bh a; return ()
+    put bh a  = do p <- tellBin bh; put_ bh a; return p
+
+putAt  :: Binary a => BinHandle -> Bin a -> a -> IO ()
+putAt bh p x = do seekBin bh p; put bh x; return ()
+
+getAt  :: Binary a => BinHandle -> Bin a -> IO a
+getAt bh p = do seekBin bh p; get bh
+
+openBinIO_ :: IO.Handle -> IO BinHandle
+openBinIO_ h = openBinIO h
+
+openBinIO :: IO.Handle -> IO BinHandle
+openBinIO h = do
+  r <- newFastMutInt
+  writeFastMutInt r 0
+  return (BinIO undefined r h)
+
+openBinMem :: Int -> IO BinHandle
+openBinMem size
+ | size <= 0 = error "Data.Binary.openBinMem: size must be >= 0"
+ | otherwise = do
+   arr <- newArray_ (0,size-1)
+   arr_r <- newIORef arr
+   ix_r <- newFastMutInt
+   writeFastMutInt ix_r 0
+   sz_r <- newFastMutInt
+   writeFastMutInt sz_r size
+   return (BinMem undefined ix_r sz_r arr_r)
+
+noBinHandleUserData = error "Binary.BinHandle: no user data"
+
+--getUserData :: BinHandle -> BinHandleState
+--getUserData bh = state bh
+
+tellBin :: BinHandle -> IO (Bin a)
+tellBin (BinIO _ r _)   = do ix <- readFastMutInt r; return (BinPtr ix)
+tellBin (BinMem _ r _ _) = do ix <- readFastMutInt r; return (BinPtr ix)
+
+seekBin :: BinHandle -> Bin a -> IO ()
+seekBin (BinIO _ ix_r h) (BinPtr p) = do 
+  writeFastMutInt ix_r p
+  hSeek h AbsoluteSeek (fromIntegral p)
+seekBin h@(BinMem _ ix_r sz_r a) (BinPtr p) = do
+  sz <- readFastMutInt sz_r
+  if (p >= sz)
+	then do expandBin h p; writeFastMutInt ix_r p
+	else writeFastMutInt ix_r p
+
+isEOFBin :: BinHandle -> IO Bool
+isEOFBin (BinMem _ ix_r sz_r a) = do
+  ix <- readFastMutInt ix_r
+  sz <- readFastMutInt sz_r
+  return (ix >= sz)
+isEOFBin (BinIO _ ix_r h) = hIsEOF h
+
+writeBinMem :: BinHandle -> FilePath -> IO ()
+writeBinMem (BinIO _ _ _) _ = error "Data.Binary.writeBinMem: not a memory handle"
+writeBinMem (BinMem _ ix_r sz_r arr_r) fn = do
+  h <- openFileEx fn (BinaryMode WriteMode)
+  arr <- readIORef arr_r
+  ix  <- readFastMutInt ix_r
+  hPutArray h arr ix
+  hClose h
+
+readBinMem :: FilePath -> IO BinHandle
+readBinMem filename = do
+  h <- openFileEx filename (BinaryMode ReadMode)
+  filesize' <- hFileSize h
+  let filesize = fromIntegral filesize'
+  arr <- newArray_ (0,filesize-1)
+  count <- hGetArray h arr filesize
+  when (count /= filesize)
+	(error ("Binary.readBinMem: only read " ++ show count ++ " bytes"))
+  hClose h
+  arr_r <- newIORef arr
+  ix_r <- newFastMutInt
+  writeFastMutInt ix_r 0
+  sz_r <- newFastMutInt
+  writeFastMutInt sz_r filesize
+  return (BinMem undefined {-initReadState-} ix_r sz_r arr_r)
+
+-- expand the size of the array to include a specified offset
+expandBin :: BinHandle -> Int -> IO ()
+expandBin (BinMem _ ix_r sz_r arr_r) off = do
+   sz <- readFastMutInt sz_r
+   let sz' = head (dropWhile (<= off) (iterate (* 2) sz))
+   arr <- readIORef arr_r
+   arr' <- newArray_ (0,sz'-1)
+   sequence_ [ unsafeRead arr i >>= unsafeWrite arr' i
+ 	     | i <- [ 0 .. sz-1 ] ]
+   writeFastMutInt sz_r sz'
+   writeIORef arr_r arr'
+   hPutStrLn stderr ("expanding to size: " ++ show sz')
+   return ()
+expandBin (BinIO _ _ _) _ = return ()
+	-- no need to expand a file, we'll assume they expand by themselves.
+
+-- -----------------------------------------------------------------------------
+-- Low-level reading/writing of bytes
+
+putWord8 :: BinHandle -> Word8 -> IO ()
+putWord8 h@(BinMem _ ix_r sz_r arr_r) w = do
+    ix <- readFastMutInt ix_r
+    sz <- readFastMutInt sz_r
+	-- double the size of the array if it overflows
+    if (ix >= sz) 
+	then do expandBin h ix
+		putWord8 h w
+	else do arr <- readIORef arr_r
+		unsafeWrite arr ix w
+    		writeFastMutInt ix_r (ix+1)
+    		return ()
+putWord8 (BinIO _ ix_r h) w = do
+    ix <- readFastMutInt ix_r
+    hPutChar h (chr (fromIntegral w))	-- XXX not really correct
+    writeFastMutInt ix_r (ix+1)
+    return ()
+
+getWord8 :: BinHandle -> IO Word8
+getWord8 (BinMem _ ix_r sz_r arr_r) = do
+    ix <- readFastMutInt ix_r
+    sz <- readFastMutInt sz_r
+    when (ix >= sz)  $
+	throw (mkIOError eofErrorType "Data.Binary.getWord8" Nothing Nothing)
+    arr <- readIORef arr_r
+    w <- unsafeRead arr ix
+    writeFastMutInt ix_r (ix+1)
+    return w
+getWord8 (BinIO _ ix_r h) = do
+    ix <- readFastMutInt ix_r
+    c <- hGetChar h
+    writeFastMutInt ix_r (ix+1)
+    return $! (fromIntegral (ord c))	-- XXX not really correct
+
+putByte :: BinHandle -> Word8 -> IO ()
+putByte bh w = put_ bh w
+
+getByte :: BinHandle -> IO Word8
+getByte = getWord8
+
+-- -----------------------------------------------------------------------------
+-- Primitve Word writes
+
+instance Binary Word8 where
+  put_ = putWord8
+  get  = getWord8
+
+instance Binary Word16 where
+  put_ h w = do -- XXX too slow.. inline putWord8?
+    putByte h (fromIntegral (w `shiftR` 8))
+    putByte h (fromIntegral (w .&. 0xff))
+  get h = do
+    w1 <- getWord8 h
+    w2 <- getWord8 h
+    return $! ((fromIntegral w1 `shiftL` 8) .|. fromIntegral w2)
+
+
+instance Binary Word32 where
+  put_ h w = do
+    putByte h (fromIntegral (w `shiftR` 24))
+    putByte h (fromIntegral ((w `shiftR` 16) .&. 0xff))
+    putByte h (fromIntegral ((w `shiftR` 8)  .&. 0xff))
+    putByte h (fromIntegral (w .&. 0xff))
+  get h = do
+    w1 <- getWord8 h
+    w2 <- getWord8 h
+    w3 <- getWord8 h
+    w4 <- getWord8 h
+    return $! ((fromIntegral w1 `shiftL` 24) .|. 
+	       (fromIntegral w2 `shiftL` 16) .|. 
+	       (fromIntegral w3 `shiftL`  8) .|. 
+	       (fromIntegral w4))
+
+
+instance Binary Word64 where
+  put_ h w = do
+    putByte h (fromIntegral (w `shiftR` 56))
+    putByte h (fromIntegral ((w `shiftR` 48) .&. 0xff))
+    putByte h (fromIntegral ((w `shiftR` 40) .&. 0xff))
+    putByte h (fromIntegral ((w `shiftR` 32) .&. 0xff))
+    putByte h (fromIntegral ((w `shiftR` 24) .&. 0xff))
+    putByte h (fromIntegral ((w `shiftR` 16) .&. 0xff))
+    putByte h (fromIntegral ((w `shiftR`  8) .&. 0xff))
+    putByte h (fromIntegral (w .&. 0xff))
+  get h = do
+    w1 <- getWord8 h
+    w2 <- getWord8 h
+    w3 <- getWord8 h
+    w4 <- getWord8 h
+    w5 <- getWord8 h
+    w6 <- getWord8 h
+    w7 <- getWord8 h
+    w8 <- getWord8 h
+    return $! ((fromIntegral w1 `shiftL` 56) .|. 
+	       (fromIntegral w2 `shiftL` 48) .|. 
+	       (fromIntegral w3 `shiftL` 40) .|. 
+	       (fromIntegral w4 `shiftL` 32) .|. 
+	       (fromIntegral w5 `shiftL` 24) .|. 
+	       (fromIntegral w6 `shiftL` 16) .|. 
+	       (fromIntegral w7 `shiftL`  8) .|. 
+	       (fromIntegral w8))
+
+-- -----------------------------------------------------------------------------
+-- Primitve Int writes
+
+instance Binary Int8 where
+  put_ h w = put_ h (fromIntegral w :: Word8)
+  get h    = do w <- get h; return $! (fromIntegral (w::Word8))
+
+instance Binary Int16 where
+  put_ h w = put_ h (fromIntegral w :: Word16)
+  get h    = do w <- get h; return $! (fromIntegral (w::Word16))
+
+instance Binary Int32 where
+  put_ h w = put_ h (fromIntegral w :: Word32)
+  get h    = do w <- get h; return $! (fromIntegral (w::Word32))
+
+instance Binary Int64 where
+  put_ h w = put_ h (fromIntegral w :: Word64)
+  get h    = do w <- get h; return $! (fromIntegral (w::Word64))
+
+-- -----------------------------------------------------------------------------
+-- Instances for standard types
+
+instance Binary () where
+    put_ bh () = return ()
+    get  _     = return ()
+--    getF bh p  = case getBitsF bh 0 p of (_,b) -> ((),b)
+
+instance Binary Bool where
+    put_ bh b = putByte bh (fromIntegral (fromEnum b))
+    get  bh   = do x <- getWord8 bh; return $! (toEnum (fromIntegral x))
+--    getF bh p = case getBitsF bh 1 p of (x,b) -> (toEnum x,b)
+
+instance Binary Char where
+    put_  bh c = put_ bh (fromIntegral (ord c) :: Word32)
+    get  bh   = do x <- get bh; return $! (chr (fromIntegral (x :: Word32)))
+--    getF bh p = case getBitsF bh 8 p of (x,b) -> (toEnum x,b)
+
+instance Binary Int where
+#if SIZEOF_HSINT == 4
+    put_ bh i = put_ bh (fromIntegral i :: Int32)
+    get  bh = do
+	x <- get bh
+	return $! (fromIntegral (x :: Int32))
+#elif SIZEOF_HSINT == 8
+    put_ bh i = put_ bh (fromIntegral i :: Int64)
+    get  bh = do
+	x <- get bh
+	return $! (fromIntegral (x :: Int64))
+#else
+#error "unsupported sizeof(HsInt)"
+#endif
+--    getF bh   = getBitsF bh 32
+
+{-
+instance Binary a => Binary [a] where
+    put_ bh []     = putByte bh 0
+    put_ bh (x:xs) = do putByte bh 1; put_ bh x; put_ bh xs
+    get bh         = do h <- getWord8 bh
+                        case h of
+                          0 -> return []
+                          _ -> do x  <- get bh
+                                  xs <- get bh
+                                  return (x:xs)
+-}
+instance Binary a => Binary [a] where
+    put_ bh l =
+	do put_ bh (length l)
+	   mapM (put_ bh) l
+	   return ()
+    get bh =
+	do len <- get bh
+	   mapM (\_ -> get bh) [1..(len::Int)]
+
+instance (Binary a, Binary b) => Binary (a,b) where
+    put_ bh (a,b) = do put_ bh a; put_ bh b
+    get bh        = do a <- get bh
+                       b <- get bh
+                       return (a,b)
+
+instance (Binary a, Binary b, Binary c) => Binary (a,b,c) where
+    put_ bh (a,b,c) = do put_ bh a; put_ bh b; put_ bh c
+    get bh          = do a <- get bh
+                         b <- get bh
+                         c <- get bh
+                         return (a,b,c)
+
+instance (Binary a, Binary b, Binary c, Binary d) => Binary (a,b,c,d) where
+    put_ bh (a,b,c,d) = do put_ bh a; put_ bh b; put_ bh c; put_ bh d
+    get bh          = do a <- get bh
+                         b <- get bh
+                         c <- get bh
+                         d <- get bh
+                         return (a,b,c,d)
+
+instance Binary a => Binary (Maybe a) where
+    put_ bh Nothing  = putByte bh 0
+    put_ bh (Just a) = do putByte bh 1; put_ bh a
+    get bh           = do h <- getWord8 bh
+                          case h of
+                            0 -> return Nothing
+                            _ -> do x <- get bh; return (Just x)
+
+instance (Binary a, Binary b) => Binary (Either a b) where
+    put_ bh (Left  a) = do putByte bh 0; put_ bh a
+    put_ bh (Right b) = do putByte bh 1; put_ bh b
+    get bh            = do h <- getWord8 bh
+                           case h of
+                             0 -> do a <- get bh ; return (Left a)
+                             _ -> do b <- get bh ; return (Right b)
+
+instance Binary Integer where
+    put_ bh (S# i#) = do putByte bh 0; put_ bh (I# i#)
+    put_ bh (J# s# a#) = do
+ 	p <- putByte bh 1;
+	put_ bh (I# s#)
+	let sz# = sizeofByteArray# a#  -- in *bytes*
+	put_ bh (I# sz#)  -- in *bytes*
+	putByteArray bh a# sz#
+   
+    get bh = do 
+	b <- getByte bh
+	case b of
+	  0 -> do (I# i#) <- get bh
+		  return (S# i#)
+	  _ -> do (I# s#) <- get bh
+		  sz <- get bh
+		  (BA a#) <- getByteArray bh sz
+		  return (J# s# a#)
+
+putByteArray :: BinHandle -> ByteArray# -> Int# -> IO ()
+putByteArray bh a s# = loop 0#
+  where loop n# 
+	   | n# ==# s# = return ()
+	   | otherwise = do
+	   	putByte bh (indexByteArray a n#)
+		loop (n# +# 1#)
+
+getByteArray :: BinHandle -> Int -> IO ByteArray
+getByteArray bh (I# sz) = do
+  (MBA arr) <- newByteArray sz 
+  let loop n
+	   | n ==# sz = return ()
+	   | otherwise = do
+		w <- getByte bh 
+		writeByteArray arr n w
+		loop (n +# 1#)
+  loop 0#
+  freezeByteArray arr
+
+
+data ByteArray = BA ByteArray#
+data MBA = MBA (MutableByteArray# RealWorld)
+
+newByteArray :: Int# -> IO MBA
+newByteArray sz = IO $ \s ->
+  case newByteArray# sz s of { (# s, arr #) ->
+  (# s, MBA arr #) }
+
+freezeByteArray :: MutableByteArray# RealWorld -> IO ByteArray
+freezeByteArray arr = IO $ \s ->
+  case unsafeFreezeByteArray# arr s of { (# s, arr #) ->
+  (# s, BA arr #) }
+
+writeByteArray :: MutableByteArray# RealWorld -> Int# -> Word8 -> IO ()
+
+writeByteArray arr i w8 = IO $ \s ->
+  case word8ToWord w8 of { W# w# -> 
+  case writeCharArray# arr i (chr# (word2Int# w#)) s  of { s ->
+  (# s , () #) }}
+
+indexByteArray a# n# = fromIntegral (I# (ord# (indexCharArray# a# n#)))
+
+instance (Integral a, Binary a) => Binary (Ratio a) where
+    put_ bh (a :% b) = do put_ bh a; put_ bh b
+    get bh = do a <- get bh; b <- get bh; return (a :% b)
+
+instance Binary (Bin a) where
+  put_ bh (BinPtr i) = put_ bh i
+  get bh = do i <- get bh; return (BinPtr i)
+
+-- -----------------------------------------------------------------------------
+-- Strings
+
+-- should put a string in UTF-8 (just throws away top 24 bits at the moment)
+putString :: BinHandle -> String -> IO ()
+putString bh str = put_ bh word8s
+ where
+  word8s :: [Word8]
+  word8s = map (fromIntegral.ord) str
+
+getString bh = do
+  word8s <- get bh
+  return (map (chr.fromIntegral) (word8s :: [Word8]))
+
+-- -----------------------------------------------------------------------------
+-- Lazy reading/writing
+
+lazyPut :: Binary a => BinHandle -> a -> IO ()
+lazyPut bh a = do
+	-- output the obj with a ptr to skip over it:
+    pre_a <- tellBin bh
+    put_ bh pre_a	-- save a slot for the ptr
+    put_ bh a		-- dump the object
+    q <- tellBin bh 	-- q = ptr to after object
+    putAt bh pre_a q 	-- fill in slot before a with ptr to q
+    seekBin bh q	-- finally carry on writing at q
+
+lazyGet :: Binary a => BinHandle -> IO a
+lazyGet bh = do
+    p <- get bh		-- a BinPtr
+    p_a <- tellBin bh
+    a <- unsafeInterleaveIO (getAt bh p_a)
+    seekBin bh p -- skip over the object for now
+    return a
diff --git a/src/FastMutInt.hs b/src/FastMutInt.hs
new file mode 100644
index 00000000..6b25e360
--- /dev/null
+++ b/src/FastMutInt.hs
@@ -0,0 +1,58 @@
+{-# OPTIONS -cpp #-}
+--
+-- (c) The University of Glasgow 2002
+--
+-- Unboxed mutable Ints
+
+module FastMutInt(
+	FastMutInt, newFastMutInt,
+	readFastMutInt, writeFastMutInt,
+	incFastMutInt, incFastMutIntBy
+  ) where
+
+#include "MachDeps.h"
+
+#ifndef SIZEOF_HSINT
+#define SIZEOF_HSINT  INT_SIZE_IN_BYTES
+#endif
+
+
+import GlaExts
+import PrelIOBase
+
+#if __GLASGOW_HASKELL__ < 411
+newByteArray# = newCharArray#
+#endif
+
+#ifdef __GLASGOW_HASKELL__
+data FastMutInt = FastMutInt (MutableByteArray# RealWorld)
+
+newFastMutInt :: IO FastMutInt
+newFastMutInt = IO $ \s ->
+  case newByteArray# size s of { (# s, arr #) ->
+  (# s, FastMutInt arr #) }
+  where I# size = SIZEOF_HSINT
+
+readFastMutInt :: FastMutInt -> IO Int
+readFastMutInt (FastMutInt arr) = IO $ \s ->
+  case readIntArray# arr 0# s of { (# s, i #) ->
+  (# s, I# i #) }
+
+writeFastMutInt :: FastMutInt -> Int -> IO ()
+writeFastMutInt (FastMutInt arr) (I# i) = IO $ \s ->
+  case writeIntArray# arr 0# i s of { s ->
+  (# s, () #) }
+
+incFastMutInt :: FastMutInt -> IO Int	-- Returns original value
+incFastMutInt (FastMutInt arr) = IO $ \s ->
+  case readIntArray# arr 0# s of { (# s, i #) ->
+  case writeIntArray# arr 0# (i +# 1#) s of { s ->
+  (# s, I# i #) } }
+
+incFastMutIntBy :: FastMutInt -> Int -> IO Int	-- Returns original value
+incFastMutIntBy (FastMutInt arr) (I# n) = IO $ \s ->
+  case readIntArray# arr 0# s of { (# s, i #) ->
+  case writeIntArray# arr 0# (i +# n) s of { s ->
+  (# s, I# i #) } }
+#endif
+
diff --git a/src/HaddockUtil.hs b/src/HaddockUtil.hs
index b0ad3544..27a83770 100644
--- a/src/HaddockUtil.hs
+++ b/src/HaddockUtil.hs
@@ -26,6 +26,8 @@ import List	( intersect )
 import IO	( hPutStr, stderr )
 import System
 import RegexString
+import Binary
+import IOExts
 
 -- -----------------------------------------------------------------------------
 -- Some Utilities
@@ -220,3 +222,36 @@ mapMaybeM :: Monad m => (a -> m b) -> Maybe a -> m (Maybe b)
 mapMaybeM f Nothing = return Nothing
 mapMaybeM f (Just a) = f a >>= return . Just
 
+-----------------------------------------------------------------------------
+-- Binary instances for stuff
+
+instance Binary Module where
+  put_ bh (Module m) = putString bh m
+  get bh = do m <- getString bh; return $! (Module m)
+
+instance Binary HsQName where
+  put_ bh (Qual m s) = do putByte bh 0; put_ bh m; put_ bh s
+  put_ bh (UnQual s) = do putByte bh 1; put_ bh s
+  get bh = do b <- getByte bh
+	      case b of
+		0 -> do m <- get bh; s <- get bh; return (Qual m s)
+		_ -> do s <- get bh; return (UnQual s)
+
+instance Binary HsName where
+  put_ bh (HsTyClsName s) = do putByte bh 0; put_ bh s
+  put_ bh (HsVarName s)   = do putByte bh 1; put_ bh s
+  get bh = do b <- getByte bh
+	      case b of
+		0 -> do s <- get bh; return (HsTyClsName s)
+		_ -> do s <- get bh; return (HsVarName s)
+
+instance Binary HsIdentifier where
+  put_ bh (HsIdent s)   = do putByte bh 0; putString bh s
+  put_ bh (HsSymbol s)  = do putByte bh 1; putString bh s
+  put_ bh (HsSpecial s) = do putByte bh 2; putString bh s
+  get bh = do b <- getByte bh
+	      case b of
+		0 -> do s <- getString bh; return (HsIdent s)
+		1 -> do s <- getString bh; return (HsSymbol s)
+		_ -> do s <- getString bh; return (HsSpecial s)
+
diff --git a/src/Main.hs b/src/Main.hs
index 3d8c86dc..e6c9576f 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -14,6 +14,7 @@ import HaddockHtml
 import HaddockTypes
 import HaddockUtil
 import Digraph
+import Binary
 
 import HsParser
 import HsParseMonad
@@ -29,7 +30,10 @@ import List	( nub )
 import Monad	( when )
 import Char	( isSpace )
 import IO
+
+#ifdef __GLASGOW_HASKELL__
 import IOExts
+#endif
 
 import MonadWriter
 
@@ -60,6 +64,9 @@ data Flag
   | Flag_CSS String
   | Flag_Lib String
   | Flag_OutputDir FilePath
+  | Flag_ReadInterface FilePath
+  | Flag_DumpInterface FilePath
+  | Flag_NoImplicitPrelude
   deriving (Eq)
 
 options =
@@ -78,10 +85,16 @@ options =
 	"page heading",
     Option ['v']  ["verbose"]  (NoArg Flag_Verbose)
 	"be verbose",
+    Option ['i'] ["read-interface"] (ReqArg Flag_ReadInterface "FILE")
+	"read an interface from FILE",
+    Option []  ["dump-interface"]   (ReqArg Flag_DumpInterface "FILE")
+        "dump an interface for these modules in FILE",
     Option []  ["css"]         (ReqArg Flag_CSS "FILE") 
 	"The CSS file to use for HTML output",
     Option []  ["lib"]         (ReqArg Flag_Lib "DIR") 
-	"Directory containing Haddock's auxiliary files"
+	"Directory containing Haddock's auxiliary files",
+    Option []  ["no-implicit-prelude"] (NoArg Flag_NoImplicitPrelude)
+ 	"Do not assume Prelude is imported"
   ]
 
 saved_flags :: IORef [Flag]
@@ -108,11 +121,24 @@ run flags files = do
 		[] -> return "."
 		fs -> return (last fs)
 
+  let dump_iface = case [str | Flag_DumpInterface str <- flags] of
+		  	[] -> Nothing
+		  	fs -> Just (last fs)
+
+      ifaces_to_read = [str | Flag_ReadInterface str <- flags]
+
+      no_implicit_prelude = Flag_NoImplicitPrelude `elem` flags
+
   prologue <- getPrologue flags
 
   writeIORef saved_flags flags
   parsed_mods <- sequence (map parse_file files)
 
+  read_ifaces_s <- mapM readIface ifaces_to_read  
+
+  let read_ifaces = concat read_ifaces_s
+      external_mods = map fst read_ifaces
+
   sorted_mod_files <- sortModules (zip parsed_mods files)
 	-- emits an error message if there are recursive modules
 
@@ -121,21 +147,59 @@ run flags files = do
   let 
 	loop ifaces [] = return ifaces
 	loop ifaces ((hsmod,file):mods)  = do 
-	   let ((mod,iface),msgs) = runWriter (mkInterface ifaces file hsmod)
+	   let ((mod,iface),msgs) = runWriter $
+		   mkInterface no_implicit_prelude ifaces file hsmod
 	       new_ifaces = addToFM ifaces mod iface
 	   mapM (hPutStrLn stderr) msgs
 	   loop new_ifaces mods
 
-  module_map <- loop emptyFM sorted_mod_files
+  module_map <- loop (listToFM read_ifaces) sorted_mod_files
   let mod_ifaces = fmToList module_map
 
+      these_mod_ifaces = [ (mod, iface) 
+			 | (mod, iface) <- mod_ifaces,
+			   mod `notElem` external_mods ]
+
 --  when (Flag_DocBook `elem` flags) $
 --    putStr (ppDocBook odir mod_ifaces)
 
-  let inst_maps = collectInstances mod_ifaces
+  let inst_maps = collectInstances these_mod_ifaces
 
   when (Flag_Html `elem` flags) $
-    ppHtml title source_url mod_ifaces odir css_file libdir inst_maps prologue
+    ppHtml title source_url these_mod_ifaces odir css_file 
+	libdir inst_maps prologue
+
+  -- dump an interface if requested
+  case dump_iface of
+     Nothing -> return ()
+     Just fn -> do
+	bh <- openBinMem 100000
+	put_ bh prepared_ifaces
+	writeBinMem bh fn
+      where
+	prepared_ifaces = [ (mod, fmToList (iface_env iface))
+		          | (mod, iface) <- these_mod_ifaces ]
+
+readIface :: FilePath -> IO [(Module,Interface)]
+readIface filename = do
+  bh <- readBinMem filename
+  stuff <- get bh
+  return (map to_interface stuff)
+ where 
+   to_interface (mod, env) = 
+	  (mod, Interface { 
+		   iface_filename     = "",
+		   iface_env          = listToFM env,
+		   iface_exports      = [],
+		   iface_orig_exports = [],
+		   iface_insts	      = [],
+		   iface_decls        = emptyFM,
+		   iface_info	      = Nothing,
+		   iface_doc          = Nothing,
+		   iface_options      = []
+		}
+      	  )
+		
 
 parse_file file = do
   bracket 
@@ -163,13 +227,14 @@ getPrologue flags
 -- Figuring out the definitions that are exported from a module
 
 mkInterface
-   :: ModuleMap -> FilePath -> HsModule
+   :: Bool				-- no implicit prelude
+   -> ModuleMap -> FilePath -> HsModule
    -> ErrMsgM (
 	       Module, 		-- the module name
 	       Interface	-- its "interface"
 	      )
 
-mkInterface mod_map filename 
+mkInterface no_implicit_prelude mod_map filename 
 	(HsModule mod exps imps decls maybe_opts maybe_info maybe_doc) = do  
 
   -- Process the options, if available
@@ -191,9 +256,16 @@ mkInterface mod_map filename
 			        zip qual_local_names   qual_local_names)
 	 -- both qualified and unqualifed names are in scope for local things
 
+     implicit_imps
+	| no_implicit_prelude || any is_prel_import imps = imps
+	| otherwise = HsImportDecl loc prelude_mod False Nothing Nothing : imps
+	where 
+		loc = SrcLoc 0 0
+	 	is_prel_import (HsImportDecl _ mod _ _ _ ) = mod == prelude_mod
+
      -- build the orig_env, which maps names to *original* names (so we can
      -- find the original declarations & docs for things).
-     orig_env = buildOrigEnv mod_map imps `plusFM` local_orig_env
+     orig_env = buildOrigEnv mod_map implicit_imps `plusFM` local_orig_env
 
      -- convert names in source code to original, fully qualified, names
      (orig_exports, missing_names1) 
@@ -214,7 +286,8 @@ mkInterface mod_map filename
      -- build the import env, which maps original names to import names
      local_import_env = listToFM (zip qual_local_names qual_local_names)
      import_env = local_import_env `plusFM`
-		   buildImportEnv mod_map mod exported_visible_names imps
+		   buildImportEnv mod_map mod exported_visible_names 
+			implicit_imps
 
   let
      final_decls = concat (map expandDecl orig_decls)