projects
/
ghc-hetmet.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
[project @ 2003-06-24 09:43:23 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
764f918
..
690fb56
100644
(file)
--- a/
ghc/compiler/utils/Binary.hs
+++ b/
ghc/compiler/utils/Binary.hs
@@
-48,6
+48,9
@@
module Binary
) where
) where
+#include "HsVersions.h"
+
+-- The *host* architecture version:
#include "MachDeps.h"
import {-# SOURCE #-} Module
#include "MachDeps.h"
import {-# SOURCE #-} Module
@@
-58,10
+61,10
@@
import UniqFM
import FastMutInt
#if __GLASGOW_HASKELL__ < 503
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
import Char
import Monad
import Exception
@@
-75,6
+78,7
@@
import PrelIOBase ( IOError(..), IOErrorType(..)
)
import PrelReal ( Ratio(..) )
import PrelIOBase ( IO(..) )
)
import PrelReal ( Ratio(..) )
import PrelIOBase ( IO(..) )
+import IOExts ( openFileEx, IOModeEx(..) )
#else
import Data.Array.IO
import Data.Array
#else
import Data.Array.IO
import Data.Array
@@
-85,7
+89,7
@@
import Data.IORef
import Data.Char ( ord, chr )
import Data.Array.Base ( unsafeRead, unsafeWrite )
import Control.Monad ( when )
import Data.Char ( ord, chr )
import Data.Array.Base ( unsafeRead, unsafeWrite )
import Control.Monad ( when )
-import Control.Exception ( throw, throwDyn )
+import Control.Exception ( throwDyn )
import System.IO as IO
import System.IO.Unsafe ( unsafeInterleaveIO )
import System.IO.Error ( mkIOError, eofErrorType )
import System.IO as IO
import System.IO.Unsafe ( unsafeInterleaveIO )
import System.IO.Error ( mkIOError, eofErrorType )
@@
-93,7
+97,17
@@
import GHC.Real ( Ratio(..) )
import GHC.Exts
import GHC.IOBase ( IO(..) )
import GHC.Word ( Word8(..) )
import GHC.Exts
import GHC.IOBase ( IO(..) )
import GHC.Word ( Word8(..) )
+#if __GLASGOW_HASKELL__ < 601
+-- openFileEx is available from the lang package, but we want to
+-- be independent of hslibs libraries.
import GHC.Handle ( openFileEx, IOModeEx(..) )
import GHC.Handle ( openFileEx, IOModeEx(..) )
+#else
+import System.IO ( openBinaryFile )
+#endif
+#endif
+
+#if __GLASGOW_HASKELL__ < 601
+openBinaryFile f mode = openFileEx f (BinaryMode mode)
#endif
#if __GLASGOW_HASKELL__ < 503
#endif
#if __GLASGOW_HASKELL__ < 503
@@
-223,7
+237,7
@@
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
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)
+ h <- openBinaryFile fn WriteMode
arr <- readIORef arr_r
ix <- readFastMutInt ix_r
hPutArray h arr ix
arr <- readIORef arr_r
ix <- readFastMutInt ix_r
hPutArray h arr ix
@@
-237,7
+251,7
@@
writeBinMem (BinMem _ ix_r sz_r arr_r) fn = do
readBinMem :: FilePath -> IO BinHandle
readBinMem filename = do
readBinMem :: FilePath -> IO BinHandle
readBinMem filename = do
- h <- openFileEx filename (BinaryMode ReadMode)
+ h <- openBinaryFile filename ReadMode
filesize' <- hFileSize h
let filesize = fromIntegral filesize'
arr <- newArray_ (0,filesize-1)
filesize' <- hFileSize h
let filesize = fromIntegral filesize'
arr <- newArray_ (0,filesize-1)
@@
-263,7
+277,9
@@
expandBin (BinMem _ ix_r sz_r arr_r) off = do
| i <- [ 0 .. sz-1 ] ]
writeFastMutInt sz_r sz'
writeIORef arr_r arr'
| 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.
return ()
expandBin (BinIO _ _ _) _ = return ()
-- no need to expand a file, we'll assume they expand by themselves.
@@
-294,7
+310,11
@@
getWord8 (BinMem _ ix_r sz_r arr_r) = do
ix <- readFastMutInt ix_r
sz <- readFastMutInt sz_r
when (ix >= sz) $
ix <- readFastMutInt ix_r
sz <- readFastMutInt sz_r
when (ix >= sz) $
+#if __GLASGOW_HASKELL__ <= 408
throw (mkIOError eofErrorType "Data.Binary.getWord8" Nothing Nothing)
throw (mkIOError eofErrorType "Data.Binary.getWord8" Nothing Nothing)
+#else
+ ioError (mkIOError eofErrorType "Data.Binary.getWord8" Nothing Nothing)
+#endif
arr <- readIORef arr_r
w <- unsafeRead arr ix
writeFastMutInt ix_r (ix+1)
arr <- readIORef arr_r
w <- unsafeRead arr ix
writeFastMutInt ix_r (ix+1)
@@
-688,4
+708,4
@@
instance Binary FastString where
get bh = do
j <- get bh
get bh = do
j <- get bh
- case getUserData bh of (_, _, _, arr) -> return (arr ! j)
+ case getUserData bh of (_, _, _, arr) -> return $! (arr ! j)