1 files changed, 58 insertions, 0 deletions
diff --git a/compiler/utils/Binary.hs b/compiler/utils/Binary.hs
index 503dd31690..61a9dd159e 100644
--- a/compiler/utils/Binary.hs
+++ b/compiler/utils/Binary.hs
@@ -27,6 +27,8 @@ module Binary
     {-type-}  BinHandle,
     SymbolTable, Dictionary,
 
+   BinData(..), dataHandle, handleData,
+
    openBinMem,
 --   closeBin,
 
@@ -74,7 +76,9 @@ import FastMutInt
 import Fingerprint
 import BasicTypes
 import SrcLoc
+import GHC.ForeignSrcLang.Type
 
+import Control.DeepSeq
 import Foreign
 import Data.Array
 import Data.ByteString (ByteString)
@@ -98,6 +102,43 @@ import GHC.Serialized
 type BinArray = ForeignPtr Word8
 
 ---------------------------------------------------------------
+-- BinData
+---------------------------------------------------------------
+
+data BinData = BinData Int BinArray
+
+instance NFData BinData where
+  rnf (BinData sz _) = rnf sz
+
+instance Binary BinData where
+  put_ bh (BinData sz dat) = do
+    put_ bh sz
+    putPrim bh sz $ \dest ->
+      withForeignPtr dat $ \orig ->
+        copyBytes dest orig sz
+  --
+  get bh = do
+    sz <- get bh
+    dat <- mallocForeignPtrBytes sz
+    getPrim bh sz $ \orig ->
+      withForeignPtr dat $ \dest ->
+        copyBytes dest orig sz
+    return (BinData sz dat)
+
+dataHandle :: BinData -> IO BinHandle
+dataHandle (BinData size bin) = do
+  ixr <- newFastMutInt
+  szr <- newFastMutInt
+  writeFastMutInt ixr 0
+  writeFastMutInt szr size
+  binr <- newIORef bin
+  return (BinMem noUserData ixr szr binr)
+
+handleData :: BinHandle -> IO BinData
+handleData (BinMem _ ixr _ binr) = BinData <$> readFastMutInt ixr <*> readIORef binr
+
+
+---------------------------------------------------------------
 -- BinHandle
 ---------------------------------------------------------------
 
@@ -1420,3 +1461,20 @@ instance Binary SourceText where
         s <- get bh
         return (SourceText s)
       _ -> panic $ "Binary SourceText:" ++ show h
+
+instance Binary ForeignSrcLang where
+  put_ bh LangC      = putByte bh 0
+  put_ bh LangCxx    = putByte bh 1
+  put_ bh LangObjc   = putByte bh 2
+  put_ bh LangObjcxx = putByte bh 3
+  put_ bh LangAsm    = putByte bh 4
+  put_ bh RawObject  = putByte bh 5
+  get bh = do
+    i <- getByte bh
+    case i of
+      0 -> return LangC
+      1 -> return LangCxx
+      2 -> return LangObjc
+      3 -> return LangObjcxx
+      4 -> return LangAsm
+      _ -> return RawObject