(original) (raw)

{-# 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 :: forall a. Storable a => Int -> IO (Ptr a) mallocArray 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 :: forall a. Storable a => Int -> IO (Ptr a) mallocArray0 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 + Int 1)

callocArray :: forall a . Storable a => Int -> IO (Ptr a) callocArray :: forall a. Storable a => Int -> IO (Ptr a) callocArray 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 :: forall a. Storable a => Int -> IO (Ptr a) callocArray0 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 + Int 1)

allocaArray :: forall a b . Storable a => Int -> (Ptr a -> IO b) -> IO b allocaArray :: forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b allocaArray 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 :: forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b allocaArray0 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 + Int 1) {-# INLINE allocaArray0 #-}

reallocArray :: forall a . Storable a => Ptr a -> Int -> IO (Ptr a) reallocArray :: forall a. Storable a => Ptr a -> Int -> IO (Ptr a) reallocArray Ptr a ptr 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 :: forall a. Storable a => Ptr a -> Int -> IO (Ptr a) reallocArray0 Ptr a ptr 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 + Int 1)

peekArray :: Storable a => Int -> Ptr a -> IO [a] peekArray :: forall a. Storable a => Int -> Ptr a -> IO [a] peekArray Int size Ptr a ptr | Int size Int -> Int -> Bool forall a. Ord a => a -> a -> Bool <= Int 0 = [a] -> IO [a] forall a. 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 -Int

1. [] where f :: Int -> [a] -> IO [a] f Int 0 [a] acc = do a e <- Ptr a -> Int -> IO a forall a. Storable a => Ptr a -> Int -> IO a peekElemOff Ptr a ptr Int 0; [a] -> IO [a] forall a. a -> IO a forall (m :: * -> *) a. Monad m => a -> m a return (a ea -> [a] -> [a] forall a. a -> [a] -> [a] :[a] acc) f Int n [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 -Int
2. (a ea -> [a] -> [a] forall a. a -> [a] -> [a] :[a] acc)

peekArray0 :: (Storable a, Eq a) => a -> Ptr a -> IO [a] peekArray0 :: forall a. (Storable a, Eq a) => a -> Ptr a -> IO [a] peekArray0 a marker 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 :: forall a. Storable a => Ptr a -> [a] -> IO () pokeArray Ptr a ptr [a] vals0 = [a] -> Int# -> IO () go [a] vals0 Int# 0# where go :: [a] -> Int# -> IO () go [] Int# _ = () -> IO () forall a. a -> IO a forall (m :: * -> *) a. Monad m => a -> m a return () go (a val:[a] vals) 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# +# Int# 1#)

pokeArray0 :: Storable a => a -> Ptr a -> [a] -> IO () pokeArray0 :: forall a. Storable a => a -> Ptr a -> [a] -> IO () pokeArray0 a marker Ptr a ptr [a] vals0 = [a] -> Int# -> IO () go [a] vals0 Int# 0# where go :: [a] -> Int# -> IO () go [] 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 (a val:[a] vals) 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# +# Int# 1#)

newArray :: Storable a => [a] -> IO (Ptr a) newArray :: forall a. Storable a => [a] -> IO (Ptr a) newArray [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 a. a -> IO a forall (m :: * -> *) a. Monad m => a -> m a return Ptr a ptr

newArray0 :: Storable a => a -> [a] -> IO (Ptr a) newArray0 :: forall a. Storable a => a -> [a] -> IO (Ptr a) newArray0 a marker [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 a. a -> IO a forall (m :: * -> *) a. Monad m => a -> m a return Ptr a ptr

withArray :: Storable a => [a] -> (Ptr a -> IO b) -> IO b withArray :: forall a b. Storable a => [a] -> (Ptr a -> IO b) -> IO b withArray [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 :: forall a b. Storable a => [a] -> (Int -> Ptr a -> IO b) -> IO b withArrayLen [a] vals 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 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 :: forall a b. Storable a => a -> [a] -> (Ptr a -> IO b) -> IO b withArray0 a marker [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 :: forall a b. Storable a => a -> [a] -> (Int -> Ptr a -> IO b) -> IO b withArrayLen0 a marker [a] vals 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 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 Int -> Ptr a -> IO b f Int len Ptr a ptr 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 :: forall a. Storable a => Ptr a -> Ptr a -> Int -> IO () copyArray Ptr a dest Ptr a src 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 :: forall a. Storable a => Ptr a -> Ptr a -> Int -> IO () moveArray Ptr a dest Ptr a src 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 :: forall a. (Storable a, Eq a) => a -> Ptr a -> IO Int lengthArray0 a marker Ptr a ptr = Int -> IO Int loop Int 0 where loop :: Int -> IO Int loop 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 a. a -> IO a 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 +Int 1)

advancePtr :: forall a . Storable a => Ptr a -> Int -> Ptr a advancePtr :: forall a. Storable a => Ptr a -> Int -> Ptr a advancePtr Ptr a ptr 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))