[project @ 2002-11-19 14:16:43 by simonmar]

[ghc-hetmet.git] / ghc / compiler / utils / Binary.hs

diff --git a/ghc/compiler/utils/Binary.hs b/ghc/compiler/utils/Binary.hs
index b39f7c2..3ac01ea 100644 (file)
--- a/ghc/compiler/utils/Binary.hs
+++ b/ghc/compiler/utils/Binary.hs
@@ -48,6 +48,7 @@ module Binary
 
   ) where
 
+#include "HsVersions.h"
 #include "MachDeps.h"
 
 import {-# SOURCE #-} Module
@@ -55,12 +56,13 @@ import FastString
 import Unique
 import Panic
 import UniqFM
+import FastMutInt
 
 #if __GLASGOW_HASKELL__ < 503
-import IOExts
-import Bits
-import Int
-import Word
+import DATA_IOREF
+import DATA_BITS
+import DATA_INT
+import DATA_WORD
 import Char
 import Monad
 import Exception
@@ -226,8 +228,8 @@ writeBinMem (BinMem _ ix_r sz_r arr_r) fn = do
   arr <- readIORef arr_r
   ix  <- readFastMutInt ix_r
   hPutArray h arr ix
-#if __GLASGOW_HASKELL__ < 500
-  -- workaround a bug in ghc 4.08's implementation of hPutBuf (it doesn't
+#if __GLASGOW_HASKELL__ <= 500
+  -- workaround a bug in old implementation of hPutBuf (it doesn't
   -- set the FILEOBJ_RW_WRITTEN flag on the file object, so the file doens't
   -- get flushed properly).  Adding an extra '\0' doens't do any harm.
   hPutChar h '\0'
@@ -262,7 +264,9 @@ expandBin (BinMem _ ix_r sz_r arr_r) off = do
             | i <- [ 0 .. sz-1 ] ]
    writeFastMutInt sz_r sz'
    writeIORef arr_r arr'
-   hPutStrLn stderr ("expanding to size: " ++ show sz')
+#ifdef DEBUG
+   hPutStrLn stderr ("Binary: expanding to size: " ++ show sz')
+#endif
    return ()
 expandBin (BinIO _ _ _) _ = return ()
        -- no need to expand a file, we'll assume they expand by themselves.
@@ -555,26 +559,6 @@ instance Binary (Bin a) where
   get bh = do i <- get bh; return (BinPtr i)
 
 -- -----------------------------------------------------------------------------
--- unboxed mutable Ints
-
-#ifdef __GLASGOW_HASKELL__
-data FastMutInt = FastMutInt (MutableByteArray# RealWorld)
-
-newFastMutInt = IO $ \s ->
-  case newByteArray# size s of { (# s, arr #) ->
-  (# s, FastMutInt arr #) }
-  where I# size = SIZEOF_HSWORD
-
-readFastMutInt (FastMutInt arr) = IO $ \s ->
-  case readIntArray# arr 0# s of { (# s, i #) ->
-  (# s, I# i #) }
-
-writeFastMutInt (FastMutInt arr) (I# i) = IO $ \s ->
-  case writeIntArray# arr 0# i s of { s ->
-  (# s, () #) }
-#endif
-
--- -----------------------------------------------------------------------------
 -- Lazy reading/writing
 
 lazyPut :: Binary a => BinHandle -> a -> IO ()
@@ -707,4 +691,4 @@ instance Binary FastString where
 
   get bh = do 
        j <- get bh
-       case getUserData bh of (_, _, _, arr) -> return (arr ! j)
+       case getUserData bh of (_, _, _, arr) -> return $! (arr ! j)