{-# OPTIONS -fglasgow-exts -fbang-patterns #-} module Data.CompactMap.Fetch where import Data.CompactMap.Types import Data.CompactMap.Buffer import Foreign import GHC.Ptr import qualified Data.ByteString.Internal as B import qualified Data.ByteString.Unsafe as B import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as LBS import Data.Binary --import Data.BinaryLinear sizeOfInt :: Int sizeOfInt = sizeOf (0::Int) {-# INLINE [2] getElement #-} getElement :: (Binary a) => Ptr () -> IO a getElement ptr = do size <- peek (castPtr ptr) :: IO Int extractElement (ptr `plusPtr` (sizeOfInt * 1)) size extractElement :: Binary a => Ptr () -> Int -> IO a extractElement !ptr !size -- = return $! decode (castPtr ptr) = do bs <- B.unsafePackCStringLen (castPtr ptr, size) return $! decode (LBS.fromChunks [bs]) {-# RULES "extractElement/ByteString" extractElement = extractElementBS #-} extractElementBS :: Ptr () -> Int -> IO B.ByteString extractElementBS ptr !size = let n = sizeOf (0::Int) Ptr addr# = ptr `plusPtr` n in B.unsafePackAddressLen (size-n) addr# {- extractRawString :: DiskSet RawString -> Int -> IO RawString extractRawString !(DiskSet {tPosition=pos, tData=dat}) !n = do posPtr <- bufferPtr pos datPtr <- bufferPtr dat (from, size) <- getElemDimensions posPtr n let n = sizeOf (0::Int) return $! RawString (size-n) (castPtr datPtr `plusPtr` (n+from)) -} {- {-# RULES "extractElement/RawString" extractElement = extractElementRaw #-} extractElementRaw :: Ptr () -> Int -> IO RawString extractElementRaw ptr size = let n = sizeOf (0::Int) in return $! RawString (size-n) (castPtr ptr `plusPtr` n) -}