{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE NoImplicitPrelude, MagicHash, ScopedTypeVariables #-}
module Foreign.Marshal.Array (
mallocArray,
mallocArray0,
allocaArray,
allocaArray0,
reallocArray,
reallocArray0,
callocArray,
callocArray0,
peekArray,
peekArray0,
pokeArray,
pokeArray0,
newArray,
newArray0,
withArray,
withArray0,
withArrayLen,
withArrayLen0,
copyArray,
moveArray,
lengthArray0,
advancePtr,
) where
import Foreign.Ptr (Ptr, plusPtr)
import Foreign.Storable (Storable(alignment,sizeOf,peekElemOff,pokeElemOff))
import Foreign.Marshal.Alloc (mallocBytes, callocBytes, allocaBytesAligned, reallocBytes)
import Foreign.Marshal.Utils (copyBytes, moveBytes)
import GHC.Num
import GHC.List
import GHC.Base
mallocArray :: forall a . Storable a => Int -> IO (Ptr a)
mallocArray :: Int -> IO (Ptr a)
mallocArray size :: Int
size = Int -> IO (Ptr a)
forall a. Int -> IO (Ptr a)
mallocBytes (Int
size Int -> Int -> Int
forall a. Num a => a -> a -> a
* a -> Int
forall a. Storable a => a -> Int
sizeOf (a
forall a. HasCallStack => a
undefined :: a))
mallocArray0 :: Storable a => Int -> IO (Ptr a)
mallocArray0 :: Int -> IO (Ptr a)
mallocArray0 size :: Int
size = Int -> IO (Ptr a)
forall a. Storable a => Int -> IO (Ptr a)
mallocArray (Int
size Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1)
callocArray :: forall a . Storable a => Int -> IO (Ptr a)
callocArray :: Int -> IO (Ptr a)
callocArray size :: Int
size = Int -> IO (Ptr a)
forall a. Int -> IO (Ptr a)
callocBytes (Int
size Int -> Int -> Int
forall a. Num a => a -> a -> a
* a -> Int
forall a. Storable a => a -> Int
sizeOf (a
forall a. HasCallStack => a
undefined :: a))
callocArray0 :: Storable a => Int -> IO (Ptr a)
callocArray0 :: Int -> IO (Ptr a)
callocArray0 size :: Int
size = Int -> IO (Ptr a)
forall a. Storable a => Int -> IO (Ptr a)
callocArray (Int
size Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1)
allocaArray :: forall a b . Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray :: Int -> (Ptr a -> IO b) -> IO b
allocaArray size :: Int
size = Int -> Int -> (Ptr a -> IO b) -> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned (Int
size Int -> Int -> Int
forall a. Num a => a -> a -> a
* a -> Int
forall a. Storable a => a -> Int
sizeOf (a
forall a. HasCallStack => a
undefined :: a))
(a -> Int
forall a. Storable a => a -> Int
alignment (a
forall a. HasCallStack => a
undefined :: a))
allocaArray0 :: Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray0 :: Int -> (Ptr a -> IO b) -> IO b
allocaArray0 size :: Int
size = Int -> (Ptr a -> IO b) -> IO b
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray (Int
size Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1)
{-# INLINE allocaArray0 #-}
reallocArray :: forall a . Storable a => Ptr a -> Int -> IO (Ptr a)
reallocArray :: Ptr a -> Int -> IO (Ptr a)
reallocArray ptr :: Ptr a
ptr size :: Int
size = Ptr a -> Int -> IO (Ptr a)
forall a. Ptr a -> Int -> IO (Ptr a)
reallocBytes Ptr a
ptr (Int
size Int -> Int -> Int
forall a. Num a => a -> a -> a
* a -> Int
forall a. Storable a => a -> Int
sizeOf (a
forall a. HasCallStack => a
undefined :: a))
reallocArray0 :: Storable a => Ptr a -> Int -> IO (Ptr a)
reallocArray0 :: Ptr a -> Int -> IO (Ptr a)
reallocArray0 ptr :: Ptr a
ptr size :: Int
size = Ptr a -> Int -> IO (Ptr a)
forall a. Storable a => Ptr a -> Int -> IO (Ptr a)
reallocArray Ptr a
ptr (Int
size Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1)
peekArray :: Storable a => Int -> Ptr a -> IO [a]
peekArray :: Int -> Ptr a -> IO [a]
peekArray size :: Int
size ptr :: Ptr a
ptr | Int
size Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 0 = [a] -> IO [a]
forall (m :: * -> *) a. Monad m => a -> m a
return []
| Bool
otherwise = Int -> [a] -> IO [a]
f (Int
sizeInt -> Int -> Int
forall a. Num a => a -> a -> a
-1) []
where
f :: Int -> [a] -> IO [a]
f 0 acc :: [a]
acc = do a
e <- Ptr a -> Int -> IO a
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr a
ptr 0; [a] -> IO [a]
forall (m :: * -> *) a. Monad m => a -> m a
return (a
ea -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
acc)
f n :: Int
n acc :: [a]
acc = do a
e <- Ptr a -> Int -> IO a
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr a
ptr Int
n; Int -> [a] -> IO [a]
f (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-1) (a
ea -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
acc)
peekArray0 :: (Storable a, Eq a) => a -> Ptr a -> IO [a]
peekArray0 :: a -> Ptr a -> IO [a]
peekArray0 marker :: a
marker ptr :: Ptr a
ptr = do
Int
size <- a -> Ptr a -> IO Int
forall a. (Storable a, Eq a) => a -> Ptr a -> IO Int
lengthArray0 a
marker Ptr a
ptr
Int -> Ptr a -> IO [a]
forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray Int
size Ptr a
ptr
pokeArray :: Storable a => Ptr a -> [a] -> IO ()
pokeArray :: Ptr a -> [a] -> IO ()
pokeArray ptr :: Ptr a
ptr vals0 :: [a]
vals0 = [a] -> Int# -> IO ()
go [a]
vals0 0#
where go :: [a] -> Int# -> IO ()
go [] _ = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
go (val :: a
val:vals :: [a]
vals) n# :: Int#
n# = do Ptr a -> Int -> a -> IO ()
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr a
ptr (Int# -> Int
I# Int#
n#) a
val; [a] -> Int# -> IO ()
go [a]
vals (Int#
n# Int# -> Int# -> Int#
+# 1#)
pokeArray0 :: Storable a => a -> Ptr a -> [a] -> IO ()
pokeArray0 :: a -> Ptr a -> [a] -> IO ()
pokeArray0 marker :: a
marker ptr :: Ptr a
ptr vals0 :: [a]
vals0 = [a] -> Int# -> IO ()
go [a]
vals0 0#
where go :: [a] -> Int# -> IO ()
go [] n# :: Int#
n# = Ptr a -> Int -> a -> IO ()
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr a
ptr (Int# -> Int
I# Int#
n#) a
marker
go (val :: a
val:vals :: [a]
vals) n# :: Int#
n# = do Ptr a -> Int -> a -> IO ()
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr a
ptr (Int# -> Int
I# Int#
n#) a
val; [a] -> Int# -> IO ()
go [a]
vals (Int#
n# Int# -> Int# -> Int#
+# 1#)
newArray :: Storable a => [a] -> IO (Ptr a)
newArray :: [a] -> IO (Ptr a)
newArray vals :: [a]
vals = do
Ptr a
ptr <- Int -> IO (Ptr a)
forall a. Storable a => Int -> IO (Ptr a)
mallocArray ([a] -> Int
forall a. [a] -> Int
length [a]
vals)
Ptr a -> [a] -> IO ()
forall a. Storable a => Ptr a -> [a] -> IO ()
pokeArray Ptr a
ptr [a]
vals
Ptr a -> IO (Ptr a)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr a
ptr
newArray0 :: Storable a => a -> [a] -> IO (Ptr a)
newArray0 :: a -> [a] -> IO (Ptr a)
newArray0 marker :: a
marker vals :: [a]
vals = do
Ptr a
ptr <- Int -> IO (Ptr a)
forall a. Storable a => Int -> IO (Ptr a)
mallocArray0 ([a] -> Int
forall a. [a] -> Int
length [a]
vals)
a -> Ptr a -> [a] -> IO ()
forall a. Storable a => a -> Ptr a -> [a] -> IO ()
pokeArray0 a
marker Ptr a
ptr [a]
vals
Ptr a -> IO (Ptr a)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr a
ptr
withArray :: Storable a => [a] -> (Ptr a -> IO b) -> IO b
withArray :: [a] -> (Ptr a -> IO b) -> IO b
withArray vals :: [a]
vals = [a] -> (Int -> Ptr a -> IO b) -> IO b
forall a b. Storable a => [a] -> (Int -> Ptr a -> IO b) -> IO b
withArrayLen [a]
vals ((Int -> Ptr a -> IO b) -> IO b)
-> ((Ptr a -> IO b) -> Int -> Ptr a -> IO b)
-> (Ptr a -> IO b)
-> IO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Ptr a -> IO b) -> Int -> Ptr a -> IO b
forall a b. a -> b -> a
const
withArrayLen :: Storable a => [a] -> (Int -> Ptr a -> IO b) -> IO b
withArrayLen :: [a] -> (Int -> Ptr a -> IO b) -> IO b
withArrayLen vals :: [a]
vals f :: Int -> Ptr a -> IO b
f =
Int -> (Ptr a -> IO b) -> IO b
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
len ((Ptr a -> IO b) -> IO b) -> (Ptr a -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr a
ptr -> do
Ptr a -> [a] -> IO ()
forall a. Storable a => Ptr a -> [a] -> IO ()
pokeArray Ptr a
ptr [a]
vals
Int -> Ptr a -> IO b
f Int
len Ptr a
ptr
where
len :: Int
len = [a] -> Int
forall a. [a] -> Int
length [a]
vals
withArray0 :: Storable a => a -> [a] -> (Ptr a -> IO b) -> IO b
withArray0 :: a -> [a] -> (Ptr a -> IO b) -> IO b
withArray0 marker :: a
marker vals :: [a]
vals = a -> [a] -> (Int -> Ptr a -> IO b) -> IO b
forall a b.
Storable a =>
a -> [a] -> (Int -> Ptr a -> IO b) -> IO b
withArrayLen0 a
marker [a]
vals ((Int -> Ptr a -> IO b) -> IO b)
-> ((Ptr a -> IO b) -> Int -> Ptr a -> IO b)
-> (Ptr a -> IO b)
-> IO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Ptr a -> IO b) -> Int -> Ptr a -> IO b
forall a b. a -> b -> a
const
withArrayLen0 :: Storable a => a -> [a] -> (Int -> Ptr a -> IO b) -> IO b
withArrayLen0 :: a -> [a] -> (Int -> Ptr a -> IO b) -> IO b
withArrayLen0 marker :: a
marker vals :: [a]
vals f :: Int -> Ptr a -> IO b
f =
Int -> (Ptr a -> IO b) -> IO b
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray0 Int
len ((Ptr a -> IO b) -> IO b) -> (Ptr a -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr a
ptr -> do
a -> Ptr a -> [a] -> IO ()
forall a. Storable a => a -> Ptr a -> [a] -> IO ()
pokeArray0 a
marker Ptr a
ptr [a]
vals
b
res <- Int -> Ptr a -> IO b
f Int
len Ptr a
ptr
b -> IO b
forall (m :: * -> *) a. Monad m => a -> m a
return b
res
where
len :: Int
len = [a] -> Int
forall a. [a] -> Int
length [a]
vals
copyArray :: forall a . Storable a => Ptr a -> Ptr a -> Int -> IO ()
copyArray :: Ptr a -> Ptr a -> Int -> IO ()
copyArray dest :: Ptr a
dest src :: Ptr a
src size :: Int
size = Ptr a -> Ptr a -> Int -> IO ()
forall a. Ptr a -> Ptr a -> Int -> IO ()
copyBytes Ptr a
dest Ptr a
src (Int
size Int -> Int -> Int
forall a. Num a => a -> a -> a
* a -> Int
forall a. Storable a => a -> Int
sizeOf (a
forall a. HasCallStack => a
undefined :: a))
moveArray :: forall a . Storable a => Ptr a -> Ptr a -> Int -> IO ()
moveArray :: Ptr a -> Ptr a -> Int -> IO ()
moveArray dest :: Ptr a
dest src :: Ptr a
src size :: Int
size = Ptr a -> Ptr a -> Int -> IO ()
forall a. Ptr a -> Ptr a -> Int -> IO ()
moveBytes Ptr a
dest Ptr a
src (Int
size Int -> Int -> Int
forall a. Num a => a -> a -> a
* a -> Int
forall a. Storable a => a -> Int
sizeOf (a
forall a. HasCallStack => a
undefined :: a))
lengthArray0 :: (Storable a, Eq a) => a -> Ptr a -> IO Int
lengthArray0 :: a -> Ptr a -> IO Int
lengthArray0 marker :: a
marker ptr :: Ptr a
ptr = Int -> IO Int
loop 0
where
loop :: Int -> IO Int
loop i :: Int
i = do
a
val <- Ptr a -> Int -> IO a
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr a
ptr Int
i
if a
val a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
marker then Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
i else Int -> IO Int
loop (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+1)
advancePtr :: forall a . Storable a => Ptr a -> Int -> Ptr a
advancePtr :: Ptr a -> Int -> Ptr a
advancePtr ptr :: Ptr a
ptr i :: Int
i = Ptr a
ptr Ptr a -> Int -> Ptr a
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
* a -> Int
forall a. Storable a => a -> Int
sizeOf (a
forall a. HasCallStack => a
undefined :: a))