Fetch.hs

{-# 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)
-}