Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
Overlapping instances
class RawStorable a where
storeMemRaw ::
(AllocationContext b z t r, AllocationType t r) =>
a -> b -> t -> IO (Ptr a)
loadMemRaw :: Ptr a -> IO a
instance RawStorable Int where
storeMemRaw el ctx typ = storeMemRaw (WrapStorable el) ctx typ >>= return . castPtr
loadMemRaw ptr = loadMemRaw (castPtr ptr) >>= return . unwrap
instance RawStorable Double where
storeMemRaw el ctx typ = storeMemRaw (WrapStorable el) ctx typ >>= return . castPtr
loadMemRaw ptr = loadMemRaw (castPtr ptr) >>= return . unwrap
instance RawStorable Bool where
storeMemRaw el ctx typ = storeMemRaw (WrapStorable el) ctx typ >>= return . castPtr
loadMemRaw ptr = loadMemRaw (castPtr ptr) >>= return . unwrap
instance {-# OVERLAPPABLE #-} Storable a => RawStorable (WrapStorable a) where
storeMemRaw (WrapStorable el) ctx typ = do
c <- withUpdatingInfo ctx typ $ \info dat -> do
((_, ptr), newInfo) <- newMaybeExternAlloc info $ sizeOf el
let cptr = castPtr ptr
poke (castPtr cptr) el
return (ptr, Just $ newInfo, dat)
return $ castPtr c
loadMemRaw ptr = peek (castPtr ptr) >>= return . WrapStorable
instance {-# OVERLAPPABLE #-} (
RawStorable a
, Traversable t
, Monoid (t a)
, Applicative t) =>
RawStorable (t a) where
storeMemRaw el ctx typ = do
elPtrs <- mapM (\i -> storeMemRaw i ctx typ) el
withUpdatingInfo ctx typ $ \info dat -> do
let len = length elPtrs
ptrSize = sizeOf nullPtr
align x a = case rem x a of
0 -> x
n -> x + (a - n)
headSize = (len + 1) * ptrSize
(head, newInfo) <- newMaybeExternAlloc info headSize
let (_, headPtr) = head
cptr = castPtr headPtr :: Ptr (t a)
end <- foldM (\ptr el -> do
poke ptr el
return $ plusPtr ptr ptrSize) (castPtr cptr) elPtrs
poke end nullPtr
return (cptr, Just newInfo, dat)
loadMemRaw ptr = return mempty
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.