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 @@ -1,5 +1,6 @@ {-# LANGUAGE UnicodeSyntax , NoImplicitPrelude + , KindSignatures , RankNTypes , CPP #-} @@ -20,25 +21,28 @@ RegionalCString, RegionalCStringLen -- * Using a locale-dependent encoding - , peekCString, peekCStringLen - , newCString, newCStringLen - , withCString, withCStringLen + , peekCString, peekCStringLen + , newCString, newCStringLen + , withCString, withCStringLen , charIsRepresentable -- * Using 8-bit characters - , FCS.castCharToCChar - , FCS.castCCharToChar + , FCS.castCharToCChar, FCS.castCCharToChar - , peekCAString, peekCAStringLen - , newCAString, newCAStringLen - , withCAString, withCAStringLen +#if MIN_VERSION_base(4,3,0) + , FCS.castCharToCUChar, FCS.castCUCharToChar + , FCS.castCharToCSChar, FCS.castCSCharToChar +#endif + , peekCAString, peekCAStringLen + , newCAString, newCAStringLen + , withCAString, withCAStringLen -- * C wide strings - , RegionalCWString, RegionalCWStringLen - , peekCWString, peekCWStringLen - , newCWString, newCWStringLen - , withCWString, withCWStringLen + , RegionalCWString, RegionalCWStringLen + , peekCWString, peekCWStringLen + , newCWString, newCWStringLen + , withCWString, withCWStringLen ) where @@ -47,68 +51,58 @@ -------------------------------------------------------------------------------- -- from base: -import Prelude ( fromIntegral ) -import Data.Function ( ($) ) import Data.Bool ( Bool ) import Data.Int ( Int ) -import Data.Char ( Char, String, ord ) -import Data.List ( map, length ) -import Control.Arrow ( first ) -import Control.Monad ( return ) +import Data.Char ( Char, String ) import Foreign.C.Types ( CChar, CWchar ) -import Foreign.Storable ( Storable ) -import qualified Foreign.C.String as FCS ( charIsRepresentable - , peekCAString, peekCAStringLen - , peekCWString, peekCWStringLen +import qualified Foreign.C.String as FCS ( peekCString, peekCStringLen + , newCString, newCStringLen + , withCString, withCStringLen + , charIsRepresentable , castCharToCChar, castCCharToChar +#if MIN_VERSION_base(4,3,0) + , castCharToCUChar, castCUCharToChar + , castCharToCSChar, castCSCharToChar +#endif + , peekCAString, peekCAStringLen + , newCAString, newCAStringLen + , withCAString, withCAStringLen + , peekCWString, peekCWStringLen + , newCWString, newCWStringLen + , withCWString, withCWStringLen ) - #ifdef __HADDOCK__ 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 -#if __GLASGOW_HASKELL__ < 701 -import Prelude ( fromInteger ) -import Control.Monad ( (>>=), fail ) -#endif - -#ifdef mingw32_HOST_OS --- These are only used in the mingw32 version of 'charsToCWchars': -import Prelude ( (-), (+), mod, div ) -import Data.List ( foldr ) -import Data.Bool ( otherwise ) -import Control.Monad ( (>>) ) -import Data.Ord ( (<) ) -#endif - -- from base-unicode-symbols: import Data.Function.Unicode ( (∘) ) -- from transformers: import Control.Monad.IO.Class ( MonadIO, liftIO ) --- from monad-peel: -import Control.Monad.IO.Peel ( MonadPeelIO ) +-- from monad-control: +import Control.Monad.IO.Control ( MonadControlIO ) -- from regions: -import Control.Monad.Trans.Region ( RegionT, AncestorRegion ) +import Control.Monad.Trans.Region ( RegionT + , AncestorRegion + , LocalRegion, Local + ) -- from ourselves: -import Foreign.Marshal.Array.Region ( newArray0, newArray - , withArray0, withArrayLen +import Foreign.Ptr.Region ( AllocatedPointer, RegionalPtr ) +import Foreign.Marshal.Alloc.Region ( LocalPtr ) +import Foreign.Ptr.Region.Unsafe ( wrapMalloc, wrapAlloca + + , wrapPeekStringLen + , wrapNewStringLen + , wrapWithStringLen + + , unsafeWrap ) -import Foreign.Ptr.Region ( RegionalPtr ) -import Foreign.Ptr.Region.Unsafe ( unsafePtr, unsafeWrap ) -------------------------------------------------------------------------------- @@ -119,14 +113,14 @@ -- terminated by a NUL. -- -- This should provide a safer replacement for @Foreign.C.String.'CString'@. -type RegionalCString r = RegionalPtr CChar r +type RegionalCString (pointer ∷ * → (* → *) → *) r = pointer 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. -- (Thus allowing NUL characters in the middle of the string) -- -- This should provide a safer replacement for @Foreign.C.String.'CStringLen'@. -type RegionalCStringLen r = (RegionalPtr CChar r, Int) +type RegionalCStringLen pointer r = (RegionalCString pointer r, Int) -------------------------------------------------------------------------------- @@ -136,33 +130,33 @@ -- | Marshal a NUL terminated C string into a Haskell string. -- -- Wraps: @Foreign.C.String.'FCS.peekCString'@ -peekCString ∷ (pr `AncestorRegion` cr, MonadIO cr) - ⇒ RegionalCString pr → cr String -peekCString = peekCAString +peekCString ∷ (AllocatedPointer pointer, pr `AncestorRegion` cr, MonadIO cr) + ⇒ RegionalCString pointer pr → cr String +peekCString = unsafeWrap FCS.peekCString -- | Marshal a C string with explicit length into a Haskell string. -- -- Wraps: @Foreign.C.String.'FCS.peekCStringLen'@. -peekCStringLen ∷ (pr `AncestorRegion` cr, MonadIO cr) - ⇒ RegionalCStringLen pr → cr String -peekCStringLen = peekCAStringLen +peekCStringLen ∷ (AllocatedPointer pointer, pr `AncestorRegion` cr, MonadIO cr) + ⇒ RegionalCStringLen pointer pr → cr String +peekCStringLen = wrapPeekStringLen FCS.peekCStringLen -- | 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 ∷ MonadPeelIO pr - ⇒ String → RegionT s pr (RegionalCString (RegionT s pr)) -newCString = newCAString +newCString ∷ MonadControlIO pr + ⇒ String → RegionT s pr (RegionalCString RegionalPtr (RegionT s pr)) +newCString = wrapMalloc ∘ FCS.newCString -- | Marshal a Haskell string into a C string (ie, character array) with -- explicit length information. -- -- Wraps: @Foreign.C.String.'FCS.newCStringLen'@. -newCStringLen ∷ MonadPeelIO pr - ⇒ String → RegionT s pr (RegionalCStringLen (RegionT s pr)) -newCStringLen = newCAStringLen +newCStringLen ∷ MonadControlIO pr + ⇒ String → RegionT s pr (RegionalCStringLen RegionalPtr (RegionT s pr)) +newCStringLen = wrapNewStringLen ∘ FCS.newCStringLen -- | Marshal a Haskell string into a NUL terminated C string using temporary -- storage. @@ -173,11 +167,13 @@ -- via an exception). -- -- Wraps: @Foreign.C.String.'FCS.withCString'@. -withCString ∷ MonadPeelIO pr +withCString ∷ MonadControlIO pr ⇒ String - → (∀ s. RegionalCString (RegionT s pr) → RegionT s pr α) - → pr α -withCString = withCAString + → (∀ sl. RegionalCString LocalPtr (LocalRegion sl s) + → RegionT (Local s) pr α + ) + → RegionT s pr α +withCString = wrapAlloca ∘ FCS.withCString -- | Marshal a Haskell string into a C string (ie, character array) in temporary -- storage, with explicit length information. @@ -186,14 +182,15 @@ -- via an exception). -- -- Wraps: @Foreign.C.String.'FCS.withCStringLen'@. -withCStringLen ∷ MonadPeelIO pr +withCStringLen ∷ MonadControlIO pr ⇒ String - → (∀ s. RegionalCStringLen (RegionT s pr) → RegionT s pr α) - → pr α -withCStringLen = withCAStringLen + → (∀ sl. RegionalCStringLen LocalPtr (LocalRegion sl s) + → RegionT (Local s) pr α + ) + → RegionT s pr α +withCStringLen = wrapWithStringLen ∘ FCS.withCStringLen --- | Generalizes @Foreign.C.String.'FCS.charIsRepresentable'@ to any --- 'MonadIO'. +-- | Generalizes @Foreign.C.String.'FCS.charIsRepresentable'@ to any 'MonadIO'. charIsRepresentable ∷ MonadIO m ⇒ Char → m Bool charIsRepresentable = liftIO ∘ FCS.charIsRepresentable @@ -205,33 +202,33 @@ -- | Marshal a NUL terminated C string into a Haskell string. -- -- Wraps: @Foreign.C.String.'FCS.peekCAString'@. -peekCAString ∷ (pr `AncestorRegion` cr, MonadIO cr) - ⇒ RegionalCString pr → cr String +peekCAString ∷ (AllocatedPointer pointer, pr `AncestorRegion` cr, MonadIO cr) + ⇒ RegionalCString pointer 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 `AncestorRegion` cr, MonadIO cr) - ⇒ RegionalCStringLen pr → cr String -peekCAStringLen = liftIO ∘ FCS.peekCAStringLen ∘ first unsafePtr +peekCAStringLen ∷ (AllocatedPointer pointer, pr `AncestorRegion` cr, MonadIO cr) + ⇒ RegionalCStringLen pointer pr → cr String +peekCAStringLen = wrapPeekStringLen FCS.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.newCAString'@. -newCAString ∷ MonadPeelIO pr - ⇒ String → RegionT s pr (RegionalCString (RegionT s pr)) -newCAString = newArray0 nUL ∘ charsToCChars +newCAString ∷ MonadControlIO pr + ⇒ String → RegionT s pr (RegionalCString RegionalPtr (RegionT s pr)) +newCAString = wrapMalloc ∘ FCS.newCAString -- | Marshal a Haskell string into a C string (ie, character array) with -- explicit length information. -- -- Wraps: @Foreign.C.String.'FCS.newCAStringLen'@. -newCAStringLen ∷ MonadPeelIO pr - ⇒ String → RegionT s pr (RegionalCStringLen (RegionT s pr)) -newCAStringLen = newArrayLen ∘ charsToCChars +newCAStringLen ∷ MonadControlIO pr + ⇒ String → RegionT s pr (RegionalCStringLen RegionalPtr (RegionT s pr)) +newCAStringLen = wrapNewStringLen ∘ FCS.newCAStringLen -- | Marshal a Haskell string into a NUL terminated C string using temporary -- storage. @@ -242,11 +239,13 @@ -- via an exception). -- -- Wraps: @Foreign.C.String.'FCS.withCAString'@. -withCAString ∷ MonadPeelIO pr +withCAString ∷ MonadControlIO pr ⇒ String - → (∀ s. RegionalCString (RegionT s pr) → RegionT s pr α) - → pr α -withCAString = withArray0 nUL ∘ charsToCChars + → (∀ sl. RegionalCString LocalPtr (LocalRegion sl s) + → RegionT (Local s) pr α + ) + → RegionT s pr α +withCAString = wrapAlloca ∘ FCS.withCAString -- | Marshal a Haskell string into a C string (ie, character array) in temporary -- storage, with explicit length information. @@ -255,12 +254,13 @@ -- via an exception). -- -- Wraps: @Foreign.C.String.'FCS.withCAStringLen'@. -withCAStringLen ∷ MonadPeelIO pr +withCAStringLen ∷ MonadControlIO pr ⇒ String - → (∀ s. RegionalCStringLen (RegionT s pr) → RegionT s pr α) - → pr α -withCAStringLen str f = withArrayLen (charsToCChars str) - $ \len rPtr → f (rPtr, len) + → (∀ sl. RegionalCStringLen LocalPtr (LocalRegion sl s) + → RegionT (Local s) pr α + ) + → RegionT s pr α +withCAStringLen = wrapWithStringLen ∘ FCS.withCAStringLen -------------------------------------------------------------------------------- @@ -271,45 +271,45 @@ -- terminated by a NUL. -- -- This should provide a safer replacement for @Foreign.C.String.'CWString'@. -type RegionalCWString r = RegionalPtr CWchar r +type RegionalCWString (pointer ∷ * → (* → *) → *) r = pointer CWchar r -- | Handy type synonym for a regional pointer to an array of C wide characters -- which is paired with the length of the array instead of terminated by a NUL. -- (Thus allowing NUL characters in the middle of the string) -- -- This should provide a safer replacement for @Foreign.C.String.'CWStringLen'@. -type RegionalCWStringLen r = (RegionalPtr CWchar r, Int) +type RegionalCWStringLen pointer r = (RegionalCWString pointer r, Int) -- | Marshal a NUL terminated C wide string into a Haskell string. -- -- Wraps: @Foreign.C.String.'FCS.peekCWString'@. -peekCWString ∷ (pr `AncestorRegion` cr, MonadIO cr) - ⇒ RegionalCWString pr → cr String +peekCWString ∷ (AllocatedPointer pointer, pr `AncestorRegion` cr, MonadIO cr) + ⇒ RegionalCWString pointer 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 `AncestorRegion` cr, MonadIO cr) - ⇒ RegionalCWStringLen pr → cr String -peekCWStringLen = liftIO ∘ FCS.peekCWStringLen ∘ first unsafePtr +peekCWStringLen ∷ (AllocatedPointer pointer, pr `AncestorRegion` cr, MonadIO cr) + ⇒ RegionalCWStringLen pointer pr → cr String +peekCWStringLen = wrapPeekStringLen FCS.peekCWStringLen -- | 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 ∷ MonadPeelIO pr - ⇒ String → RegionT s pr (RegionalCWString (RegionT s pr)) -newCWString = newArray0 wNUL ∘ charsToCWchars +newCWString ∷ MonadControlIO pr + ⇒ String → RegionT s pr (RegionalCWString RegionalPtr (RegionT s pr)) +newCWString = wrapMalloc ∘ FCS.newCWString -- | Marshal a Haskell string into a C wide string (ie, wide character array) -- with explicit length information. -- -- Wraps: @Foreign.C.String.'FCS.newCWStringLen'@. -newCWStringLen ∷ MonadPeelIO pr - ⇒ String → RegionT s pr (RegionalCWStringLen (RegionT s pr)) -newCWStringLen = newArrayLen ∘ charsToCWchars +newCWStringLen ∷ MonadControlIO pr + ⇒ String → RegionT s pr (RegionalCWStringLen RegionalPtr (RegionT s pr)) +newCWStringLen = wrapNewStringLen ∘ FCS.newCWStringLen -- | Marshal a Haskell string into a NUL terminated C wide string using -- temporary storage. @@ -320,11 +320,13 @@ -- normally or via an exception). -- -- Wraps: @Foreign.C.String.'FCS.withCWString'@. -withCWString ∷ MonadPeelIO pr +withCWString ∷ MonadControlIO pr ⇒ String - → (∀ s. RegionalCWString (RegionT s pr) → RegionT s pr α) - → pr α -withCWString = withArray0 wNUL ∘ charsToCWchars + → (∀ sl. RegionalCWString LocalPtr (LocalRegion sl s) + → RegionT (Local s) pr α + ) + → RegionT s pr α +withCWString = wrapAlloca ∘ FCS.withCWString -- | Marshal a Haskell string into a NUL terminated C wide string using -- temporary storage. @@ -335,56 +337,13 @@ -- normally or via an exception). -- -- Wraps: @Foreign.C.String.'FCS.withCWStringLen'@. -withCWStringLen ∷ MonadPeelIO pr +withCWStringLen ∷ MonadControlIO pr ⇒ String - → (∀ s. RegionalCWStringLen (RegionT s pr) → RegionT s pr α) - → pr α -withCWStringLen str f = withArrayLen (charsToCWchars str) - $ \len rPtr → f (rPtr, len) - - --------------------------------------------------------------------------------- --- * Utility functions --------------------------------------------------------------------------------- - -nUL ∷ CChar -nUL = 0 - -wNUL ∷ CWchar -wNUL = 0 - --- | allocate an array to hold the list and pair it with the number of elements. -newArrayLen ∷ (Storable α, MonadPeelIO pr) - ⇒ [α] → RegionT s pr (RegionalPtr α (RegionT s pr), Int) -newArrayLen xs = do - rPtr ← newArray xs - return (rPtr, length xs) - -charsToCChars ∷ [Char] → [CChar] -charsToCChars = map FCS.castCharToCChar - --- Note that the following is copied from 'Foreign.C.String': -charsToCWchars ∷ [Char] → [CWchar] - -#ifdef mingw32_HOST_OS --- On Windows, wchar_t is 16 bits wide and CWString uses the UTF-16 encoding. -charsToCWchars = foldr utf16Char [] ∘ map ord - where - utf16Char c wcs - | c < 0x10000 = fromIntegral c : wcs - | otherwise = let c' = c - 0x10000 in - fromIntegral (c' `div` 0x400 + 0xd800) : - fromIntegral (c' `mod` 0x400 + 0xdc00) : wcs - -#else -charsToCWchars = map castCharToCWchar - --- These conversions only make sense if __STDC_ISO_10646__ is defined --- (meaning that wchar_t is ISO 10646, aka Unicode) - -castCharToCWchar ∷ Char → CWchar -castCharToCWchar = fromIntegral ∘ ord -#endif + → (∀ sl. RegionalCWStringLen LocalPtr (LocalRegion sl s) + → RegionT (Local s) pr α + ) + → RegionT s pr α +withCWStringLen = wrapWithStringLen ∘ FCS.withCWStringLen -- The End --------------------------------------------------------------------- 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 @@ -16,14 +16,15 @@ module Foreign.Marshal.Alloc.Region ( -- * Local allocation - alloca + LocalPtr + , alloca , allocaBytes - +#if MIN_VERSION_base(4,3,0) + , allocaBytesAligned +#endif -- * Dynamic allocation , malloc , mallocBytes - - -- | /TODO:/ Define and export: @realloc@ and @reallocBytes@. ) where @@ -32,102 +33,107 @@ -------------------------------------------------------------------------------- -- from base: -import Control.Monad ( (>>=) ) -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 ) +import Foreign.Storable ( Storable ) -#ifdef __HADDOCK__ -import qualified Foreign.Marshal.Alloc as FMA ( alloca, allocaBytes, malloc ) +import qualified Foreign.Marshal.Alloc as FMA ( alloca, allocaBytes + , malloc, mallocBytes + ) +#if MIN_VERSION_base(4,3,0) +import qualified Foreign.Marshal.Alloc as FMA ( allocaBytesAligned ) #endif -#if __GLASGOW_HASKELL__ < 701 -import Control.Monad ( fail ) +#if __HADDOCK__ +import Foreign.Storable ( sizeOf ) #endif --- from base-unicode-symbols: -import Prelude.Unicode ( (⊥) ) - --- from transformers: -import Control.Monad.IO.Class ( liftIO ) - --- from monad-peel: -import Control.Monad.IO.Peel ( MonadPeelIO ) -import Control.Exception.Peel ( block ) +-- from monad-control: +import Control.Monad.IO.Control ( MonadControlIO ) -- from regions: -import Control.Monad.Trans.Region ( RegionT, runRegionT ) +import Control.Monad.Trans.Region ( RegionT, LocalRegion, Local ) -- from ourselves: -import Foreign.Ptr.Region ( RegionalPtr ) -import Foreign.Ptr.Region.Unsafe ( unsafeRegionalPtr ) +import Foreign.Ptr.Region ( RegionalPtr, ) +import Foreign.Ptr.Region.Internal ( LocalPtr ) +import Foreign.Ptr.Region.Unsafe ( wrapAlloca, wrapMalloc ) -------------------------------------------------------------------------------- -- * Local allocation -------------------------------------------------------------------------------- -{-| Convenience function which allocates sufficient memory to hold values of -type @α@, applies the given continuation function to the resulting regional -pointer and runs the resulting region. +{-| +@'alloca' f@ executes the computation @f@, passing as argument a pointer to +a temporarily allocated block of memory sufficient to hold values of type @α@. +The memory is freed when @f@ terminates (either normally or via an exception). + This should provide a safer replacement for: @Foreign.Marshal.Alloc.'FMA.alloca'@. - -Note that: @alloca = 'allocaBytes' $ 'sizeOf' (undefined :: α)@ -} -alloca ∷ ∀ α pr β. (Storable α, MonadPeelIO pr) - ⇒ (∀ s. RegionalPtr α (RegionT s pr) → RegionT s pr β) - → pr β -alloca = allocaBytes $ sizeOf ((⊥) ∷ α) +alloca ∷ (Storable α, MonadControlIO pr) + ⇒ (∀ sl. LocalPtr α (LocalRegion sl s) → RegionT (Local s) pr β) + → RegionT s pr β +alloca = wrapAlloca FMA.alloca -{-| Convenience function which allocates the given number of bytes, applies the -given continuation function to the resulting regional pointer and runs the -resulting region. +{-| +@'allocaBytes' n f@ executes the computation @f@, passing as argument a +pointer to a temporarily allocated block of memory of @n@ bytes. +The block of memory is sufficiently aligned for any of the basic foreign types +that fits into a memory block of the allocated size. +The memory is freed when @f@ terminates (either normally or via an exception). + This should provide a safer replacement for: @Foreign.Marshal.Alloc.'FMA.allocaBytes'@. - -Note that: @allocaBytes size f = 'runRegionT' $ 'mallocBytes' size >>= f@ -} -allocaBytes ∷ ∀ α pr β. MonadPeelIO pr +allocaBytes ∷ MonadControlIO pr ⇒ Int - → (∀ s. RegionalPtr α (RegionT s pr) → RegionT s pr β) - → pr β -allocaBytes size f = runRegionT $ mallocBytes size >>= f + → (∀ sl. LocalPtr α (LocalRegion sl s) → RegionT (Local s) pr β) + → RegionT s pr β +allocaBytes size = wrapAlloca (FMA.allocaBytes size) +#if MIN_VERSION_base(4,3,0) +-- | This should provide a safer replacement for: +-- @Foreign.Marshal.Alloc.'FMA.allocaBytesAligned'@. +allocaBytesAligned ∷ + MonadControlIO pr + ⇒ Int → Int + → (∀ sl. LocalPtr α (LocalRegion sl s) → RegionT (Local s) pr β) + → RegionT s pr β +allocaBytesAligned size align = wrapAlloca (FMA.allocaBytesAligned size align) +#endif + -------------------------------------------------------------------------------- -- * Dynamic allocation -------------------------------------------------------------------------------- -{-| Convenience function which allocates sufficient memory to hold values of -type @α@ and returns a regional pointer to them. +{-| +Allocate a block of memory that is sufficient to hold values of type @α@. +Note that: @malloc = 'mallocBytes' $ 'sizeOf' (undefined :: α)@ + This should provide a safer replacement for: @Foreign.Marshal.Alloc.'FMA.malloc'@. - -Note that: @malloc = 'mallocBytes' $ 'sizeOf' (undefined :: α)@ -} -malloc ∷ ∀ α pr s. (Storable α, MonadPeelIO pr) +malloc ∷ ∀ α pr s. (Storable α, MonadControlIO pr) ⇒ RegionT s pr (RegionalPtr α (RegionT s pr)) -malloc = mallocBytes $ sizeOf ((⊥) ∷ α) +malloc = wrapMalloc FMA.malloc -{-| Allocates the given number of bytes and returns a regional pointer to them. +{-| +Allocate a block of memory of the given number of bytes. +The block of memory is sufficiently aligned for any of the basic foreign types +that fits into a memory block of the allocated size. This should provide a safer replacement for: @Foreign.Marshal.Alloc.'FMA.mallocBytes'@. -} -mallocBytes ∷ MonadPeelIO pr +mallocBytes ∷ MonadControlIO pr ⇒ Int → RegionT s pr (RegionalPtr α (RegionT s pr)) -mallocBytes size = block $ do - ptr ← liftIO $ FMA.mallocBytes size - unsafeRegionalPtr ptr $ free ptr +mallocBytes size = wrapMalloc (FMA.mallocBytes size) -- TODO: -- realloc ∷ (Storable β, pr `AncestorRegion` 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 @@ -2,7 +2,6 @@ , NoImplicitPrelude , CPP , RankNTypes - , ScopedTypeVariables #-} ------------------------------------------------------------------------------- @@ -16,30 +15,20 @@ module Foreign.Marshal.Array.Region ( -- * Allocation - mallocArray - , mallocArray0 - , allocaArray - , allocaArray0 - - -- | /TODO:/ Define and export @reallocArray@ and @reallocArray0@ + mallocArray, mallocArray0 + , allocaArray, allocaArray0 -- * Marshalling - , peekArray - , peekArray0 - , pokeArray - , pokeArray0 + , peekArray, peekArray0 + , pokeArray, pokeArray0 -- * Combined allocation and marshalling - , newArray - , newArray0 - , withArray - , withArray0 - , withArrayLen - , withArrayLen0 + , newArray, newArray0 + , withArray, withArray0 + , withArrayLen, withArrayLen0 -- * Copying - , copyArray - , moveArray + , copyArray, moveArray -- * Finding the length , lengthArray0 @@ -54,46 +43,53 @@ -------------------------------------------------------------------------------- -- from base: -import Prelude ( (*), succ ) -import Data.Function ( ($), flip ) +import Data.Function ( ($) ) import Data.Int ( Int ) -import Data.List ( length ) import Data.Eq ( Eq ) -import Control.Monad ( return ) -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 +import Foreign.Storable ( Storable ) +import qualified Foreign.Marshal.Array as FMA ( mallocArray, mallocArray0 + + , allocaArray, allocaArray0 + + , peekArray, peekArray0 + , pokeArray, pokeArray0 + + , newArray, newArray0 + , withArray, withArray0 + + , withArrayLen, withArrayLen0 + + , copyArray, moveArray + , lengthArray0 , advancePtr ) -#if __GLASGOW_HASKELL__ < 701 -import Control.Monad ( (>>=), fail, (>>) ) -#endif - -- from base-unicode-symbols: import Data.Function.Unicode ( (∘) ) -import Prelude.Unicode ( (⊥) ) -- from transformers: import Control.Monad.IO.Class ( MonadIO, liftIO ) --- from monad-peel: -import Control.Monad.IO.Peel ( MonadPeelIO ) +-- from monad-control: +import Control.Monad.IO.Control ( MonadControlIO ) -- from regions: -import Control.Monad.Trans.Region ( RegionT , AncestorRegion ) +import Control.Monad.Trans.Region ( RegionT + , AncestorRegion + , LocalRegion, Local + ) -- from ourselves: -import Foreign.Ptr.Region ( RegionalPtr, mapRegionalPtr ) -import Foreign.Ptr.Region.Unsafe ( unsafePtr, unsafeWrap2 ) -import Foreign.Marshal.Alloc.Region ( mallocBytes, allocaBytes ) +import Foreign.Ptr.Region ( AllocatedPointer, mapPointer + , RegionalPtr + ) +import Foreign.Marshal.Alloc.Region ( LocalPtr ) +import Foreign.Ptr.Region.Unsafe ( unsafePtr + , unsafeWrap2, unsafeWrap2flp + , wrapAlloca, wrapAlloca2 + , wrapMalloc + ) #ifdef __HADDOCK__ import Foreign.Marshal.Alloc.Region ( malloc, alloca ) @@ -108,31 +104,31 @@ -- | Allocate storage for the given number of elements of a storable type. -- -- Like 'malloc', but for multiple elements. -mallocArray ∷ ∀ α s pr. (Storable α, MonadPeelIO pr) +mallocArray ∷ (Storable α, MonadControlIO pr) ⇒ Int → RegionT s pr (RegionalPtr α (RegionT s pr)) -mallocArray size = mallocBytes $ size * sizeOf ((⊥) ∷ α) +mallocArray = wrapMalloc ∘ FMA.mallocArray -- | Like 'mallocArray', but add an extra position to hold a special termination -- element. -mallocArray0 ∷ (Storable α, MonadPeelIO pr) +mallocArray0 ∷ (Storable α, MonadControlIO pr) ⇒ Int → RegionT s pr (RegionalPtr α (RegionT s pr)) -mallocArray0 = mallocArray ∘ succ +mallocArray0 = wrapMalloc ∘ FMA.mallocArray0 -- | Temporarily allocate space for the given number of elements (like 'alloca', -- but for multiple elements). -allocaArray ∷ ∀ α pr β. (Storable α, MonadPeelIO pr) +allocaArray ∷ (Storable α, MonadControlIO pr) ⇒ Int - → (∀ s. RegionalPtr α (RegionT s pr) → RegionT s pr β) - → pr β -allocaArray size = allocaBytes $ size * sizeOf ((⊥) ∷ α) + → (∀ sl. LocalPtr α (LocalRegion sl s) → RegionT (Local s) pr β) + → RegionT s pr β +allocaArray = wrapAlloca ∘ FMA.allocaArray -- | Like 'allocaArray', but add an extra position to hold a special termination -- element. -allocaArray0 ∷ ∀ α pr β. (Storable α, MonadPeelIO pr) +allocaArray0 ∷ (Storable α, MonadControlIO pr) ⇒ Int - → (∀ s. RegionalPtr α (RegionT s pr) → RegionT s pr β) - → pr β -allocaArray0 = allocaArray ∘ succ + → (∀ sl. LocalPtr α (LocalRegion sl s) → RegionT (Local s) pr β) + → RegionT s pr β +allocaArray0 = wrapAlloca ∘ FMA.allocaArray0 -- TODO: -- reallocArray ∷ Storable α ⇒ RegionalPtr α pr → Int → cr (RegionalPtr α pr) @@ -143,11 +139,6 @@ -- * Marshalling -------------------------------------------------------------------------------- -unsafeWrap2flp ∷ MonadIO m - ⇒ (γ → Ptr α → IO β) - → (γ → RegionalPtr α r → m β) -unsafeWrap2flp = flip ∘ unsafeWrap2 ∘ flip - -- | Convert an array of given length into a Haskell list. -- -- (This version traverses the array backwards using an accumulating parameter, @@ -155,30 +146,38 @@ -- linear stack space.) -- -- Wraps: @Foreign.Marshal.Array.'FMA.peekArray'@. -peekArray ∷ (Storable α, pr `AncestorRegion` cr, MonadIO cr) - ⇒ Int → RegionalPtr α pr → cr [α] +peekArray ∷ ( AllocatedPointer pointer, Storable α + , pr `AncestorRegion` cr, MonadIO cr + ) + ⇒ Int → pointer α pr → cr [α] peekArray = unsafeWrap2flp FMA.peekArray -- | Convert an array terminated by the given end marker into a Haskell list. -- -- Wraps: @Foreign.Marshal.Array.'FMA.peekArray0'@. -peekArray0 ∷ (Storable α, Eq α, pr `AncestorRegion` cr, MonadIO cr) - ⇒ α → RegionalPtr α pr → cr [α] +peekArray0 ∷ ( AllocatedPointer pointer, Storable α, Eq α + , pr `AncestorRegion` cr, MonadIO cr + ) + ⇒ α → pointer α pr → cr [α] peekArray0 = unsafeWrap2flp FMA.peekArray0 -- | Write the list elements consecutive into memory. -- -- Wraps: @Foreign.Marshal.Array.'FMA.pokeArray'@. -pokeArray ∷ (Storable α, pr `AncestorRegion` cr, MonadIO cr) - ⇒ RegionalPtr α pr → [α] → cr () +pokeArray ∷ ( AllocatedPointer pointer, Storable α + , pr `AncestorRegion` cr, MonadIO cr + ) + ⇒ pointer α pr → [α] → cr () pokeArray = unsafeWrap2 FMA.pokeArray -- | Write the list elements consecutive into memory and terminate them with the -- given marker element. -- -- Wraps: @Foreign.Marshal.Array.'FMA.pokeArray0'@. -pokeArray0 ∷ (Storable α, pr `AncestorRegion` cr, MonadIO cr) - ⇒ α → RegionalPtr α pr → [α] → cr () +pokeArray0 ∷ ( AllocatedPointer pointer, Storable α + , pr `AncestorRegion` cr, MonadIO cr + ) + ⇒ α → pointer α pr → [α] → cr () pokeArray0 m rp xs = liftIO $ FMA.pokeArray0 m (unsafePtr rp) xs @@ -190,66 +189,50 @@ -- sequence of storable values. -- -- Like 'new', but for multiple elements. -newArray ∷ (Storable α, MonadPeelIO pr) +newArray ∷ (Storable α, MonadControlIO pr) ⇒ [α] → RegionT s pr (RegionalPtr α (RegionT s pr )) -newArray vals = do - ptr ← mallocArray $ length vals - pokeArray ptr vals - return ptr +newArray = wrapMalloc ∘ FMA.newArray -- | 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 α, MonadPeelIO pr) +newArray0 ∷ (Storable α, MonadControlIO pr) ⇒ α → [α] → RegionT s pr (RegionalPtr α (RegionT s pr)) -newArray0 marker vals = do - ptr ← mallocArray0 $ length vals - pokeArray0 marker ptr vals - return ptr +newArray0 marker vals = wrapMalloc (FMA.newArray0 marker vals) -- | Temporarily store a list of storable values in memory. -- -- Like 'with', but for multiple elements. -withArray ∷ (Storable α, MonadPeelIO pr) +withArray ∷ (Storable α, MonadControlIO pr) ⇒ [α] - → (∀ s. RegionalPtr α (RegionT s pr) → RegionT s pr β) - → pr β -withArray vals f = withArrayLen vals $ \_ → f + → (∀ sl. LocalPtr α (LocalRegion sl s) → RegionT (Local s) pr β) + → RegionT s pr β +withArray = wrapAlloca ∘ FMA.withArray -- | Like 'withArray', but a terminator indicates where the array ends. -withArray0 ∷ (Storable α, MonadPeelIO pr) +withArray0 ∷ (Storable α, MonadControlIO pr) ⇒ α → [α] - → (∀ s. RegionalPtr α (RegionT s pr) → RegionT s pr β) - → pr β -withArray0 marker vals f = withArrayLen0 marker vals $ \_ → f + → (∀ sl. LocalPtr α (LocalRegion sl s) → RegionT (Local s) pr β) + → RegionT s pr β +withArray0 marker vals = wrapAlloca (FMA.withArray0 marker vals) -- | Like 'withArray', but the action gets the number of values as an additional -- parameter. -withArrayLen ∷ (Storable α, MonadPeelIO 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 +withArrayLen ∷ + (Storable α, MonadControlIO pr) + ⇒ [α] + → (∀ sl. Int → LocalPtr α (LocalRegion sl s) → RegionT (Local s) pr β) + → RegionT s pr β +withArrayLen = wrapAlloca2 ∘ FMA.withArrayLen -- | Like 'withArrayLen', but a terminator indicates where the array ends. -withArrayLen0 ∷ (Storable α, MonadPeelIO 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 +withArrayLen0 ∷ + (Storable α, MonadControlIO pr) + ⇒ α + → [α] + → (∀ sl. Int → LocalPtr α (LocalRegion sl s) → RegionT (Local s) pr β) + → RegionT s pr β +withArrayLen0 marker vals = wrapAlloca2 (FMA.withArrayLen0 marker vals) -------------------------------------------------------------------------------- @@ -260,31 +243,37 @@ -- first array (destination); the copied areas may /not/ overlap. -- -- Wraps: @Foreign.Marshal.Array.'FMA.copyArray'@. -copyArray ∷ ( Storable α +copyArray ∷ ( AllocatedPointer pointer1 + , AllocatedPointer pointer2 + , Storable α , pr1 `AncestorRegion` cr , pr2 `AncestorRegion` cr , MonadIO cr ) - ⇒ RegionalPtr α pr1 -- ^ Destination - → RegionalPtr α pr2 -- ^ Source - → Int -- ^ Number of /elements/ to copy. + ⇒ pointer1 α pr1 -- ^ Destination + → pointer2 α pr2 -- ^ Source + → Int -- ^ Number of /elements/ to copy. → cr () -copyArray rPtr1 rPtr2 = liftIO ∘ FMA.copyArray (unsafePtr rPtr1) (unsafePtr rPtr2) +copyArray pointer1 pointer2 = liftIO ∘ FMA.copyArray (unsafePtr pointer1) + (unsafePtr pointer2) -- | 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 α +moveArray ∷ ( AllocatedPointer pointer1 + , AllocatedPointer pointer2 + , Storable α , pr1 `AncestorRegion` cr , pr2 `AncestorRegion` cr , MonadIO cr ) - ⇒ RegionalPtr α pr1 -- ^ Destination - → RegionalPtr α pr1 -- ^ Source - → Int -- ^ Number of /elements/ to move. + ⇒ pointer1 α pr1 -- ^ Destination + → pointer2 α pr2 -- ^ Source + → Int -- ^ Number of /elements/ to move. → cr () -moveArray rPtr1 rPtr2 = liftIO ∘ FMA.moveArray (unsafePtr rPtr1) (unsafePtr rPtr2) +moveArray pointer1 pointer2 = liftIO ∘ FMA.moveArray (unsafePtr pointer1) + (unsafePtr pointer2) -------------------------------------------------------------------------------- @@ -294,8 +283,10 @@ -- | Return the number of elements in an array, excluding the terminator. -- -- Wraps: @Foreign.Marshal.Array.'FMA.lengthArray0'@. -lengthArray0 ∷ (Storable α, Eq α, pr `AncestorRegion` cr, MonadIO cr) - ⇒ α → RegionalPtr α pr → cr Int +lengthArray0 ∷ ( AllocatedPointer pointer, Storable α, Eq α + , pr `AncestorRegion` cr, MonadIO cr + ) + ⇒ α → pointer α pr → cr Int lengthArray0 = unsafeWrap2flp FMA.lengthArray0 @@ -306,8 +297,9 @@ -- | 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 +advancePtr ∷ (AllocatedPointer pointer, Storable α) + ⇒ pointer α pr → Int → pointer α pr +advancePtr pointer i = mapPointer (\ptr → FMA.advancePtr ptr i) pointer -- The End --------------------------------------------------------------------- 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 @@ -1,7 +1,9 @@ -{-# LANGUAGE UnicodeSyntax +{-# LANGUAGE CPP + , UnicodeSyntax , NoImplicitPrelude - , CPP , RankNTypes + , GADTs + , KindSignatures #-} ------------------------------------------------------------------------------- @@ -23,11 +25,14 @@ , FMU.fromBool , FMU.toBool - -- ** Marshalling of Maybe values - -- | /TODO:/ Define and export: @maybeNew@, @maybeWith@ and @maybePeek@. + -- ** Marshalling of @MaybePointer@ values + , MaybePointer(..) + , maybeNew + , maybeWith + , MaybePeek(maybePeek) -- ** Marshalling lists of storable objects - -- | /TODO:/ Define and export: @withMany@. + , FMU.withMany -- ** Haskellish interface to memcpy and memmove -- | (argument order: destination, source) @@ -41,22 +46,23 @@ -------------------------------------------------------------------------------- -- from base: -import Data.Function ( ($) ) -import Data.Int ( Int ) -import Control.Monad ( return, (>>) ) -import qualified Foreign.Marshal.Utils as FMU ( fromBool, toBool +import qualified Foreign.Marshal.Utils as FMU ( with, new + , fromBool, toBool + , withMany , copyBytes, moveBytes ) import Foreign.Storable ( Storable ) #ifdef __HADDOCK__ -import qualified Foreign.Marshal.Utils as FMU ( with, new ) import Foreign.Storable ( sizeOf ) +import qualified Foreign.Marshal.Utils as FMU ( maybeNew, maybeWith, maybePeek ) #endif -#if __GLASGOW_HASKELL__ < 701 -import Control.Monad ( (>>=), fail ) -#endif +import Data.Int ( Int ) +import Data.Maybe ( Maybe(Nothing, Just) ) +import Data.Functor ( (<$>) ) +import Control.Applicative ( Applicative, pure ) +import Control.Monad ( Monad, return ) -- from base-unicode-symbols: import Data.Function.Unicode ( (∘) ) @@ -64,17 +70,25 @@ -- from transformers: import Control.Monad.IO.Class ( MonadIO, liftIO ) --- from monad-peel: -import Control.Monad.IO.Peel ( MonadPeelIO ) +-- from monad-control: +import Control.Monad.IO.Control ( MonadControlIO ) -- from regions: -import Control.Monad.Trans.Region ( RegionT, AncestorRegion ) +import Control.Monad.Trans.Region ( RegionT + , AncestorRegion + , RootRegion + , LocalRegion, Local + ) -- from ourselves: -import Foreign.Ptr.Region ( RegionalPtr ) -import Foreign.Ptr.Region.Unsafe ( unsafePtr ) -import Foreign.Marshal.Alloc.Region ( alloca, malloc ) -import Foreign.Storable.Region ( poke ) +import Foreign.Ptr.Region ( AllocatedPointer + , RegionalPtr + , NullPtr, nullPtr + ) +import Foreign.Marshal.Alloc.Region ( LocalPtr ) +import Foreign.Ptr.Region.Unsafe ( unsafePtr + , wrapAlloca, wrapMalloc + ) -------------------------------------------------------------------------------- @@ -91,27 +105,61 @@ -- exception). -- -- This provides a safer replacement for @Foreign.Marshal.Utils.'FMU.with'@. -with ∷ (Storable α, MonadPeelIO pr) - ⇒ α → (∀ s. RegionalPtr α (RegionT s pr) → RegionT s pr β) → pr β -with val f = alloca $ \ptr → poke ptr val >> f ptr +with ∷ (Storable α, MonadControlIO pr) + ⇒ α → (∀ sl. LocalPtr α (LocalRegion sl s) → RegionT (Local s) pr β) -- ^ + → RegionT s pr β +with = wrapAlloca ∘ FMU.with -- | 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 α, MonadPeelIO pr) +new ∷ (Storable α, MonadControlIO pr) ⇒ α → RegionT s pr (RegionalPtr α (RegionT s pr)) -new val = do ptr ← malloc - poke ptr val - return ptr +new = wrapMalloc ∘ FMU.new --- TODO: --- -- ** Marshalling of Maybe values --- maybeNew --- maybeWith --- maybePeek +-- ** Marshalling of @MaybePointer@ values + +-- | A @'MaybePointer' α@ corresponds to a @'Maybe' α@ +-- but additionally introduces some type equalities to the type-checker. +data MaybePointer (α ∷ *) (pointer ∷ *) (β ∷ *) (r ∷ * → *) where + NullPointer ∷ MaybePointer α (NullPtr β RootRegion) β RootRegion + JustPointer ∷ α → MaybePointer α (RegionalPtr β r) β r + +-- | Allocate storage and marshal a storable value wrapped into a 'MaybePointer'. +-- +-- The 'nullPtr' is used to represent 'NullPointer'. +-- +-- Alternative for 'FMU.maybeNew'. +maybeNew ∷ Monad m + ⇒ (α → m (RegionalPtr β r)) -- ^ + → (MaybePointer α pointer β r → m pointer) +maybeNew _ NullPointer = return nullPtr +maybeNew f (JustPointer x) = f x + +-- | Converts a @withXXX@ combinator into one marshalling a value wrapped +-- into a 'MaybePointer', using 'nullPtr' to represent 'NoPointer'. +-- +-- Alternative for 'FMU.maybeWith' +maybeWith ∷ (α → (pointer → m γ) → m γ) -- ^ + → (MaybePointer α pointer β r → (pointer → m γ) → m γ) +maybeWith _ NullPointer g = g nullPtr +maybeWith f (JustPointer x) g = f x g + +class MaybePeek (pointer ∷ * → (* → *) → *) where + -- | Convert a @peek@ combinator into a one returning 'Nothing' + -- if applied to a 'nullPtr'. + -- + -- Alternative for 'FMU.maybePeek'. + maybePeek ∷ Applicative m + ⇒ (pointer α r → m β) -- ^ + → (pointer α r → m (Maybe β)) + +instance MaybePeek NullPtr where maybePeek _ _ = pure Nothing +instance MaybePeek RegionalPtr where maybePeek peek ptr = Just <$> peek ptr + -- TODO -- -- ** Marshalling lists of storable objects -- withMany :: (a -> (b -> res) -> res) -> [a] -> ([b] -> res) -> res @@ -122,29 +170,35 @@ -- first (destination); the copied areas may /not/ overlap -- -- Wraps: @Foreign.Marshal.Utils.'FMU.copyBytes'@. -copyBytes ∷ ( pr1 `AncestorRegion` cr +copyBytes ∷ ( AllocatedPointer pointer1 + , AllocatedPointer pointer2 + , pr1 `AncestorRegion` cr , pr2 `AncestorRegion` cr , MonadIO cr ) - ⇒ RegionalPtr α pr1 -- ^ Destination - → RegionalPtr α pr2 -- ^ Source - → Int -- ^ Number of bytes to copy + ⇒ pointer1 α pr1 -- ^ Destination + → pointer2 α pr2 -- ^ Source + → Int -- ^ Number of bytes to copy → cr () -copyBytes rPtr1 rPtr2 = liftIO ∘ FMU.copyBytes (unsafePtr rPtr1) (unsafePtr rPtr2) +copyBytes pointer1 pointer2 = liftIO ∘ FMU.copyBytes (unsafePtr pointer1) + (unsafePtr pointer2) -- | 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 `AncestorRegion` cr +moveBytes ∷ ( AllocatedPointer pointer1 + , AllocatedPointer pointer2 + , pr1 `AncestorRegion` cr , pr2 `AncestorRegion` cr , MonadIO cr ) - ⇒ RegionalPtr α pr1 -- ^ Destination - → RegionalPtr α pr2 -- ^ Source - → Int -- ^ Number of bytes to move + ⇒ pointer1 α pr1 -- ^ Destination + → pointer2 α pr2 -- ^ Source + → Int -- ^ Number of bytes to move → cr () -moveBytes rPtr1 rPtr2 = liftIO ∘ FMU.moveBytes (unsafePtr rPtr1) (unsafePtr rPtr2) +moveBytes pointer1 pointer2 = liftIO ∘ FMU.moveBytes (unsafePtr pointer1) + (unsafePtr pointer2) -- The End --------------------------------------------------------------------- diff --git a/Foreign/Ptr/Region.hs b/Foreign/Ptr/Region.hs --- a/Foreign/Ptr/Region.hs +++ b/Foreign/Ptr/Region.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE UnicodeSyntax, NoImplicitPrelude #-} +{-# LANGUAGE UnicodeSyntax, NoImplicitPrelude, KindSignatures #-} ------------------------------------------------------------------------------- -- | @@ -10,28 +10,27 @@ ------------------------------------------------------------------------------- module Foreign.Ptr.Region - ( -- * Regional pointers - RegionalPtr - - , nullPtr - - {-| Note that this module re-exports the @Control.Monad.Trans.Region@ - module from the @regions@ package which allows you to: - - * Run a region using 'runRegionT'. + ( {-| + Note that this module re-exports the @Control.Monad.Trans.Region@ module + from the @regions@ package which allows you to run regions using 'runRegionT' + and duplicate a 'RegionalPtr' to a parent region using 'dup'. + -} + module Control.Monad.Trans.Region - * Concurrently run a region inside another region using 'forkIOTopRegion'. + -- * Regional pointers + , RegionalPtr - * Duplicate a 'RegionalPtr' to a parent region using 'dup'. - -} - , module Control.Monad.Trans.Region + -- * Null pointers + , nullPtr, NullPtr - -- * Pure functions on regional pointers - , mapRegionalPtr + -- * Class of pointers + , Pointer(mapPointer) + , AllocatedPointer + -- * Pure functions on pointers , castPtr - , plusPtr , alignPtr + , plusPtr , minusPtr ) where @@ -42,56 +41,28 @@ -- from base: import Data.Int ( Int ) +import qualified Foreign.Ptr as FP ( castPtr, plusPtr, alignPtr, minusPtr ) -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) -- from ourselves: -import Foreign.Ptr.Region.Internal ( RegionalPtr(RegionalPtr) ) -import Foreign.Ptr.Region.Unsafe ( unsafePureRegionalPtr, unsafePtr ) - - --------------------------------------------------------------------------------- --- * Regional pointers --------------------------------------------------------------------------------- - --- | 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 finalizer like @free nullPtr@ --- in the 'RegionT' monad. --- --- Finally note that the region parameter of the 'RegionalPtr' is set to --- 'RootRegion' which is the ancestor of any region. This allows 'nullPtr' to be --- used in any region. -nullPtr ∷ RegionalPtr α RootRegion -nullPtr = unsafePureRegionalPtr FP.nullPtr +import Foreign.Ptr.Region.Internal ( RegionalPtr + , NullPtr, nullPtr + , Pointer(unsafePtr, mapPointer) + , AllocatedPointer + ) -------------------------------------------------------------------------------- -- * 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 - --- | Advances the given address by the given offset in bytes. --- --- Wraps: @Foreign.Ptr.@'FP.plusPtr' -plusPtr ∷ RegionalPtr α r → Int → RegionalPtr β r -plusPtr rPtr n = mapRegionalPtr (\ptr → FP.plusPtr ptr n) rPtr +castPtr ∷ Pointer pointer ⇒ pointer α r → pointer β r +castPtr = mapPointer FP.castPtr -- | Given an arbitrary address and an alignment constraint, @alignPtr@ yields -- the next higher address that fulfills the alignment constraint. An alignment @@ -99,17 +70,24 @@ -- is idempotent. -- -- Wraps: @Foreign.Ptr.@'FP.alignPtr' -alignPtr ∷ RegionalPtr α r → Int → RegionalPtr α r -alignPtr rPtr n = mapRegionalPtr (\ptr → FP.alignPtr ptr n) rPtr +alignPtr ∷ AllocatedPointer pointer ⇒ pointer α r → Int → pointer α r +alignPtr pointer n = mapPointer (\ptr → FP.alignPtr ptr n) pointer +-- | Advances the given address by the given offset in bytes. +-- +-- Wraps: @Foreign.Ptr.@'FP.plusPtr' +plusPtr ∷ AllocatedPointer pointer ⇒ pointer α r → Int → pointer β r +plusPtr pointer n = mapPointer (\ptr → FP.plusPtr ptr n) pointer + -- | 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 rPtr1 rPtr2 = FP.minusPtr (unsafePtr rPtr1) (unsafePtr rPtr2) +minusPtr ∷ AllocatedPointer pointer ⇒ pointer α r1 → pointer β r2 → Int +minusPtr pointer1 pointer2 = FP.minusPtr (unsafePtr pointer1) + (unsafePtr pointer2) -- 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 @@ -1,6 +1,8 @@ -{-# LANGUAGE UnicodeSyntax +{-# LANGUAGE CPP + , UnicodeSyntax , NoImplicitPrelude , KindSignatures + , RankNTypes #-} ------------------------------------------------------------------------------- @@ -15,14 +17,30 @@ module Foreign.Ptr.Region.Internal ( -- * Regional pointers RegionalPtr(RegionalPtr) - - -- * Unsafely constructing regional pointers , unsafeRegionalPtr - , unsafePureRegionalPtr + , wrapMalloc + -- * Null pointers + , nullPtr, NullPtr + + -- * Foreign regional pointers + , LocalPtr + , wrapAlloca, wrapAlloca2 + + -- * Wrapping @CStringLen@ operations + , wrapPeekStringLen + , wrapNewStringLen + , wrapWithStringLen + -- * Unsafe utility functions for lifting operations on @Ptrs@ to @RegionalPtrs@ - , unsafePtr + , Pointer(unsafePtr, mapPointer) + , unsafeWrap, unsafeWrap2, unsafeWrap3 + + , unsafeWrap2flp + + -- * Pointers to allocated memory + , AllocatedPointer ) where @@ -31,92 +49,221 @@ -------------------------------------------------------------------------------- -- from base: -import Control.Monad ( return, liftM ) -import Data.Function ( ($) ) -import Data.Maybe ( Maybe(Nothing, Just) ) -import System.IO ( IO ) -import Foreign.Ptr ( Ptr ) +import Control.Monad ( return, liftM ) +import Control.Arrow ( first ) +import Data.Function ( ($), flip ) +import Data.Int ( Int ) +import Data.Char ( String ) +import System.IO ( IO ) +import Foreign.Ptr ( Ptr ) +import qualified Foreign.Ptr as FP ( nullPtr ) +import Foreign.Marshal.Alloc ( free ) +#if __GLASGOW_HASKELL__ < 700 +import Control.Monad ( (>>=), fail ) +#endif + -- from base-unicode-symbols: -import Data.Function.Unicode ( (∘) ) +import Data.Function.Unicode ( (∘) ) -- from transformers: -import Control.Monad.IO.Class ( MonadIO, liftIO ) +import Control.Monad.IO.Class ( MonadIO, liftIO ) -- from regions: import Control.Monad.Trans.Region.OnExit ( FinalizerHandle, Finalizer, onExit ) -import Control.Monad.Trans.Region ( RegionT, RootRegion, Dup(dup) ) +import Control.Monad.Trans.Region ( RegionT + , AncestorRegion + , RootRegion + , LocalRegion, Local + , Dup(dup) + ) +import Control.Monad.Trans.Region.Unsafe ( unsafeStripLocal ) +-- from monad-control: +import Control.Monad.IO.Control ( MonadControlIO, controlIO, liftIOOp ) +#if MIN_VERSION_base(4,3,0) +import Control.Exception.Control ( mask_ ) +#else +import Control.Exception.Control ( block ) + +mask_ ∷ MonadControlIO m ⇒ m a → m a +mask_ = block +#endif + + -------------------------------------------------------------------------------- -- * Regional pointers -------------------------------------------------------------------------------- --- | A regional handle to memory. This should provide a safer replacement for --- @Foreign.Ptr.'Ptr'@ -data RegionalPtr α (r ∷ * → *) = RegionalPtr !(Ptr α) !(Maybe (FinalizerHandle r)) +{-| +A regional pointer to memory. -instance Dup (RegionalPtr α) where - dup (RegionalPtr ptr Nothing) = return $ RegionalPtr ptr Nothing - dup (RegionalPtr ptr (Just ch)) = liftM (RegionalPtr ptr ∘ Just) $ dup ch +This should provide a safer replacement for @Foreign.Ptr.'Ptr'@ +-} +data RegionalPtr α (r ∷ * → *) = RegionalPtr !(Ptr α) !(FinalizerHandle r) +instance Dup (RegionalPtr α) where + dup (RegionalPtr ptr ch) = liftM (RegionalPtr ptr) (dup 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 performed when the region +terminates. --- | Construct a regional pointer from a native pointer --- and an @IO@ computation that finalizes the pointer (like @free ptr@) --- which is performed when the region terminates. --- --- This function is 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. +This function is 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 α → Finalizer → RegionT s pr (RegionalPtr α (RegionT s pr)) -unsafeRegionalPtr ptr finalize = liftM (RegionalPtr ptr ∘ Just) $ onExit finalize +unsafeRegionalPtr ptr finalize = liftM (RegionalPtr ptr) (onExit finalize) --- | Construct a regional pointer from a native pointer --- without registering a finalizer like @free ptr@. --- --- This function is unsafe because this library can't guarantee the finalisation --- of the pointer, you have to verify the correct finalisation yourself. +wrapMalloc ∷ MonadControlIO pr + ⇒ IO (Ptr α) → RegionT s pr (RegionalPtr α (RegionT s pr)) +wrapMalloc doMalloc = mask_ $ do + ptr ← liftIO doMalloc + unsafeRegionalPtr ptr (free ptr) + + +-------------------------------------------------------------------------------- +-- * Null pointers +-------------------------------------------------------------------------------- + +{-| +The constant @nullPtr@ is a pointer which 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 finalizer like \"@free nullPtr@\" +in the 'RegionT' monad. + +Finally note that the region parameter of the 'NullPtr' is set to +'RootRegion' which is the ancestor of any region. +This allows 'nullPtr' to be used in any region. +-} +nullPtr ∷ NullPtr α RootRegion +nullPtr = NullPtr FP.nullPtr + +newtype NullPtr α (r ∷ * → *) = NullPtr (Ptr α) + + +-------------------------------------------------------------------------------- +-- * Foreign regional pointers +-------------------------------------------------------------------------------- + +-- | A regional pointer to memory which was locally allocated +-- by one of the @alloca@-like functions. -- --- Note that the region parameter of the 'RegionalPtr' is set to 'RootRegion' --- which is the ancestor of any region. This allows the regional pointer to be --- used in any region. -unsafePureRegionalPtr ∷ Ptr α → RegionalPtr α RootRegion -unsafePureRegionalPtr ptr = RegionalPtr ptr Nothing +-- Note that a @LocalPtr@ can not be 'dup'licated to a parent region. +newtype LocalPtr α (r ∷ * → *) = LocalPtr (Ptr α) +wrapAlloca ∷ MonadControlIO pr + ⇒ ((Ptr α → IO (RegionT s pr β)) → IO (RegionT s pr β)) + → (∀ sl. LocalPtr α (LocalRegion sl s) → RegionT (Local s) pr β) + → RegionT s pr β +wrapAlloca doAlloca f = liftIOOp doAlloca $ + unsafeStripLocal ∘ f ∘ LocalPtr +wrapAlloca2 ∷ MonadControlIO pr + ⇒ ((γ → Ptr α → IO (RegionT s pr β)) → IO (RegionT s pr β)) + → (∀ sl. γ → LocalPtr α (LocalRegion sl s) → RegionT (Local s) pr β) + → RegionT s pr β +wrapAlloca2 doAlloca f = controlIO $ \runInIO → + doAlloca $ \s → + runInIO ∘ unsafeStripLocal ∘ f s ∘ LocalPtr + + -------------------------------------------------------------------------------- +-- * Wrapping @CStringLen@ operations +-------------------------------------------------------------------------------- + +wrapPeekStringLen ∷ (Pointer pointer, pr `AncestorRegion` cr, MonadIO cr) + ⇒ ((Ptr α, Int) → IO String) + → (pointer α pr, Int) → cr String +wrapPeekStringLen peekStringLen = liftIO ∘ peekStringLen ∘ first unsafePtr + +wrapNewStringLen ∷ MonadControlIO pr + ⇒ IO (Ptr α, Int) + → RegionT s pr (RegionalPtr α (RegionT s pr), Int) +wrapNewStringLen newStringLen = mask_ $ do + (ptr, len) ← liftIO newStringLen + rPtr ← unsafeRegionalPtr ptr (free ptr) + return (rPtr, len) + +wrapWithStringLen ∷ MonadControlIO pr + ⇒ (((Ptr α, Int) → IO (RegionT s pr β)) → IO (RegionT s pr β)) + → (∀ sl. (LocalPtr α (LocalRegion sl s), Int) → RegionT (Local s) pr β) + → RegionT s pr β +wrapWithStringLen withStringLen f = liftIOOp withStringLen $ + unsafeStripLocal ∘ f ∘ first LocalPtr + + +-------------------------------------------------------------------------------- -- * Utility functions for lifting operations on Ptrs to RegionalPtrs -------------------------------------------------------------------------------- --- | Retrieve the native pointer from a regional pointer. --- --- This function is unsafe because it both allows you to @free@ the pointer --- before the region terminates and use the pointer outside the region when it --- is already freed. -unsafePtr ∷ RegionalPtr α r → Ptr α -unsafePtr (RegionalPtr ptr _) = ptr +class Pointer (pointer ∷ * → (* → *) → *) where + -- | Retrieve the native pointer from a regional pointer. + -- + -- This function is unsafe because it allows you to both @free@ the pointer + -- before the region terminates and use the pointer outside the region when it + -- is already freed. + unsafePtr ∷ pointer α r → Ptr α -unsafeWrap ∷ MonadIO m - ⇒ (Ptr α → IO β) - → (RegionalPtr α r → m β) -unsafeWrap f rPtr = liftIO $ f (unsafePtr rPtr) + -- | Apply a /pure/ function to the inner pointer of a regional pointer. + mapPointer ∷ (Ptr α → Ptr β) → (pointer α r → pointer β r) -unsafeWrap2 ∷ MonadIO m - ⇒ (Ptr α → γ → IO β) - → (RegionalPtr α r → γ → m β) -unsafeWrap2 f rPtr x = liftIO $ f (unsafePtr rPtr) x +instance Pointer RegionalPtr where + unsafePtr (RegionalPtr ptr _) = ptr + mapPointer f (RegionalPtr ptr ch) = RegionalPtr (f ptr) ch -unsafeWrap3 ∷ MonadIO m - ⇒ (Ptr α → γ → δ → IO β) - → (RegionalPtr α r → γ → δ → m β) -unsafeWrap3 f rPtr x y = liftIO $ f (unsafePtr rPtr) x y +instance Pointer NullPtr where + unsafePtr (NullPtr ptr) = ptr + mapPointer f (NullPtr ptr) = NullPtr (f ptr) + +instance Pointer LocalPtr where + unsafePtr (LocalPtr ptr) = ptr + mapPointer f (LocalPtr ptr) = LocalPtr (f ptr) + +unsafeWrap ∷ (MonadIO m, Pointer pointer) + ⇒ (Ptr α → IO β) + → (pointer α r → m β) +unsafeWrap f pointer = liftIO $ f (unsafePtr pointer) + +unsafeWrap2 ∷ (MonadIO m, Pointer pointer) + ⇒ (Ptr α → γ → IO β) + → (pointer α r → γ → m β) +unsafeWrap2 f pointer x = liftIO $ f (unsafePtr pointer) x + +unsafeWrap3 ∷ (MonadIO m, Pointer pointer) + ⇒ (Ptr α → γ → δ → IO β) + → (pointer α r → γ → δ → m β) +unsafeWrap3 f pointer x y = liftIO $ f (unsafePtr pointer) x y + +unsafeWrap2flp ∷ (MonadIO m, Pointer pointer) + ⇒ (γ → Ptr α → IO β) + → (γ → pointer α r → m β) +unsafeWrap2flp = flip ∘ unsafeWrap2 ∘ flip + + +-------------------------------------------------------------------------------- +-- * Allocated pointers +-------------------------------------------------------------------------------- + +class Pointer pointer ⇒ PrivateAllocatedPointer pointer + +-- | Class of pointers which point to allocated memory. 'NullPtr' is the only +-- pointer which is not an instance of this class. +-- +-- The super class 'PrivateAllocatedPointer' is not exported by this module +-- which ensures you can't accidentally make 'NullPtr' an instance of this class. +class PrivateAllocatedPointer pointer ⇒ AllocatedPointer pointer + +instance PrivateAllocatedPointer RegionalPtr; instance AllocatedPointer RegionalPtr +instance PrivateAllocatedPointer LocalPtr; instance AllocatedPointer LocalPtr -- 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 @@ -11,22 +11,27 @@ -- @Ptr@ from a regional pointer and for lifting operations on @Ptrs@ to -- @RegionalPtrs@. -- --- ------------------------------------------------------------------------------- module Foreign.Ptr.Region.Unsafe ( -- * Unsafely constructing regional pointers unsafeRegionalPtr - , unsafePureRegionalPtr + -- * Wrapping @alloca@- and @malloc@-like functions + , wrapAlloca, wrapAlloca2 + , wrapMalloc + + -- * Wrapping @CStringLen@ operations + , wrapPeekStringLen + , wrapNewStringLen + , wrapWithStringLen + -- * Unsafe utility functions for lifting operations on @Ptrs@ to @RegionalPtrs@ , unsafePtr + , unsafeWrap, unsafeWrap2, unsafeWrap3 - ) where -import Foreign.Ptr.Region.Internal ( unsafeRegionalPtr - , unsafePureRegionalPtr + , unsafeWrap2flp + ) where - , unsafePtr - , unsafeWrap, unsafeWrap2, unsafeWrap3 - ) +import Foreign.Ptr.Region.Internal diff --git a/Foreign/Storable/Region.hs b/Foreign/Storable/Region.hs --- a/Foreign/Storable/Region.hs +++ b/Foreign/Storable/Region.hs @@ -37,7 +37,7 @@ import Control.Monad.Trans.Region ( AncestorRegion ) -- from ourselves: -import Foreign.Ptr.Region ( RegionalPtr ) +import Foreign.Ptr.Region ( AllocatedPointer ) import Foreign.Ptr.Region.Unsafe ( unsafeWrap, unsafeWrap2, unsafeWrap3 ) @@ -57,8 +57,10 @@ -- implementation of the function. -- -- Wraps: @Foreign.Storable.'FS.peekElemOff'@. -peekElemOff ∷ (pr `AncestorRegion` cr, Storable α, MonadIO cr) - ⇒ RegionalPtr α pr → Int → cr α +peekElemOff ∷ ( AllocatedPointer pointer, Storable α + , pr `AncestorRegion` cr, MonadIO cr + ) + ⇒ pointer α pr → Int → cr α peekElemOff = unsafeWrap2 FS.peekElemOff -- | Write a value to a memory area regarded as an array of values of the same @@ -68,8 +70,10 @@ -- > poke (addr `plusPtr` (idx * sizeOf x)) x -- -- Wraps: @Foreign.Storable.'FS.pokeElemOff'@. -pokeElemOff ∷ (pr `AncestorRegion` cr, Storable α, MonadIO cr) - ⇒ RegionalPtr α pr → Int → α → cr () +pokeElemOff ∷ ( AllocatedPointer pointer, Storable α + , pr `AncestorRegion` cr, MonadIO cr + ) + ⇒ pointer α pr → Int → α → cr () pokeElemOff = unsafeWrap3 FS.pokeElemOff -- | Read a value from a memory location given by a base address and offset. @@ -78,8 +82,10 @@ -- > peekByteOff addr off = peek (addr `plusPtr` off) -- -- Wraps: @Foreign.Storable.'FS.peekByteOff'@. -peekByteOff ∷ (pr `AncestorRegion` cr, Storable α, MonadIO cr) - ⇒ RegionalPtr β pr → Int → cr α +peekByteOff ∷ ( AllocatedPointer pointer, Storable α + , pr `AncestorRegion` cr, MonadIO cr + ) + ⇒ pointer β pr → Int → cr α peekByteOff = unsafeWrap2 FS.peekByteOff -- | Write a value to a memory location given by a base address and offset. The @@ -88,8 +94,10 @@ -- > pokeByteOff addr off x = poke (addr `plusPtr` off) x -- -- Wraps: @Foreign.Storable.'FS.pokeByteOff'@. -pokeByteOff ∷ (pr `AncestorRegion` cr, Storable α, MonadIO cr) - ⇒ RegionalPtr β pr → Int → α → cr () +pokeByteOff ∷ ( AllocatedPointer pointer, Storable α + , pr `AncestorRegion` cr, MonadIO cr + ) + ⇒ pointer β pr → Int → α → cr () pokeByteOff = unsafeWrap3 FS.pokeByteOff -- | Read a value from the given memory location. @@ -101,16 +109,20 @@ -- is fulfilled. -- -- Wraps: @Foreign.Storable.'FS.peek'@. -peek ∷ (pr `AncestorRegion` cr, Storable α, MonadIO cr) - ⇒ RegionalPtr α pr → cr α +peek ∷ ( AllocatedPointer pointer, Storable α + , pr `AncestorRegion` cr, MonadIO cr + ) + ⇒ pointer α pr → cr α peek = unsafeWrap FS.peek -- | Write the given value to the given memory location. Alignment restrictions -- might apply; see 'peek'. -- -- Wraps: @Foreign.Storable.'FS.poke'@. -poke ∷ (pr `AncestorRegion` cr, Storable α, MonadIO cr) - ⇒ RegionalPtr α pr → α → cr () +poke ∷ ( AllocatedPointer pointer, Storable α + , pr `AncestorRegion` cr, MonadIO cr + ) + ⇒ pointer α pr → α → cr () poke = unsafeWrap2 FS.poke 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.5 +version: 0.6 cabal-version: >=1.6 build-type: Custom license: BSD3 @@ -26,7 +26,7 @@ re-exported from this library. . This library provides wrappers around all the @Ptr@ functions - from the @Foreign.*@ modules from @base@. + from the @Foreign.*@ modules of the @base@ library. source-repository head Type: darcs @@ -36,9 +36,9 @@ GHC-Options: -Wall build-depends: base >= 4 && < 4.4 , base-unicode-symbols >= 0.1.1 && < 0.3 - , regions >= 0.8 && < 0.9 + , regions >= 0.9 && < 0.10 , transformers >= 0.2 && < 0.3 - , monad-peel >= 0.1 && < 0.2 + , monad-control >= 0.2 && < 0.3 exposed-modules: Foreign.Ptr.Region Foreign.Ptr.Region.Unsafe Foreign.Marshal.Alloc.Region