[project @ 2005-11-24 16:23:48 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 90c7e53..1902ff1 100644 (file)
--- a/ghc/compiler/utils/Binary.hs
+++ b/ghc/compiler/utils/Binary.hs
@@ -56,6 +56,7 @@ import Unique
 import Panic
 import UniqFM
 import FastMutInt
+import PackageConfig           ( PackageId, packageIdFS, fsToPackageId )
 
 #if __GLASGOW_HASKELL__ < 503
 import DATA_IOREF
@@ -457,14 +458,20 @@ instance Binary Int where
 --    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)
+    put_ bh l = do 
+       let len = length l
+       if (len < 0xff) 
+         then putByte bh (fromIntegral len :: Word8)
+         else do putByte bh 0xff; put_ bh (fromIntegral len :: Word32)
+       mapM_ (put_ bh) l
+    get bh = do
+       b <- getByte bh
+       len <- if b == 0xff 
+                 then get bh
+                 else return (fromIntegral b :: Word32)
+       let loop 0 = return []
+           loop n = do a <- get bh; as <- loop (n-1); return (a:as)
+       loop len
 
 instance (Binary a, Binary b) => Binary (a,b) where
     put_ bh (a,b) = do put_ bh a; put_ bh b
@@ -614,7 +621,12 @@ lazyGet bh = do
 -- --------------------------------------------------------------
 
 initBinMemSize       = (1024*1024) :: Int
+
+#if   WORD_SIZE_IN_BITS == 32
 binaryInterfaceMagic = 0x1face :: Word32
+#elif WORD_SIZE_IN_BITS == 64
+binaryInterfaceMagic = 0x1face64 :: Word32
+#endif
 
 getBinFileWithDict :: Binary a => FilePath -> IO a
 getBinFileWithDict file_path = do
@@ -749,6 +761,10 @@ getFS bh = do
   (BA ba) <- getByteArray bh (I# l)
   return $! (mkFastSubStringBA# ba 0# l)
 
+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 ba) =
     case getUserData bh of {