regional-pointers 0.1.0.2 → 0.2
raw patch · 10 files changed
+400/−132 lines, 10 filesdep ~regions
Dependency ranges changed: regions
Files
- Foreign/C/String/Region.hs +111/−6
- Foreign/Marshal/Alloc/Region.hs +24/−20
- Foreign/Marshal/Array/Region.hs +89/−25
- Foreign/Marshal/Utils/Region.hs +33/−3
- Foreign/Ptr/Region.hs +69/−17
- Foreign/Ptr/Region/Internal.hs +21/−48
- Foreign/Ptr/Region/Unsafe.hs +6/−2
- Foreign/Storable/Region.hs +44/−6
- LICENSE +1/−1
- regional-pointers.cabal +2/−4
Foreign/C/String/Region.hs view
@@ -67,6 +67,14 @@ import Foreign.C.String ( CString, CStringLen , CWString, CWStringLen )+import qualified Foreign.C.String as FCS ( peekCString, peekCStringLen+ , newCString, newCStringLen+ , withCString, withCStringLen+ , newCAString, newCAStringLen+ , withCAString, withCAStringLen+ , newCWString, newCWStringLen+ , withCWString, withCWStringLen+ ) #endif #ifdef mingw32_HOST_OS@@ -99,14 +107,14 @@ ----------------------------------------------------------------------------------- Regional C Strings+-- * Regional C Strings -------------------------------------------------------------------------------- -- | Handy type synonym for a regional pointer to an array of C characters -- terminated by a NUL. -- -- This should provide a safer replacement for @Foreign.C.String.'CString'@.-type RegionalCString r = RegionalPtr CChar r+type RegionalCString r = RegionalPtr CChar r -- | Handy type synonym for a regional pointer to an array of C characters which -- is paired with the length of the array instead of terminated by a NUL.@@ -117,67 +125,131 @@ ----------------------------------------------------------------------------------- Using a locale-dependent encoding+-- * Using a locale-dependent encoding -------------------------------------------------------------------------------- +-- | Marshal a NUL terminated C string into a Haskell string.+--+-- Wraps: @Foreign.C.String.'FCS.peekCString'@ peekCString ∷ (pr `ParentOf` cr, MonadIO cr) ⇒ RegionalCString pr → cr String peekCString = peekCAString +-- | Marshal a C string with explicit length into a Haskell string.+--+-- Wraps: @Foreign.C.String.'FCS.peekCStringLen'@. peekCStringLen ∷ (pr `ParentOf` cr, MonadIO cr) ⇒ RegionalCStringLen pr → cr String peekCStringLen = peekCAStringLen +-- | Marshal a Haskell string into a NUL terminated C string.+--+-- The Haskell string may /not/ contain any NUL characters+--+-- Wraps: @Foreign.C.String.'FCS.newCString'@. newCString ∷ MonadCatchIO pr ⇒ String → RegionT s pr (RegionalCString (RegionT s pr)) newCString = newCAString +-- | Marshal a Haskell string into a C string (ie, character array) with+-- explicit length information.+--+-- Wraps: @Foreign.C.String.'FCS.newCStringLen'@. newCStringLen ∷ MonadCatchIO pr ⇒ String → RegionT s pr (RegionalCStringLen (RegionT s pr)) newCStringLen = newCAStringLen +-- | Marshal a Haskell string into a NUL terminated C string using temporary+-- storage.+--+-- * the Haskell string may /not/ contain any NUL characters+--+-- * the memory is freed when the subcomputation terminates (either normally or+-- via an exception).+--+-- Wraps: @Foreign.C.String.'FCS.withCString'@. withCString ∷ MonadCatchIO pr ⇒ String → (∀ s. RegionalCString (RegionT s pr) → RegionT s pr α) → pr α withCString = withCAString +-- | Marshal a Haskell string into a C string (ie, character array) in temporary+-- storage, with explicit length information.+--+-- * the memory is freed when the subcomputation terminates (either normally or+-- via an exception).+--+-- Wraps: @Foreign.C.String.'FCS.withCStringLen'@. withCStringLen ∷ MonadCatchIO pr ⇒ String → (∀ s. RegionalCStringLen (RegionT s pr) → RegionT s pr α) → pr α withCStringLen = withCAStringLen +-- | Generalizes @Foreign.C.String.'FCS.charIsRepresentable'@ to any+-- 'MonadIO'. charIsRepresentable ∷ MonadIO m ⇒ Char → m Bool charIsRepresentable = liftIO ∘ FCS.charIsRepresentable ----------------------------------------------------------------------------------- Using 8-bit characters+-- * Using 8-bit characters -------------------------------------------------------------------------------- +-- | Marshal a NUL terminated C string into a Haskell string.+--+-- Wraps: @Foreign.C.String.'FCS.peekCAString'@. peekCAString ∷ (pr `ParentOf` cr, MonadIO cr) ⇒ RegionalCString pr → cr String peekCAString = unsafeWrap FCS.peekCAString +-- | Marshal a C string with explicit length into a Haskell string.+--+-- Wraps: @Foreign.C.String.'FCS.peekCAStringLen'@. peekCAStringLen ∷ (pr `ParentOf` cr, MonadIO cr) ⇒ RegionalCStringLen pr → cr String peekCAStringLen = liftIO ∘ FCS.peekCAStringLen ∘ first unsafePtr +-- | Marshal a Haskell string into a NUL terminated C string.+--+-- The Haskell string may /not/ contain any NUL characters+--+-- Wraps: @Foreign.C.String.'FCS.newCAString'@. newCAString ∷ MonadCatchIO pr ⇒ String → RegionT s pr (RegionalCString (RegionT s pr)) newCAString = newArray0 nUL ∘ charsToCChars +-- | Marshal a Haskell string into a C string (ie, character array) with+-- explicit length information.+--+-- Wraps: @Foreign.C.String.'FCS.newCAStringLen'@. newCAStringLen ∷ MonadCatchIO pr ⇒ String → RegionT s pr (RegionalCStringLen (RegionT s pr)) newCAStringLen = newArrayLen ∘ charsToCChars +-- | Marshal a Haskell string into a NUL terminated C string using temporary+-- storage.+--+-- * the Haskell string may /not/ contain any NUL characters+--+-- * the memory is freed when the subcomputation terminates (either normally or+-- via an exception).+--+-- Wraps: @Foreign.C.String.'FCS.withCAString'@. withCAString ∷ MonadCatchIO pr ⇒ String → (∀ s. RegionalCString (RegionT s pr) → RegionT s pr α) → pr α withCAString = withArray0 nUL ∘ charsToCChars +-- | Marshal a Haskell string into a C string (ie, character array) in temporary+-- storage, with explicit length information.+--+-- * the memory is freed when the subcomputation terminates (either normally or+-- via an exception).+--+-- Wraps: @Foreign.C.String.'FCS.withCAStringLen'@. withCAStringLen ∷ MonadCatchIO pr ⇒ String → (∀ s. RegionalCStringLen (RegionT s pr) → RegionT s pr α)@@ -187,7 +259,7 @@ ----------------------------------------------------------------------------------- C wide strings+-- * C wide strings -------------------------------------------------------------------------------- -- | Handy type synonym for a regional pointer to an array of C wide characters@@ -203,28 +275,61 @@ -- This should provide a safer replacement for @Foreign.C.String.'CWStringLen'@. type RegionalCWStringLen r = (RegionalPtr CWchar r, Int) +-- | Marshal a NUL terminated C wide string into a Haskell string.+--+-- Wraps: @Foreign.C.String.'FCS.peekCWString'@. peekCWString ∷ (pr `ParentOf` cr, MonadIO cr) ⇒ RegionalCWString pr → cr String peekCWString = unsafeWrap FCS.peekCWString +-- | Marshal a C wide string with explicit length into a Haskell string.+--+-- Wraps: @Foreign.C.String.'FCS.peekCWStringLen'@. peekCWStringLen ∷ (pr `ParentOf` cr, MonadIO cr) ⇒ RegionalCWStringLen pr → cr String peekCWStringLen = liftIO ∘ FCS.peekCWStringLen ∘ first unsafePtr +-- | Marshal a Haskell string into a NUL terminated C wide string.+--+-- The Haskell string may /not/ contain any NUL characters.+--+-- Wraps: @Foreign.C.String.'FCS.newCWString'@. newCWString ∷ MonadCatchIO pr ⇒ String → RegionT s pr (RegionalCWString (RegionT s pr)) newCWString = newArray0 wNUL ∘ charsToCWchars +-- | Marshal a Haskell string into a C wide string (ie, wide character array)+-- with explicit length information.+--+-- Wraps: @Foreign.C.String.'FCS.newCWStringLen'@. newCWStringLen ∷ MonadCatchIO pr ⇒ String → RegionT s pr (RegionalCWStringLen (RegionT s pr)) newCWStringLen = newArrayLen ∘ charsToCWchars +-- | Marshal a Haskell string into a NUL terminated C wide string using+-- temporary storage.+--+-- * the Haskell string may /not/ contain any NUL characters+--+-- * the memory is freed when the subcomputation terminates (either+-- normally or via an exception).+--+-- Wraps: @Foreign.C.String.'FCS.withCWString'@. withCWString ∷ MonadCatchIO pr ⇒ String → (∀ s. RegionalCWString (RegionT s pr) → RegionT s pr α) → pr α withCWString = withArray0 wNUL ∘ charsToCWchars +-- | Marshal a Haskell string into a NUL terminated C wide string using+-- temporary storage.+--+-- * the Haskell string may /not/ contain any NUL characters.+--+-- * the memory is freed when the subcomputation terminates (either+-- normally or via an exception).+--+-- Wraps: @Foreign.C.String.'FCS.withCWStringLen'@. withCWStringLen ∷ MonadCatchIO pr ⇒ String → (∀ s. RegionalCWStringLen (RegionT s pr) → RegionT s pr α)@@ -234,7 +339,7 @@ ----------------------------------------------------------------------------------- Utility functions+-- * Utility functions -------------------------------------------------------------------------------- nUL ∷ CChar
Foreign/Marshal/Alloc/Region.hs view
@@ -32,28 +32,33 @@ -------------------------------------------------------------------------------- -- from base:-import Prelude ( undefined )-import Data.Function ( ($) )-import Data.Int ( Int )-import Foreign.Storable ( Storable, sizeOf )+import Control.Monad ( (>>=), fail )+import Data.Function ( ($) )+import Data.Int ( Int )+import Foreign.Storable ( Storable, sizeOf ) +import Foreign.Marshal.Alloc ( free )++import qualified Foreign.Marshal.Alloc as FMA ( mallocBytes )+ #ifdef __HADDOCK__-import qualified Foreign.Marshal.Alloc as FMA ( alloca, allocaBytes- , malloc, mallocBytes- )+import qualified Foreign.Marshal.Alloc as FMA ( alloca, allocaBytes, malloc ) #endif -- from base-unicode-symbols:-import Data.Function.Unicode ( (∘) )+import Prelude.Unicode ( (⊥) ) +-- from transformers:+import Control.Monad.IO.Class ( liftIO )+ -- from MonadCatchIO-transformers:-import Control.Monad.CatchIO ( MonadCatchIO )+import Control.Monad.CatchIO ( MonadCatchIO, block ) -- from regions:-import Control.Monad.Trans.Region ( RegionT, open, with )+import Control.Monad.Trans.Region ( RegionT, runRegionT ) -- from ourselves:-import Foreign.Ptr.Region ( Memory(Memory), RegionalPtr )+import Foreign.Ptr.Region ( RegionalPtr, regionalPtr ) --------------------------------------------------------------------------------@@ -72,7 +77,7 @@ alloca ∷ ∀ α pr β. (Storable α, MonadCatchIO pr) ⇒ (∀ s. RegionalPtr α (RegionT s pr) → RegionT s pr β) → pr β-alloca = allocaBytes $ sizeOf (undefined ∷ α)+alloca = allocaBytes $ sizeOf ((⊥) ∷ α) {-| Convenience function which allocates the given number of bytes, applies the given continuation function to the resulting regional pointer and runs the@@ -81,13 +86,13 @@ This should provide a safer replacement for: @Foreign.Marshal.Alloc.'FMA.allocaBytes'@. -Note that: @allocaBytes = 'with' . 'Memory'@+Note that: @allocaBytes size f = 'runRegionT' $ 'mallocBytes' size >>= f@ -} allocaBytes ∷ ∀ α pr β. MonadCatchIO pr ⇒ Int → (∀ s. RegionalPtr α (RegionT s pr) → RegionT s pr β) → pr β-allocaBytes = with ∘ Memory+allocaBytes size f = runRegionT $ mallocBytes size >>= f --------------------------------------------------------------------------------@@ -104,20 +109,19 @@ -} malloc ∷ ∀ α pr s. (Storable α, MonadCatchIO pr) ⇒ RegionT s pr (RegionalPtr α (RegionT s pr))-malloc = mallocBytes $ sizeOf (undefined ∷ α)+malloc = mallocBytes $ sizeOf ((⊥) ∷ α) -{-| Convenience function which allocates the given number of bytes and returns a-regional pointer to them.+{-| Allocates the given number of bytes and returns a regional pointer to them. This should provide a safer replacement for: @Foreign.Marshal.Alloc.'FMA.mallocBytes'@.--Note that: @mallocBytes = 'open' . 'Memory'@ -} mallocBytes ∷ MonadCatchIO pr ⇒ Int → RegionT s pr (RegionalPtr α (RegionT s pr))-mallocBytes = open ∘ Memory+mallocBytes size = block $ do+ ptr ← liftIO $ FMA.mallocBytes size+ regionalPtr ptr $ free ptr -- TODO: -- realloc ∷ (Storable β, pr `ParentOf` cr, MonadIO cr)
Foreign/Marshal/Array/Region.hs view
@@ -1,5 +1,6 @@ {-# LANGUAGE UnicodeSyntax , NoImplicitPrelude+ , CPP , RankNTypes , ScopedTypeVariables #-}@@ -53,14 +54,12 @@ -------------------------------------------------------------------------------- -- from base:-import Prelude ( undefined, (*), succ )+import Prelude ( (*), succ ) import Data.Function ( ($), flip, const ) import Data.Int ( Int ) import Data.List ( length ) import Data.Eq ( Eq )-import Control.Monad ( return, (>>=), fail- , (>>)- )+import Control.Monad ( return, (>>=), fail, (>>) ) import System.IO ( IO ) import Foreign.Ptr ( Ptr ) import Foreign.Storable ( Storable, sizeOf )@@ -75,6 +74,7 @@ ) -- from base-unicode-symbols: import Data.Function.Unicode ( (∘) )+import Prelude.Unicode ( (⊥) ) -- from transformers: import Control.Monad.IO.Class ( MonadIO, liftIO )@@ -90,25 +90,39 @@ import Foreign.Ptr.Region.Unsafe ( unsafePtr, unsafeWrap2 ) import Foreign.Marshal.Alloc.Region ( mallocBytes, allocaBytes ) +#ifdef __HADDOCK__+import Foreign.Marshal.Alloc.Region ( malloc, alloca )+import Foreign.Marshal.Utils.Region ( new, with )+#endif + ----------------------------------------------------------------------------------- Allocation+-- * Allocation -------------------------------------------------------------------------------- +-- | Allocate storage for the given number of elements of a storable type.+--+-- Like 'malloc', but for multiple elements. mallocArray ∷ ∀ α s pr. (Storable α, MonadCatchIO pr) ⇒ Int → RegionT s pr (RegionalPtr α (RegionT s pr))-mallocArray size = mallocBytes $ size * sizeOf (undefined ∷ α)+mallocArray size = mallocBytes $ size * sizeOf ((⊥) ∷ α) +-- | Like 'mallocArray', but add an extra position to hold a special termination+-- element. mallocArray0 ∷ (Storable α, MonadCatchIO pr) ⇒ Int → RegionT s pr (RegionalPtr α (RegionT s pr)) mallocArray0 = mallocArray ∘ succ +-- | Temporarily allocate space for the given number of elements (like 'alloca',+-- but for multiple elements). allocaArray ∷ ∀ α pr β. (Storable α, MonadCatchIO pr) ⇒ Int → (∀ s. RegionalPtr α (RegionT s pr) → RegionT s pr β) → pr β-allocaArray size = allocaBytes $ size * sizeOf (undefined ∷ α)+allocaArray size = allocaBytes $ size * sizeOf ((⊥) ∷ α) +-- | Like 'allocaArray', but add an extra position to hold a special termination+-- element. allocaArray0 ∷ ∀ α pr β. (Storable α, MonadCatchIO pr) ⇒ Int → (∀ s. RegionalPtr α (RegionT s pr) → RegionT s pr β)@@ -116,12 +130,12 @@ allocaArray0 = allocaArray ∘ succ -- TODO:--- reallocArray ∷ Storable α ⇒ RegionalPtr α pr → Int → cr (RegionalPtr α pr)+-- reallocArray ∷ Storable α ⇒ RegionalPtr α pr → Int → cr (RegionalPtr α pr) -- reallocArray0 ∷ Storable α ⇒ RegionalPtr α pr → Int → cr (RegionalPtr α pr) ----------------------------------------------------------------------------------- Marshalling+-- * Marshalling -------------------------------------------------------------------------------- unsafeWrap2flp ∷ MonadIO m@@ -129,31 +143,48 @@ → (γ → RegionalPtr α r → m β) unsafeWrap2flp = flip ∘ unsafeWrap2 ∘ flip --- | Wraps: @Foreign.Marshal.Array.@'FMA.peekArray'.+-- | Convert an array of given length into a Haskell list.+--+-- (This version traverses the array backwards using an accumulating parameter,+-- which uses constant stack space. The previous version using @mapM@ needed+-- linear stack space.)+--+-- Wraps: @Foreign.Marshal.Array.'FMA.peekArray'@. peekArray ∷ (Storable α, pr `ParentOf` cr, MonadIO cr) ⇒ Int → RegionalPtr α pr → cr [α] peekArray = unsafeWrap2flp FMA.peekArray --- | Wraps: @Foreign.Marshal.Array.@'FMA.peekArray0'.+-- | Convert an array terminated by the given end marker into a Haskell list.+--+-- Wraps: @Foreign.Marshal.Array.'FMA.peekArray0'@. peekArray0 ∷ (Storable α, Eq α, pr `ParentOf` cr, MonadIO cr) ⇒ α → RegionalPtr α pr → cr [α] peekArray0 = unsafeWrap2flp FMA.peekArray0 --- | Wraps: @Foreign.Marshal.Array.@'FMA.pokeArray'.+-- | Write the list elements consecutive into memory.+--+-- Wraps: @Foreign.Marshal.Array.'FMA.pokeArray'@. pokeArray ∷ (Storable α, pr `ParentOf` cr, MonadIO cr) ⇒ RegionalPtr α pr → [α] → cr () pokeArray = unsafeWrap2 FMA.pokeArray --- | Wraps: @Foreign.Marshal.Array.@'FMA.pokeArray0'.+-- | Write the list elements consecutive into memory and terminate them with the+-- given marker element.+--+-- Wraps: @Foreign.Marshal.Array.'FMA.pokeArray0'@. pokeArray0 ∷ (Storable α, pr `ParentOf` cr, MonadIO cr) ⇒ α → RegionalPtr α pr → [α] → cr () pokeArray0 m rp xs = liftIO $ FMA.pokeArray0 m (unsafePtr rp) xs ----------------------------------------------------------------------------------- Combined allocation and marshalling+-- * Combined allocation and marshalling -------------------------------------------------------------------------------- +-- | Write a list of storable elements into a newly allocated, consecutive+-- sequence of storable values.+--+-- Like 'new', but for multiple elements. newArray ∷ (Storable α, MonadCatchIO pr) ⇒ [α] → RegionT s pr (RegionalPtr α (RegionT s pr )) newArray vals = do@@ -161,6 +192,8 @@ pokeArray ptr vals return ptr +-- | Write a list of storable elements into a newly allocated, consecutive+-- sequence of storable values, where the end is fixed by the given end marker. newArray0 ∷ (Storable α, MonadCatchIO pr) ⇒ α → [α] → RegionT s pr (RegionalPtr α (RegionT s pr)) newArray0 marker vals = do@@ -168,12 +201,16 @@ pokeArray0 marker ptr vals return ptr +-- | Temporarily store a list of storable values in memory.+--+-- Like 'with', but for multiple elements. withArray ∷ (Storable α, MonadCatchIO pr) ⇒ [α] → (∀ s. RegionalPtr α (RegionT s pr) → RegionT s pr β) → pr β withArray vals = withArrayLen vals ∘ const +-- | Like 'withArray', but a terminator indicates where the array ends. withArray0 ∷ (Storable α, MonadCatchIO pr) ⇒ α → [α]@@ -181,6 +218,8 @@ → pr β withArray0 marker vals = withArrayLen0 marker vals ∘ const +-- | Like 'withArray', but the action gets the number of values as an additional+-- parameter. withArrayLen ∷ (Storable α, MonadCatchIO pr) ⇒ [α] → (∀ s. Int → RegionalPtr α (RegionT s pr) → RegionT s pr β)@@ -193,6 +232,7 @@ where len = length vals +-- | Like 'withArrayLen', but a terminator indicates where the array ends. withArrayLen0 ∷ (Storable α, MonadCatchIO pr) ⇒ α → [α]@@ -208,35 +248,59 @@ ----------------------------------------------------------------------------------- Copying+-- * Copying -------------------------------------------------------------------------------- --- | Wraps: @Foreign.Marshal.Array.@'FMA.copyArray'.-copyArray ∷ (Storable α, pr `ParentOf` cr, MonadIO cr)- ⇒ RegionalPtr α pr → RegionalPtr α pr → Int → cr ()+-- | Copy the given number of elements from the second array (source) into the+-- first array (destination); the copied areas may /not/ overlap.+--+-- Wraps: @Foreign.Marshal.Array.'FMA.copyArray'@.+copyArray ∷ ( Storable α+ , pr1 `ParentOf` cr+ , pr2 `ParentOf` cr+ , MonadIO cr+ )+ ⇒ RegionalPtr α pr1 -- ^ Destination+ → RegionalPtr α pr2 -- ^ Source+ → Int -- ^ Number of /elements/ to copy.+ → cr () copyArray rp1 rp2 = liftIO ∘ FMA.copyArray (unsafePtr rp1) (unsafePtr rp2) --- | Wraps: @Foreign.Marshal.Array.@'FMA.moveArray'.-moveArray ∷ (Storable α, pr `ParentOf` cr, MonadIO cr)- ⇒ RegionalPtr α pr → RegionalPtr α pr → Int → cr ()+-- | Copy the given number of elements from the second array (source) into the+-- first array (destination); the copied areas /may/ overlap.+--+-- Wraps: @Foreign.Marshal.Array.'FMA.moveArray'@.+moveArray ∷ ( Storable α+ , pr1 `ParentOf` cr+ , pr2 `ParentOf` cr+ , MonadIO cr+ )+ ⇒ RegionalPtr α pr1 -- ^ Destination+ → RegionalPtr α pr1 -- ^ Source+ → Int -- ^ Number of /elements/ to move.+ → cr () moveArray rp1 rp2 = liftIO ∘ FMA.moveArray (unsafePtr rp1) (unsafePtr rp2) ----------------------------------------------------------------------------------- Finding the length+-- * Finding the length -------------------------------------------------------------------------------- --- | Wraps: @Foreign.Marshal.Array.@'FMA.lengthArray0'.+-- | Return the number of elements in an array, excluding the terminator.+--+-- Wraps: @Foreign.Marshal.Array.'FMA.lengthArray0'@. lengthArray0 ∷ (Storable α, Eq α, pr `ParentOf` cr, MonadIO cr) ⇒ α → RegionalPtr α pr → cr Int lengthArray0 = unsafeWrap2flp FMA.lengthArray0 ----------------------------------------------------------------------------------- Indexing+-- * Indexing -------------------------------------------------------------------------------- --- | Wraps: @Foreign.Marshal.Array.@'FMA.advancePtr'.+-- | Advance a pointer into an array by the given number of elements.+--+-- Wraps: @Foreign.Marshal.Array.'FMA.advancePtr'@. advancePtr ∷ Storable α ⇒ RegionalPtr α pr → Int → RegionalPtr α pr advancePtr rp i = mapRegionalPtr (\p → FMA.advancePtr p i) rp
Foreign/Marshal/Utils/Region.hs view
@@ -1,5 +1,6 @@ {-# LANGUAGE UnicodeSyntax , NoImplicitPrelude+ , CPP , RankNTypes #-} @@ -43,10 +44,16 @@ import Data.Function ( ($) ) import Data.Int ( Int ) import Control.Monad ( return, (>>=), fail, (>>) )-import Foreign.Storable ( Storable ) import qualified Foreign.Marshal.Utils as FMU ( fromBool, toBool , copyBytes, moveBytes )+import Foreign.Storable ( Storable )++#ifdef __HADDOCK__+import qualified Foreign.Marshal.Utils as FMU ( with, new )+import Foreign.Storable ( sizeOf )+#endif+ -- from base-unicode-symbols: import Data.Function.Unicode ( (∘) ) @@ -72,10 +79,23 @@ -- ** Combined allocation and marshalling +-- | @'with' val f@ executes the computation @f@, passing as argument a regional+-- pointer to a temporarily allocated block of memory into which @val@ has been+-- marshalled (the combination of 'alloca' and 'poke').+--+-- The memory is freed when @f@ terminates (either normally or via an+-- exception).+--+-- This provides a safer replacement for @Foreign.Marshal.Utils.'FMU.with'@. with ∷ (Storable α, MonadCatchIO pr) ⇒ α → (∀ s. RegionalPtr α (RegionT s pr) → RegionT s pr β) → pr β with val f = alloca $ \ptr → poke ptr val >> f ptr +-- | Allocate a block of memory and marshal a value into it (the combination of+-- 'malloc' and 'poke'). The size of the area allocated is determined by the+-- 'sizeOf' method from the instance of 'Storable' for the appropriate type.+--+-- This provides a safer replacement for @Foreign.Marshal.Utils.'FMU.new'@. new ∷ (Storable α, MonadCatchIO pr) ⇒ α → RegionT s pr (RegionalPtr α (RegionT s pr)) new val = do ptr ← malloc@@ -94,22 +114,32 @@ -- ** Haskellish interface to memcpy and memmove +-- | Copies the given number of bytes from the second area (source) into the+-- first (destination); the copied areas may /not/ overlap+--+-- Wraps: @Foreign.Marshal.Utils.'FMU.copyBytes'@. copyBytes ∷ ( pr1 `ParentOf` cr , pr2 `ParentOf` cr , MonadIO cr ) ⇒ RegionalPtr α pr1 -- ^ Destination → RegionalPtr α pr2 -- ^ Source- → Int → cr ()+ → Int -- ^ Number of bytes to copy+ → cr () copyBytes rp1 rp2 = liftIO ∘ FMU.copyBytes (unsafePtr rp1) (unsafePtr rp2) +-- | Copies the given number of bytes from the second area (source) into the+-- first (destination); the copied areas /may/ overlap+--+-- Wraps: @Foreign.Marshal.Utils.'FMU.moveBytes'@. moveBytes ∷ ( pr1 `ParentOf` cr , pr2 `ParentOf` cr , MonadIO cr ) ⇒ RegionalPtr α pr1 -- ^ Destination → RegionalPtr α pr2 -- ^ Source- → Int → cr ()+ → Int -- ^ Number of bytes to move+ → cr () moveBytes rp1 rp2 = liftIO ∘ FMU.moveBytes (unsafePtr rp1) (unsafePtr rp2)
Foreign/Ptr/Region.hs view
@@ -10,23 +10,24 @@ ------------------------------------------------------------------------------- module Foreign.Ptr.Region- ( -- * Memory as a scarce resource- Memory(..)- , RegionalPtr+ ( -- * Regional pointers+ RegionalPtr {-| Note that this module re-exports the @Control.Monad.Trans.Region@ module from the @regions@ package which allows you to: - * 'open' 'Memory' in a 'RegionT'.- * Run a region using 'runRegionT'. * Concurrently run a region inside another region using 'forkTopRegion'. - * Duplicate a regional pointer to a parent region using 'dup'.+ * Duplicate a 'RegionalPtr' to a parent region using 'dup'. -} , module Control.Monad.Trans.Region + -- * Constructing regional pointers+ , regionalPtr+ , nullPtr+ -- * Pure functions on regional pointers , mapRegionalPtr @@ -42,35 +43,86 @@ -------------------------------------------------------------------------------- -- from base:-import Data.Int ( Int )-import qualified Foreign.Ptr as FP ( castPtr, plusPtr, alignPtr, minusPtr )+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 )+ -- from regions:-import Control.Monad.Trans.Region -- (re-exported entirely)+import Control.Monad.Trans.Region -- (re-exported entirely)+import Control.Monad.Trans.Region.OnExit ( CloseAction, onExit ) -- from ourselves:-import Foreign.Ptr.Region.Internal ( Memory(..), RegionalPtr, mapRegionalPtr )-import Foreign.Ptr.Region.Unsafe ( unsafePtr )+import Foreign.Ptr.Region.Internal ( RegionalPtr(RegionalPtr) )+import Foreign.Ptr.Region.Unsafe ( unsafePtr ) ----------------------------------------------------------------------------------- Pure functions on regional pointers+-- * Constructing regional pointers -------------------------------------------------------------------------------- --- | Wraps: @Foreign.Ptr.@'FP.castPtr'+-- | 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.+nullPtr ∷ RegionalPtr α r+nullPtr = RegionalPtr FP.nullPtr Nothing+++--------------------------------------------------------------------------------+-- * Pure functions on regional pointers+--------------------------------------------------------------------------------++-- | Apply a /pure/ function to the inner pointer of a regional pointer.+mapRegionalPtr ∷ (Ptr α → Ptr β) → (RegionalPtr α r → RegionalPtr β r)+mapRegionalPtr f = \(RegionalPtr ptr ch) → RegionalPtr (f ptr) ch++-- | The @castPtr@ function casts a pointer from one type to another.+--+-- Wraps: @Foreign.Ptr.@'FP.castPtr' castPtr ∷ RegionalPtr α r → RegionalPtr β r castPtr = mapRegionalPtr FP.castPtr --- | Wraps: @Foreign.Ptr.@'FP.plusPtr'+-- | Advances the given address by the given offset in bytes.+--+-- Wraps: @Foreign.Ptr.@'FP.plusPtr' plusPtr ∷ RegionalPtr α r → Int → RegionalPtr β r plusPtr rp n = mapRegionalPtr (\p → FP.plusPtr p n) rp --- | Wraps: @Foreign.Ptr.@'FP.alignPtr'+-- | Given an arbitrary address and an alignment constraint, @alignPtr@ yields+-- the next higher address that fulfills the alignment constraint. An alignment+-- constraint @x@ is fulfilled by any address divisible by @x@. This operation+-- is idempotent.+--+-- Wraps: @Foreign.Ptr.@'FP.alignPtr' alignPtr ∷ RegionalPtr α r → Int → RegionalPtr α r alignPtr rp n = mapRegionalPtr (\p → FP.alignPtr p n) rp --- | Wraps: @Foreign.Ptr.@'FP.minusPtr'-minusPtr ∷ RegionalPtr α r → RegionalPtr β r → Int+-- | Computes the offset required to get from the second to the first+-- argument. We have+--+-- > p2 == p1 `plusPtr` (p2 `minusPtr` p1)+--+-- Wraps: @Foreign.Ptr.@'FP.minusPtr'+minusPtr ∷ RegionalPtr α r1 → RegionalPtr β r2 → Int minusPtr rp1 rp2 = FP.minusPtr (unsafePtr rp1) (unsafePtr rp2)
Foreign/Ptr/Region/Internal.hs view
@@ -1,7 +1,6 @@ {-# LANGUAGE UnicodeSyntax , NoImplicitPrelude- , TypeFamilies- , CPP+ , KindSignatures #-} -------------------------------------------------------------------------------@@ -14,12 +13,10 @@ ------------------------------------------------------------------------------- module Foreign.Ptr.Region.Internal- ( -- * Memory as a scarce resource- Memory(..)- , RegionalPtr+ ( -- * Regional pointers+ RegionalPtr(RegionalPtr) -- * Utility functions for lifting operations on Ptrs to RegionalPtrs- , mapRegionalPtr , unsafePtr , unsafeWrap, unsafeWrap2, unsafeWrap3 ) where@@ -30,64 +27,40 @@ -------------------------------------------------------------------------------- -- from base:-import Data.Function ( ($) )-import Data.Int ( Int )-import Control.Monad ( liftM )-import System.IO ( IO )-import Foreign.Ptr ( Ptr )-import qualified Foreign.Marshal.Alloc as FMA ( mallocBytes, free )---- from base-unicode-symbols:-import Data.Function.Unicode ( (∘) )+import Control.Monad ( return, (>>=), fail )+import Data.Function ( ($) )+import Data.Maybe ( Maybe(Nothing, Just) )+import System.IO ( IO )+import Foreign.Ptr ( Ptr ) -- from transformers:-import Control.Monad.IO.Class ( MonadIO, liftIO )+import Control.Monad.IO.Class ( MonadIO, liftIO ) -- from regions:-import Control.Resource ( Resource- , Handle- , open- , close- )-import Control.Monad.Trans.Region ( RegionalHandle )-import Control.Monad.Trans.Region.Unsafe ( internalHandle- , mapInternalHandle- )-#ifdef __HADDOCK__-import Control.Monad.Trans.Region ( open )-#endif+import Control.Monad.Trans.Region.OnExit ( CloseHandle )+import Control.Monad.Trans.Region ( Dup(dup) ) ----------------------------------------------------------------------------------- Memory as a scarce resource+-- * Regional pointers -------------------------------------------------------------------------------- -{-| Represents memory of 'size' number of bytes which may be marshalled to or-from Haskell values of type @α@. Before you can use the memory you have to-allocate it using 'open'.--}-newtype Memory α = Memory { size ∷ Int }--instance Resource (Memory α) where- newtype Handle (Memory α) = Pointer { ptr ∷ Ptr α }-- open = liftM Pointer ∘ FMA.mallocBytes ∘ size- close = FMA.free ∘ ptr+-- | A regional handle to memory. This should provide a safer replacement for+-- @Foreign.Ptr.'Ptr'@+data RegionalPtr α (r ∷ * → *) = RegionalPtr (Ptr α) (Maybe (CloseHandle r)) --- | Handy type synonym for a regional handle to memory. This should provide a--- safer replacement for @Foreign.Ptr.@'Ptr'-type RegionalPtr α r = RegionalHandle (Memory α) 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' ----------------------------------------------------------------------------------- Utility functions for lifting operations on Ptrs to RegionalPtrs+-- * Utility functions for lifting operations on Ptrs to RegionalPtrs -------------------------------------------------------------------------------- -mapRegionalPtr ∷ (Ptr α → Ptr β) → (RegionalPtr α r → RegionalPtr β r)-mapRegionalPtr f = mapInternalHandle $ Pointer ∘ f ∘ ptr- unsafePtr ∷ RegionalPtr α r → Ptr α-unsafePtr = ptr ∘ internalHandle+unsafePtr (RegionalPtr ptr _) = ptr unsafeWrap ∷ MonadIO m ⇒ (Ptr α → IO β)
Foreign/Ptr/Region/Unsafe.hs view
@@ -7,8 +7,12 @@ -- License : BSD3 (see the file LICENSE) -- Maintainer : Bas van Dijk <v.dijk.bas@gmail.com> ----- /Unsafe/ functions for retrieving the actual 'Ptr' from a regional pointer--- and for lifting operations on 'Ptr's to 'RegionalPtr's.+-- /Unsafe/ functions for retrieving the actual @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. -- -------------------------------------------------------------------------------
Foreign/Storable/Region.hs view
@@ -45,32 +45,70 @@ -- Storable methods lifted to a region -------------------------------------------------------------------------------- --- | Wraps: @Foreign.Storable.'FS.peekElemOff'@.+-- | Read a value from a memory area regarded as an array of values of the same+-- kind. The first argument specifies the start address of the array and the+-- second the index into the array (the first element of the array has index+-- @0@). The following equality holds,+--+-- > peekElemOff addr idx = IOExts.fixIO $ \result ->+-- > peek (addr `plusPtr` (idx * sizeOf result))+--+-- Note that this is only a specification, not necessarily the concrete+-- implementation of the function.+--+-- Wraps: @Foreign.Storable.'FS.peekElemOff'@. peekElemOff ∷ (pr `ParentOf` cr, Storable α, MonadIO cr) ⇒ RegionalPtr α pr → Int → cr α peekElemOff = unsafeWrap2 FS.peekElemOff --- | Wraps: @Foreign.Storable.'FS.pokeElemOff'@.+-- | Write a value to a memory area regarded as an array of values of the same+-- kind. The following equality holds:+--+-- > pokeElemOff addr idx x =+-- > poke (addr `plusPtr` (idx * sizeOf x)) x+--+-- Wraps: @Foreign.Storable.'FS.pokeElemOff'@. pokeElemOff ∷ (pr `ParentOf` cr, Storable α, MonadIO cr) ⇒ RegionalPtr α pr → Int → α → cr () pokeElemOff = unsafeWrap3 FS.pokeElemOff --- | Wraps: @Foreign.Storable.'FS.peekByteOff'@.+-- | Read a value from a memory location given by a base address and offset.+-- The following equality holds:+--+-- > peekByteOff addr off = peek (addr `plusPtr` off)+--+-- Wraps: @Foreign.Storable.'FS.peekByteOff'@. peekByteOff ∷ (pr `ParentOf` cr, Storable α, MonadIO cr) ⇒ RegionalPtr β pr → Int → cr α peekByteOff = unsafeWrap2 FS.peekByteOff --- | Wraps: @Foreign.Storable.'FS.pokeByteOff'@.+-- | Write a value to a memory location given by a base address and offset. The+-- following equality holds:+--+-- > pokeByteOff addr off x = poke (addr `plusPtr` off) x+--+-- Wraps: @Foreign.Storable.'FS.pokeByteOff'@. pokeByteOff ∷ (pr `ParentOf` cr, Storable α, MonadIO cr) ⇒ RegionalPtr β pr → Int → α → cr () pokeByteOff = unsafeWrap3 FS.pokeByteOff --- | Wraps: @Foreign.Storable.'FS.peek'@.+-- | Read a value from the given memory location.+--+-- Note that the peek and poke functions might require properly aligned+-- addresses to function correctly. This is architecture dependent; thus,+-- portable code should ensure that when peeking or poking values of some type+-- @a@, the alignment constraint for @a@, as given by the function 'alignment'+-- is fulfilled.+--+-- Wraps: @Foreign.Storable.'FS.peek'@. peek ∷ (pr `ParentOf` cr, Storable α, MonadIO cr) ⇒ RegionalPtr α pr → cr α peek = unsafeWrap FS.peek --- | Wraps: @Foreign.Storable.'FS.poke'@.+-- | Write the given value to the given memory location. Alignment restrictions+-- might apply; see 'peek'.+--+-- Wraps: @Foreign.Storable.'FS.poke'@. poke ∷ (pr `ParentOf` cr, Storable α, MonadIO cr) ⇒ RegionalPtr α pr → α → cr () poke = unsafeWrap2 FS.poke
LICENSE view
@@ -1,4 +1,4 @@-Copyright (c) 2009 Bas van Dijk+Copyright (c) 2010 Bas van Dijk All rights reserved.
regional-pointers.cabal view
@@ -1,5 +1,5 @@ name: regional-pointers-version: 0.1.0.2+version: 0.2 cabal-version: >=1.6 build-type: Custom license: BSD3@@ -36,7 +36,7 @@ GHC-Options: -Wall build-depends: base >= 4 && < 4.3 , base-unicode-symbols >= 0.1.1 && < 0.3- , regions >= 0.5 && < 0.6+ , regions >= 0.6 && < 0.7 , transformers >= 0.2 && < 0.3 , MonadCatchIO-transformers >= 0.2 && < 0.3 exposed-modules: Foreign.Ptr.Region@@ -46,6 +46,4 @@ Foreign.Marshal.Utils.Region Foreign.Storable.Region Foreign.C.String.Region- -- TODO: Foreign.StablePtr.Region- -- TODO: Foreign.Marshal.Pool.Region other-modules: Foreign.Ptr.Region.Internal