module Foreign.Marshal.Array.Region
(
mallocArray
, mallocArray0
, allocaArray
, allocaArray0
, peekArray
, peekArray0
, pokeArray
, pokeArray0
, newArray
, newArray0
, withArray
, withArray0
, withArrayLen
, withArrayLen0
, copyArray
, moveArray
, lengthArray0
, advancePtr
) where
import Prelude ( undefined, (*), succ )
import Data.Function ( ($), flip, const )
import Data.Int ( Int )
import Data.List ( length )
import Data.Eq ( Eq )
import Control.Monad ( return, (>>=), fail
, (>>)
)
import System.IO ( IO )
import Foreign.Ptr ( Ptr )
import Foreign.Storable ( Storable, sizeOf )
import qualified Foreign.Marshal.Array as FMA ( peekArray
, peekArray0
, pokeArray
, pokeArray0
, copyArray
, moveArray
, lengthArray0
, advancePtr
)
import Data.Function.Unicode ( (∘) )
import Control.Monad.IO.Class ( MonadIO, liftIO )
import Control.Monad.CatchIO ( MonadCatchIO )
import Control.Monad.Trans.Region ( RegionT , ParentOf )
import Foreign.Ptr.Region ( RegionalPtr, mapRegionalPtr )
import Foreign.Ptr.Region.Unsafe ( unsafePtr, unsafeWrap2 )
import Foreign.Marshal.Alloc.Region ( mallocBytes, allocaBytes )
mallocArray ∷ ∀ α s pr. (Storable α, MonadCatchIO pr)
⇒ Int → RegionT s pr (RegionalPtr α (RegionT s pr))
mallocArray size = mallocBytes $ size * sizeOf (undefined ∷ α)
mallocArray0 ∷ (Storable α, MonadCatchIO pr)
⇒ Int → RegionT s pr (RegionalPtr α (RegionT s pr))
mallocArray0 = mallocArray ∘ succ
allocaArray ∷ ∀ α pr β. (Storable α, MonadCatchIO pr)
⇒ Int
→ (∀ s. RegionalPtr α (RegionT s pr) → RegionT s pr β)
→ pr β
allocaArray size = allocaBytes $ size * sizeOf (undefined ∷ α)
allocaArray0 ∷ ∀ α pr β. (Storable α, MonadCatchIO pr)
⇒ Int
→ (∀ s. RegionalPtr α (RegionT s pr) → RegionT s pr β)
→ pr β
allocaArray0 = allocaArray ∘ succ
unsafeWrap2flp ∷ MonadIO m
⇒ (γ → Ptr α → IO β)
→ (γ → RegionalPtr α r → m β)
unsafeWrap2flp = flip ∘ unsafeWrap2 ∘ flip
peekArray ∷ (Storable α, pr `ParentOf` cr, MonadIO cr)
⇒ Int → RegionalPtr α pr → cr [α]
peekArray = unsafeWrap2flp FMA.peekArray
peekArray0 ∷ (Storable α, Eq α, pr `ParentOf` cr, MonadIO cr)
⇒ α → RegionalPtr α pr → cr [α]
peekArray0 = unsafeWrap2flp FMA.peekArray0
pokeArray ∷ (Storable α, pr `ParentOf` cr, MonadIO cr)
⇒ RegionalPtr α pr → [α] → cr ()
pokeArray = unsafeWrap2 FMA.pokeArray
pokeArray0 ∷ (Storable α, pr `ParentOf` cr, MonadIO cr)
⇒ α → RegionalPtr α pr → [α] → cr ()
pokeArray0 m rp xs = liftIO $ FMA.pokeArray0 m (unsafePtr rp) xs
newArray ∷ (Storable α, MonadCatchIO pr)
⇒ [α] → RegionT s pr (RegionalPtr α (RegionT s pr ))
newArray vals = do
ptr ← mallocArray $ length vals
pokeArray ptr vals
return ptr
newArray0 ∷ (Storable α, MonadCatchIO pr)
⇒ α → [α] → RegionT s pr (RegionalPtr α (RegionT s pr))
newArray0 marker vals = do
ptr ← mallocArray0 $ length vals
pokeArray0 marker ptr vals
return ptr
withArray ∷ (Storable α, MonadCatchIO pr)
⇒ [α]
→ (∀ s. RegionalPtr α (RegionT s pr) → RegionT s pr β)
→ pr β
withArray vals = withArrayLen vals ∘ const
withArray0 ∷ (Storable α, MonadCatchIO pr)
⇒ α
→ [α]
→ (∀ s. RegionalPtr α (RegionT s pr) → RegionT s pr β)
→ pr β
withArray0 marker vals = withArrayLen0 marker vals ∘ const
withArrayLen ∷ (Storable α, MonadCatchIO pr)
⇒ [α]
→ (∀ s. Int → RegionalPtr α (RegionT s pr) → RegionT s pr β)
→ pr β
withArrayLen vals f =
allocaArray len $ \ptr → do
pokeArray ptr vals
res ← f len ptr
return res
where
len = length vals
withArrayLen0 ∷ (Storable α, MonadCatchIO pr)
⇒ α
→ [α]
→ (∀ s. Int → RegionalPtr α (RegionT s pr) → RegionT s pr β)
→ pr β
withArrayLen0 marker vals f =
allocaArray0 len $ \ptr → do
pokeArray0 marker ptr vals
res ← f len ptr
return res
where
len = length vals
copyArray ∷ (Storable α, pr `ParentOf` cr, MonadIO cr)
⇒ RegionalPtr α pr → RegionalPtr α pr → Int → cr ()
copyArray rp1 rp2 = liftIO ∘ FMA.copyArray (unsafePtr rp1) (unsafePtr rp2)
moveArray ∷ (Storable α, pr `ParentOf` cr, MonadIO cr)
⇒ RegionalPtr α pr → RegionalPtr α pr → Int → cr ()
moveArray rp1 rp2 = liftIO ∘ FMA.moveArray (unsafePtr rp1) (unsafePtr rp2)
lengthArray0 ∷ (Storable α, Eq α, pr `ParentOf` cr, MonadIO cr)
⇒ α → RegionalPtr α pr → cr Int
lengthArray0 = unsafeWrap2flp FMA.lengthArray0
advancePtr ∷ Storable α ⇒ RegionalPtr α pr → Int → RegionalPtr α pr
advancePtr rp i = mapRegionalPtr (\p → FMA.advancePtr p i) rp