{-# OPTIONS -cpp #-}
+{-# OPTIONS -w #-}
+-- The above warning supression flag is a temporary kludge.
+-- While working on this module you are encouraged to remove it and fix
+-- any warnings in the module. See
+-- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
+-- for details
+
--
-- (c) The University of Glasgow 2002-2006
--
lazyGet,
lazyPut,
+#ifdef __GLASGOW_HASKELL__
-- GHC only:
ByteArray(..),
getByteArray,
putByteArray,
+#endif
UserData(..), getUserData, setUserData,
newReadState, newWriteState,
import Panic
import UniqFM
import FastMutInt
-import PackageConfig
import Foreign
import Data.Array.IO
import GHC.Exts
import GHC.IOBase ( IO(..) )
import GHC.Word ( Word8(..) )
-#if __GLASGOW_HASKELL__ < 601
+#if defined(__GLASGOW_HASKELL__) && __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 System.IO ( openBinaryFile )
#endif
-#if __GLASGOW_HASKELL__ < 601
+#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ < 601
openBinaryFile f mode = openFileEx f (BinaryMode mode)
#endif
arr <- readIORef arr_r
ix <- readFastMutInt ix_r
hPutArray h arr ix
-#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'
-#endif
hClose h
readBinMem :: FilePath -> IO BinHandle
ix <- readFastMutInt ix_r
sz <- readFastMutInt sz_r
when (ix >= sz) $
-#if __GLASGOW_HASKELL__ <= 408
- 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)
0 -> do a <- get bh ; return (Left a)
_ -> do b <- get bh ; return (Right b)
-#ifdef __GLASGOW_HASKELL__
+#if defined(__GLASGOW_HASKELL__) || 1
+--to quote binary-0.3 on this code idea,
+--
+-- TODO This instance is not architecture portable. GMP stores numbers as
+-- arrays of machine sized words, so the byte format is not portable across
+-- architectures with different endianess and word size.
+--
+-- This makes it hard (impossible) to make an equivalent instance
+-- with code that is compilable with non-GHC. Do we need any instance
+-- Binary Integer, and if so, does it have to be blazing fast? Or can
+-- we just change this instance to be portable like the rest of the
+-- instances? (binary package has code to steal for that)
+--
+-- yes, we need Binary Integer and Binary Rational in basicTypes/Literal.lhs
+
instance Binary Integer where
put_ bh (S# i#) = do putByte bh 0; put_ bh (I# i#)
put_ bh (J# s# a#) = do
(BA a#) <- getByteArray bh sz
return (J# s# a#)
+-- As for the rest of this code, even though this module
+-- exports it, it doesn't seem to be used anywhere else
+-- in GHC!
+
putByteArray :: BinHandle -> ByteArray# -> Int# -> IO ()
putByteArray bh a s# = loop 0#
where loop n#
(# s, BA arr #) }
writeByteArray :: MutableByteArray# RealWorld -> Int# -> Word8 -> IO ()
-
-#if __GLASGOW_HASKELL__ < 503
-writeByteArray arr i w8 = IO $ \s ->
- case word8ToWord w8 of { W# w# ->
- case writeCharArray# arr i (chr# (word2Int# w#)) s of { s ->
- (# s , () #) }}
-#else
writeByteArray arr i (W8# w) = IO $ \s ->
case writeWord8Array# arr i w s of { s ->
(# s, () #) }
-#endif
-#if __GLASGOW_HASKELL__ < 503
-indexByteArray a# n# = fromIntegral (I# (ord# (indexCharArray# a# n#)))
-#else
+indexByteArray :: ByteArray# -> Int# -> Word8
indexByteArray a# n# = W8# (indexWord8Array# a# n#)
-#endif
instance (Integral a, Binary a) => Binary (Ratio a) where
put_ bh (a :% b) = do put_ bh a; put_ bh b
--
go 0
-#if __GLASGOW_HASKELL__ < 600
-mallocForeignPtrBytes :: Int -> IO (ForeignPtr a)
-mallocForeignPtrBytes n = do
- r <- mallocBytes n
- newForeignPtr r (finalizerFree r)
-
-foreign import ccall unsafe "stdlib.h free"
- finalizerFree :: Ptr a -> IO ()
-#endif
-
-instance Binary PackageId where
- put_ bh pid = put_ bh (packageIdFS pid)
- get bh = do { fs <- get bh; return (fsToPackageId fs) }
-
instance Binary FastString where
put_ bh f@(FastString id l _ fp _) =
case getUserData bh of {