X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Futils%2FBinary.hs;h=6003923c5cb5d6ba171dfc44f8a70147532facb0;hb=96a7900481db325e220667f794eb7499ea64fbc4;hp=e479b791da9d8f62da37289426fe7d6eeb77b481;hpb=046ee54f048ddd721dcee41916d6a6f68db3b15b;p=ghc-hetmet.git

diff --git a/compiler/utils/Binary.hs b/compiler/utils/Binary.hs
index e479b79..6003923 100644
--- a/compiler/utils/Binary.hs
+++ b/compiler/utils/Binary.hs
@@ -1,4 +1,11 @@
 {-# 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
 --
@@ -38,10 +45,12 @@ module Binary
    lazyGet,
    lazyPut,
 
+#ifdef __GLASGOW_HASKELL__
    -- GHC only:
    ByteArray(..),
    getByteArray,
    putByteArray,
+#endif
 
    UserData(..), getUserData, setUserData,
    newReadState, newWriteState,
@@ -59,7 +68,6 @@ import Unique
 import Panic
 import UniqFM
 import FastMutInt
-import PackageConfig
 
 import Foreign
 import Data.Array.IO
@@ -78,7 +86,7 @@ import GHC.Real			( Ratio(..) )
 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(..) )
@@ -86,7 +94,7 @@ 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
 
@@ -202,12 +210,6 @@ 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 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
@@ -272,11 +274,7 @@ getWord8 (BinMem _ ix_r sz_r arr_r) = do
     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)
@@ -461,7 +459,21 @@ instance (Binary a, Binary b) => Binary (Either a b) where
                              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
@@ -481,6 +493,10 @@ instance Binary Integer where
 		  (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# 
@@ -516,23 +532,12 @@ freezeByteArray arr = IO $ \s ->
   (# 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
@@ -681,20 +686,6 @@ getFS bh = do
   --
   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 {