diff --git a/Foreign/C/String/Region.hs b/Foreign/C/String/Region.hs --- a/Foreign/C/String/Region.hs +++ b/Foreign/C/String/Region.hs @@ -255,7 +255,7 @@ → (∀ s. RegionalCStringLen (RegionT s pr) → RegionT s pr α) → pr α withCAStringLen str f = withArrayLen (charsToCChars str) - $ \len ptr → f (ptr, len) + $ \len rPtr → f (rPtr, len) -------------------------------------------------------------------------------- @@ -335,7 +335,7 @@ → (∀ s. RegionalCWStringLen (RegionT s pr) → RegionT s pr α) → pr α withCWStringLen str f = withArrayLen (charsToCWchars str) - $ \len ptr → f (ptr, len) + $ \len rPtr → f (rPtr, len) -------------------------------------------------------------------------------- @@ -352,8 +352,8 @@ newArrayLen ∷ (Storable α, MonadCatchIO pr) ⇒ [α] → RegionT s pr (RegionalPtr α (RegionT s pr), Int) newArrayLen xs = do - a <- newArray xs - return (a, length xs) + rPtr ← newArray xs + return (rPtr, length xs) charsToCChars ∷ [Char] → [CChar] charsToCChars = map FCS.castCharToCChar diff --git a/Foreign/Marshal/Alloc/Region.hs b/Foreign/Marshal/Alloc/Region.hs --- a/Foreign/Marshal/Alloc/Region.hs +++ b/Foreign/Marshal/Alloc/Region.hs @@ -58,7 +58,8 @@ import Control.Monad.Trans.Region ( RegionT, runRegionT ) -- from ourselves: -import Foreign.Ptr.Region ( RegionalPtr, regionalPtr ) +import Foreign.Ptr.Region ( RegionalPtr ) +import Foreign.Ptr.Region.Unsafe ( unsafeRegionalPtr ) -------------------------------------------------------------------------------- @@ -121,7 +122,7 @@ → RegionT s pr (RegionalPtr α (RegionT s pr)) mallocBytes size = block $ do ptr ← liftIO $ FMA.mallocBytes size - regionalPtr ptr $ free ptr + unsafeRegionalPtr ptr $ free ptr -- TODO: -- realloc ∷ (Storable β, pr `ParentOf` cr, MonadIO cr) diff --git a/Foreign/Marshal/Array/Region.hs b/Foreign/Marshal/Array/Region.hs --- a/Foreign/Marshal/Array/Region.hs +++ b/Foreign/Marshal/Array/Region.hs @@ -264,7 +264,7 @@ → RegionalPtr α pr2 -- ^ Source → Int -- ^ Number of /elements/ to copy. → cr () -copyArray rp1 rp2 = liftIO ∘ FMA.copyArray (unsafePtr rp1) (unsafePtr rp2) +copyArray rPtr1 rPtr2 = liftIO ∘ FMA.copyArray (unsafePtr rPtr1) (unsafePtr rPtr2) -- | Copy the given number of elements from the second array (source) into the -- first array (destination); the copied areas /may/ overlap. @@ -279,7 +279,7 @@ → RegionalPtr α pr1 -- ^ Source → Int -- ^ Number of /elements/ to move. → cr () -moveArray rp1 rp2 = liftIO ∘ FMA.moveArray (unsafePtr rp1) (unsafePtr rp2) +moveArray rPtr1 rPtr2 = liftIO ∘ FMA.moveArray (unsafePtr rPtr1) (unsafePtr rPtr2) -------------------------------------------------------------------------------- diff --git a/Foreign/Marshal/Utils/Region.hs b/Foreign/Marshal/Utils/Region.hs --- a/Foreign/Marshal/Utils/Region.hs +++ b/Foreign/Marshal/Utils/Region.hs @@ -126,7 +126,7 @@ → RegionalPtr α pr2 -- ^ Source → Int -- ^ Number of bytes to copy → cr () -copyBytes rp1 rp2 = liftIO ∘ FMU.copyBytes (unsafePtr rp1) (unsafePtr rp2) +copyBytes rPtr1 rPtr2 = liftIO ∘ FMU.copyBytes (unsafePtr rPtr1) (unsafePtr rPtr2) -- | Copies the given number of bytes from the second area (source) into the -- first (destination); the copied areas /may/ overlap @@ -140,7 +140,7 @@ → RegionalPtr α pr2 -- ^ Source → Int -- ^ Number of bytes to move → cr () -moveBytes rp1 rp2 = liftIO ∘ FMU.moveBytes (unsafePtr rp1) (unsafePtr rp2) +moveBytes rPtr1 rPtr2 = liftIO ∘ FMU.moveBytes (unsafePtr rPtr1) (unsafePtr rPtr2) -- The End --------------------------------------------------------------------- diff --git a/Foreign/Ptr/Region.hs b/Foreign/Ptr/Region.hs --- a/Foreign/Ptr/Region.hs +++ b/Foreign/Ptr/Region.hs @@ -13,6 +13,8 @@ ( -- * Regional pointers RegionalPtr + , nullPtr + {-| Note that this module re-exports the @Control.Monad.Trans.Region@ module from the @regions@ package which allows you to: @@ -24,10 +26,6 @@ -} , module Control.Monad.Trans.Region - -- * Constructing regional pointers - , regionalPtr - , nullPtr - -- * Pure functions on regional pointers , mapRegionalPtr @@ -43,48 +41,32 @@ -------------------------------------------------------------------------------- -- from base: -import Control.Monad ( return, (>>=), fail ) -import Data.Function ( ($) ) -import Data.Int ( Int ) -import Data.Maybe ( Maybe(Nothing, Just) ) -import Foreign.Ptr ( Ptr ) -import qualified Foreign.Ptr as FP ( nullPtr - , castPtr, plusPtr, alignPtr, minusPtr - ) - --- from transformers: -import Control.Monad.IO.Class ( MonadIO ) +import Data.Int ( Int ) +import Foreign.Ptr ( Ptr ) +import qualified Foreign.Ptr as FP ( nullPtr + , castPtr, plusPtr, alignPtr, minusPtr + ) -- from regions: -import Control.Monad.Trans.Region -- (re-exported entirely) -import Control.Monad.Trans.Region.OnExit ( CloseAction, onExit ) +import Control.Monad.Trans.Region -- (re-exported entirely) -- from ourselves: -import Foreign.Ptr.Region.Internal ( RegionalPtr(RegionalPtr) ) -import Foreign.Ptr.Region.Unsafe ( unsafePtr ) +import Foreign.Ptr.Region.Internal ( RegionalPtr(RegionalPtr) ) +import Foreign.Ptr.Region.Unsafe ( unsafePureRegionalPtr, unsafePtr ) -------------------------------------------------------------------------------- --- * Constructing regional pointers +-- * Regional pointers -------------------------------------------------------------------------------- --- | Construct a regional pointer from a native pointer and an @IO@ computation --- that frees the pointer which is executed when the region exits. -regionalPtr ∷ MonadIO pr - ⇒ Ptr α - → CloseAction - → RegionT s pr (RegionalPtr α (RegionT s pr)) -regionalPtr ptr freePtr = do ch ← onExit freePtr - return $ RegionalPtr ptr $ Just ch - -- | The constant @nullPtr@ contains a distinguished value of 'RegionalPtr' -- that is not associated with a valid memory location. -- -- Note that @nullPtr@ is a pure value. This means it does not perform the --- side-effect of registering a 'CloseAction' like @free nullPtr@ in the --- 'RegionT' monad. +-- side-effect of registering a finalizer like @free nullPtr@ +-- in the 'RegionT' monad. nullPtr ∷ RegionalPtr α r -nullPtr = RegionalPtr FP.nullPtr Nothing +nullPtr = unsafePureRegionalPtr FP.nullPtr -------------------------------------------------------------------------------- @@ -105,7 +87,7 @@ -- -- Wraps: @Foreign.Ptr.@'FP.plusPtr' plusPtr ∷ RegionalPtr α r → Int → RegionalPtr β r -plusPtr rp n = mapRegionalPtr (\p → FP.plusPtr p n) rp +plusPtr rPtr n = mapRegionalPtr (\ptr → FP.plusPtr ptr n) rPtr -- | Given an arbitrary address and an alignment constraint, @alignPtr@ yields -- the next higher address that fulfills the alignment constraint. An alignment @@ -114,7 +96,7 @@ -- -- Wraps: @Foreign.Ptr.@'FP.alignPtr' alignPtr ∷ RegionalPtr α r → Int → RegionalPtr α r -alignPtr rp n = mapRegionalPtr (\p → FP.alignPtr p n) rp +alignPtr rPtr n = mapRegionalPtr (\ptr → FP.alignPtr ptr n) rPtr -- | Computes the offset required to get from the second to the first -- argument. We have @@ -123,7 +105,7 @@ -- -- Wraps: @Foreign.Ptr.@'FP.minusPtr' minusPtr ∷ RegionalPtr α r1 → RegionalPtr β r2 → Int -minusPtr rp1 rp2 = FP.minusPtr (unsafePtr rp1) (unsafePtr rp2) +minusPtr rPtr1 rPtr2 = FP.minusPtr (unsafePtr rPtr1) (unsafePtr rPtr2) -- The End --------------------------------------------------------------------- diff --git a/Foreign/Ptr/Region/Internal.hs b/Foreign/Ptr/Region/Internal.hs --- a/Foreign/Ptr/Region/Internal.hs +++ b/Foreign/Ptr/Region/Internal.hs @@ -16,7 +16,11 @@ ( -- * Regional pointers RegionalPtr(RegionalPtr) - -- * Utility functions for lifting operations on Ptrs to RegionalPtrs + -- * Unsafely constructing regional pointers + , unsafeRegionalPtr + , unsafePureRegionalPtr + + -- * Unsafe utility functions for lifting operations on @Ptrs@ to @RegionalPtrs@ , unsafePtr , unsafeWrap, unsafeWrap2, unsafeWrap3 ) where @@ -37,8 +41,8 @@ import Control.Monad.IO.Class ( MonadIO, liftIO ) -- from regions: -import Control.Monad.Trans.Region.OnExit ( CloseHandle ) -import Control.Monad.Trans.Region ( Dup(dup) ) +import Control.Monad.Trans.Region.OnExit ( CloseHandle, CloseAction, onExit ) +import Control.Monad.Trans.Region ( RegionT, Dup(dup) ) -------------------------------------------------------------------------------- @@ -47,14 +51,40 @@ -- | A regional handle to memory. This should provide a safer replacement for -- @Foreign.Ptr.'Ptr'@ -data RegionalPtr α (r ∷ * → *) = RegionalPtr (Ptr α) (Maybe (CloseHandle r)) +data RegionalPtr α (r ∷ * → *) = RegionalPtr !(Ptr α) !(Maybe (CloseHandle r)) instance Dup (RegionalPtr α) where dup (RegionalPtr ptr Nothing) = return $ RegionalPtr ptr Nothing dup (RegionalPtr ptr (Just ch)) = do ch' ← dup ch return $ RegionalPtr ptr $ Just ch' +-------------------------------------------------------------------------------- +-- * Constructing regional pointers +-------------------------------------------------------------------------------- +-- | Construct a regional pointer from a native pointer +-- and an @IO@ computation that finalizes the pointer (like @free ptr@) +-- which is executed when the region exits. +-- +-- This function is considered unsafe because this library can't guarantee that +-- the finalizer will actually finalize the pointer (suppose having @return ()@ +-- as the finalizer). You have to verify the correct finalisation yourself. +unsafeRegionalPtr ∷ MonadIO pr + ⇒ Ptr α + → CloseAction + → RegionT s pr (RegionalPtr α (RegionT s pr)) +unsafeRegionalPtr ptr finalize = do ch ← onExit finalize + return $ RegionalPtr ptr $ Just ch + +-- | Construct a regional pointer from a native pointer +-- without registering a finalizer like @free ptr@. +-- +-- This function is considered unsafe because this library can't guarantee the +-- finalisation of the pointer, you have to do that yourself. +unsafePureRegionalPtr ∷ Ptr α → RegionalPtr α r +unsafePureRegionalPtr ptr = RegionalPtr ptr Nothing + + -------------------------------------------------------------------------------- -- * Utility functions for lifting operations on Ptrs to RegionalPtrs -------------------------------------------------------------------------------- @@ -65,17 +95,17 @@ unsafeWrap ∷ MonadIO m ⇒ (Ptr α → IO β) → (RegionalPtr α r → m β) -unsafeWrap f rp = liftIO $ f $ unsafePtr rp +unsafeWrap f rPtr = liftIO $ f (unsafePtr rPtr) unsafeWrap2 ∷ MonadIO m ⇒ (Ptr α → γ → IO β) → (RegionalPtr α r → γ → m β) -unsafeWrap2 f rp x = liftIO $ f (unsafePtr rp) x +unsafeWrap2 f rPtr x = liftIO $ f (unsafePtr rPtr) x unsafeWrap3 ∷ MonadIO m ⇒ (Ptr α → γ → δ → IO β) → (RegionalPtr α r → γ → δ → m β) -unsafeWrap3 f rp x y = liftIO $ f (unsafePtr rp) x y +unsafeWrap3 f rPtr x y = liftIO $ f (unsafePtr rPtr) x y -- The End --------------------------------------------------------------------- diff --git a/Foreign/Ptr/Region/Unsafe.hs b/Foreign/Ptr/Region/Unsafe.hs --- a/Foreign/Ptr/Region/Unsafe.hs +++ b/Foreign/Ptr/Region/Unsafe.hs @@ -7,20 +7,30 @@ -- License : BSD3 (see the file LICENSE) -- Maintainer : Bas van Dijk -- --- /Unsafe/ functions for retrieving the actual @Ptr@ from a regional pointer --- and for lifting operations on @Ptrs@ to @RegionalPtrs@. +-- /Unsafe/ functions for constructing regional pointers, retrieving the native +-- @Ptr@ from a regional pointer and for lifting operations on @Ptrs@ to +-- @RegionalPtrs@. -- --- These operations are unsafe because they allow you to @free@ the regional --- pointer before exiting their region. So they enable you to perform @IO@ with --- already freed pointers. -- ------------------------------------------------------------------------------- module Foreign.Ptr.Region.Unsafe - ( unsafePtr + ( -- * Unsafely constructing regional pointers + unsafeRegionalPtr + , unsafePureRegionalPtr + + -- * Unsafe utility functions for lifting operations on @Ptrs@ to @RegionalPtrs@ + + -- | These operations are unsafe because they allow you to @free@ the + -- regional pointer before exiting their region. So they enable you to + -- perform @IO@ with already freed pointers. + , unsafePtr , unsafeWrap, unsafeWrap2, unsafeWrap3 ) where -import Foreign.Ptr.Region.Internal ( unsafePtr +import Foreign.Ptr.Region.Internal ( unsafeRegionalPtr + , unsafePureRegionalPtr + + , unsafePtr , unsafeWrap, unsafeWrap2, unsafeWrap3 ) diff --git a/regional-pointers.cabal b/regional-pointers.cabal --- a/regional-pointers.cabal +++ b/regional-pointers.cabal @@ -1,5 +1,5 @@ name: regional-pointers -version: 0.3 +version: 0.4 cabal-version: >=1.6 build-type: Custom license: BSD3