ref: f8732cab62e07dd877cf5573922c3109fe1adb26
parent: 4d3b1c9b28a8995f3f721ffa882d2ee1d594763e
author: Lennart Augustsson <lennart.augustsson@epicgames.com>
date: Sun Dec 17 06:10:47 EST 2023
More storable stuff
--- /dev/null
+++ b/lib/Foreign/Marshal/Array.hs
@@ -1,0 +1,52 @@
+module Foreign.Marshal.Array(module Foreign.Marshal.Array) where
+import Prelude
+import Foreign.Ptr
+import Foreign.Storable
+import Foreign.Marshal.Alloc
+
+mallocArray :: forall a . Storable a => Int -> IO (Ptr a)
+mallocArray size = mallocBytes (size * sizeOf (undefined :: a))
+
+mallocArray0 :: forall a . Storable a => Int -> IO (Ptr a)
+mallocArray0 size = mallocArray (size + 1)
+
+callocArray :: forall a . Storable a => Int -> IO (Ptr a)
+callocArray size = callocBytes (size * sizeOf (undefined :: a))
+
+callocArray0 :: forall a . Storable a => Int -> IO (Ptr a)
+callocArray0 size = callocArray (size + 1)
+
+peekArray :: forall a . Storable a => Int -> Ptr a -> IO [a]
+peekArray size ptr | size <= 0 = return []
+ | otherwise = f (size-1) []
+ where
+ f 0 acc = do e <- peekElemOff ptr 0; return (e:acc)
+ f n acc = do e <- peekElemOff ptr n; f (n-1) (e:acc)
+
+peekArray0 :: forall a . (Storable a, Eq a) => a -> Ptr a -> IO [a]
+peekArray0 marker ptr = do
+ size <- lengthArray0 marker ptr
+ peekArray size ptr
+
+pokeArray :: forall a . Storable a => Ptr a -> [a] -> IO ()
+pokeArray ptr vals0 = go vals0 0
+ where go [] _ = return ()
+ go (val:vals) n = do { pokeElemOff ptr n val; go vals (n + 1) }+
+pokeArray0 :: forall a . Storable a => a -> Ptr a -> [a] -> IO ()
+pokeArray0 marker ptr vals0 = go vals0 0
+ where go [] n = pokeElemOff ptr n marker
+ go (val:vals) n = do { pokeElemOff ptr n val; go vals (n + 1) }+
+newArray0 :: forall a . Storable a => a -> [a] -> IO (Ptr a)
+newArray0 marker vals = do
+ ptr <- mallocArray0 (length vals)
+ pokeArray0 marker ptr vals
+ return ptr
+
+lengthArray0 :: forall a . (Storable a, Eq a) => a -> Ptr a -> IO Int
+lengthArray0 marker ptr = loop 0
+ where
+ loop i = do
+ val <- peekElemOff ptr i
+ if val == marker then return i else loop (i+1)
--- a/lib/Foreign/Storable.hs
+++ b/lib/Foreign/Storable.hs
@@ -22,11 +22,22 @@
peek ptr = peekElemOff ptr 0
poke ptr = pokeElemOff ptr 0
-foreign import ccall "wordPeek" c_wordPeek :: Ptr Word -> IO Word
-foreign import ccall "wordPoke" c_wordPoke :: Ptr Word -> Word -> IO ()
+foreign import ccall "peekWord" c_peekWord :: Ptr Word -> IO Word
+foreign import ccall "pokeWord" c_pokeWord :: Ptr Word -> Word -> IO ()
instance Storable Word where
sizeOf _ = _wordSize
alignment _ = _wordSize
- peek p = c_wordPeek p
- poke p w = c_wordPoke p w
+ peek p = c_peekWord p
+ poke p w = c_pokeWord p w
+
+foreign import ccall "peekPtr" c_peekPtr :: forall a . Ptr (Ptr a) -> IO (Ptr a)
+foreign import ccall "pokePtr" c_pokePtr :: forall a . Ptr (Ptr a) -> Ptr a -> IO ()
+
+instance forall a . Storable (Ptr a) where
+ sizeOf _ = _wordSize
+ alignment _ = _wordSize
+ peek p = c_peekPtr p
+ poke p w = c_pokePtr p w
+
+
--
⑨