diff options
Diffstat (limited to 'compiler/GHC/Utils')
| -rw-r--r-- | compiler/GHC/Utils/Binary.hs | 24 |
1 files changed, 24 insertions, 0 deletions
diff --git a/compiler/GHC/Utils/Binary.hs b/compiler/GHC/Utils/Binary.hs index 15071c1b37..34d7479a47 100644 --- a/compiler/GHC/Utils/Binary.hs +++ b/compiler/GHC/Utils/Binary.hs @@ -34,6 +34,7 @@ module GHC.Utils.Binary SymbolTable, Dictionary, BinData(..), dataHandle, handleData, + packBinBuffer, unpackBinBuffer, openBinMem, -- closeBin, @@ -109,6 +110,8 @@ import System.IO.Error ( mkIOError, eofErrorType ) import GHC.Real ( Ratio(..) ) import Data.IntMap (IntMap) import qualified Data.IntMap as IntMap +import Data.Map (Map) +import qualified Data.Map as M #if MIN_VERSION_base(4,15,0) import GHC.ForeignPtr ( unsafeWithForeignPtr ) #endif @@ -181,6 +184,23 @@ withBinBuffer (BinMem _ ix_r _ arr_r) action = do ix <- readFastMutInt ix_r action $ BS.fromForeignPtr arr 0 ix +packBinBuffer :: BinHandle -> IO ByteString +packBinBuffer bh@(BinMem _ ix_r _ _) = do + l <- readFastMutInt ix_r + here <- tellBin bh + seekBin bh (BinPtr 0) + b <- BS.create l $ \dest -> do + getPrim bh l (\src -> BS.memcpy dest src l) + seekBin bh here + return b + +unpackBinBuffer :: Int -> ByteString -> IO BinHandle +unpackBinBuffer n from = do + bh <- openBinMem n + BS.unsafeUseAsCString from $ \ptr -> do + putPrim bh n (\op -> BS.memcpy op (castPtr ptr) n) + seekBin bh (BinPtr 0) + return bh --------------------------------------------------------------- -- Bin @@ -647,6 +667,10 @@ instance (Binary a, Ord a) => Binary (Set a) where put_ bh s = put_ bh (Set.toList s) get bh = Set.fromList <$> get bh +instance (Ord k, Binary k, Binary v) => Binary (Map k v) where + put_ bh = put_ bh . M.toList + get bh = M.fromList <$> get bh + instance Binary a => Binary (NonEmpty a) where put_ bh = put_ bh . NonEmpty.toList get bh = NonEmpty.fromList <$> get bh |