regional-pointers (empty) → 0.1
raw patch · 11 files changed
+1167/−0 lines, 11 filesdep +MonadCatchIO-transformersdep +basedep +base-unicode-symbolsbuild-type:Customsetup-changed
Dependencies added: MonadCatchIO-transformers, base, base-unicode-symbols, regions, transformers
Files
- Foreign/C/String/Region.hs +280/−0
- Foreign/Marshal/Alloc/Region.hs +131/−0
- Foreign/Marshal/Array/Region.hs +244/−0
- Foreign/Marshal/Utils/Region.hs +116/−0
- Foreign/Ptr/Region.hs +77/−0
- Foreign/Ptr/Region/Internal.hs +107/−0
- Foreign/Ptr/Region/Unsafe.hs +22/−0
- Foreign/Storable/Region.hs +79/−0
- LICENSE +31/−0
- Setup.hs +21/−0
- regional-pointers.cabal +59/−0
+ Foreign/C/String/Region.hs view
@@ -0,0 +1,280 @@+{-# LANGUAGE UnicodeSyntax+ , NoImplicitPrelude+ , RankNTypes+ , CPP+ #-}++-------------------------------------------------------------------------------+-- |+-- Module : Foreign.C.String.Region+-- Copyright : (c) 2010 Bas van Dijk+-- License : BSD3 (see the file LICENSE)+-- Maintainer : Bas van Dijk <v.dijk.bas@gmail.com>+--+-- Lifts functions and types from @Foreign.C.String@ to regional pointers.+--+-------------------------------------------------------------------------------++module Foreign.C.String.Region+ ( -- * Regional C Strings+ RegionalCString, RegionalCStringLen++ -- * Using a locale-dependent encoding+ , peekCString, peekCStringLen+ , newCString, newCStringLen+ , withCString, withCStringLen++ , charIsRepresentable++ -- * Using 8-bit characters+ , FCS.castCharToCChar+ , FCS.castCCharToChar++ , peekCAString, peekCAStringLen+ , newCAString, newCAStringLen+ , withCAString, withCAStringLen++ -- * C wide strings+ , RegionalCWString, RegionalCWStringLen+ , peekCWString, peekCWStringLen+ , newCWString, newCWStringLen+ , withCWString, withCWStringLen+ ) where+++--------------------------------------------------------------------------------+-- Imports+--------------------------------------------------------------------------------++-- from base:+import Prelude ( fromInteger, 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, (>>=), fail)+import Foreign.C.Types ( CChar, CWchar )+import Foreign.Storable ( Storable )+import qualified Foreign.C.String as FCS ( charIsRepresentable+ , peekCAString, peekCAStringLen+ , peekCWString, peekCWStringLen+ , castCharToCChar, castCCharToChar+ )++#ifdef __HADDOCK__+import Foreign.C.String ( CString, CStringLen+ , CWString, CWStringLen+ )+#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.Trans ( MonadIO, liftIO )++-- from MonadCatchIO-transformers:+import Control.Monad.CatchIO ( MonadCatchIO )++-- from regions:+import Control.Monad.Trans.Region ( RegionT, ParentOf )++-- from ourselves:+import Foreign.Marshal.Array.Region ( newArray0, newArray+ , withArray0, withArrayLen+ )+import Foreign.Ptr.Region ( RegionalPtr )+import Foreign.Ptr.Region.Unsafe ( unsafePtr, unsafeWrap )+++--------------------------------------------------------------------------------+-- 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++-- | 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)+++--------------------------------------------------------------------------------+-- Using a locale-dependent encoding+--------------------------------------------------------------------------------++peekCString ∷ (pr `ParentOf` cr, MonadIO cr)+ ⇒ RegionalCString pr → cr String+peekCString = peekCAString++peekCStringLen ∷ (pr `ParentOf` cr, MonadIO cr)+ ⇒ RegionalCStringLen pr → cr String+peekCStringLen = peekCAStringLen++newCString ∷ MonadCatchIO pr+ ⇒ String → RegionT s pr (RegionalCString (RegionT s pr))+newCString = newCAString++newCStringLen ∷ MonadCatchIO pr+ ⇒ String → RegionT s pr (RegionalCStringLen (RegionT s pr))+newCStringLen = newCAStringLen++withCString ∷ MonadCatchIO pr+ ⇒ String+ → (∀ s. RegionalCString (RegionT s pr) → RegionT s pr α)+ → pr α+withCString = withCAString++withCStringLen ∷ MonadCatchIO pr+ ⇒ String+ → (∀ s. RegionalCStringLen (RegionT s pr) → RegionT s pr α)+ → pr α+withCStringLen = withCAStringLen++charIsRepresentable ∷ MonadIO m ⇒ Char → m Bool+charIsRepresentable = liftIO ∘ FCS.charIsRepresentable+++--------------------------------------------------------------------------------+-- Using 8-bit characters+--------------------------------------------------------------------------------++peekCAString ∷ (pr `ParentOf` cr, MonadIO cr)+ ⇒ RegionalCString pr → cr String+peekCAString = unsafeWrap FCS.peekCAString++peekCAStringLen ∷ (pr `ParentOf` cr, MonadIO cr)+ ⇒ RegionalCStringLen pr → cr String+peekCAStringLen = liftIO ∘ FCS.peekCAStringLen ∘ first unsafePtr++newCAString ∷ MonadCatchIO pr+ ⇒ String → RegionT s pr (RegionalCString (RegionT s pr))+newCAString = newArray0 nUL ∘ charsToCChars++newCAStringLen ∷ MonadCatchIO pr+ ⇒ String → RegionT s pr (RegionalCStringLen (RegionT s pr))+newCAStringLen = newArrayLen ∘ charsToCChars++withCAString ∷ MonadCatchIO pr+ ⇒ String+ → (∀ s. RegionalCString (RegionT s pr) → RegionT s pr α)+ → pr α+withCAString = withArray0 nUL ∘ charsToCChars++withCAStringLen ∷ MonadCatchIO pr+ ⇒ String+ → (∀ s. RegionalCStringLen (RegionT s pr) → RegionT s pr α)+ → pr α+withCAStringLen str f = withArrayLen (charsToCChars str)+ $ \len ptr → f (ptr, len)+++--------------------------------------------------------------------------------+-- C wide strings+--------------------------------------------------------------------------------++-- | Handy type synonym for a regional pointer to an array of C wide characters+-- terminated by a NUL.+--+-- This should provide a safer replacement for @Foreign.C.String.'CWString'@.+type RegionalCWString r = RegionalPtr 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)++peekCWString ∷ (pr `ParentOf` cr, MonadIO cr)+ ⇒ RegionalCWString pr → cr String+peekCWString = unsafeWrap FCS.peekCWString++peekCWStringLen ∷ (pr `ParentOf` cr, MonadIO cr)+ ⇒ RegionalCWStringLen pr → cr String+peekCWStringLen = liftIO ∘ FCS.peekCWStringLen ∘ first unsafePtr++newCWString ∷ MonadCatchIO pr+ ⇒ String → RegionT s pr (RegionalCWString (RegionT s pr))+newCWString = newArray0 wNUL ∘ charsToCWchars++newCWStringLen ∷ MonadCatchIO pr+ ⇒ String → RegionT s pr (RegionalCWStringLen (RegionT s pr))+newCWStringLen = newArrayLen ∘ charsToCWchars++withCWString ∷ MonadCatchIO pr+ ⇒ String+ → (∀ s. RegionalCWString (RegionT s pr) → RegionT s pr α)+ → pr α+withCWString = withArray0 wNUL ∘ charsToCWchars++withCWStringLen ∷ MonadCatchIO pr+ ⇒ String+ → (∀ s. RegionalCWStringLen (RegionT s pr) → RegionT s pr α)+ → pr α+withCWStringLen str f = withArrayLen (charsToCWchars str)+ $ \len ptr → f (ptr, 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 α, MonadCatchIO pr)+ ⇒ [α] → RegionT s pr (RegionalPtr α (RegionT s pr), Int)+newArrayLen xs = do+ a <- newArray xs+ return (a, 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+++-- The End ---------------------------------------------------------------------
+ Foreign/Marshal/Alloc/Region.hs view
@@ -0,0 +1,131 @@+{-# LANGUAGE UnicodeSyntax+ , NoImplicitPrelude+ , RankNTypes+ , ScopedTypeVariables+ , CPP+ #-}++-------------------------------------------------------------------------------+-- |+-- Module : Foreign.Marshal.Alloc.Region+-- Copyright : (c) 2010 Bas van Dijk+-- License : BSD3 (see the file LICENSE)+-- Maintainer : Bas van Dijk <v.dijk.bas@gmail.com>+--+-------------------------------------------------------------------------------++module Foreign.Marshal.Alloc.Region+ ( -- * Local allocation+ alloca+ , allocaBytes++ -- * Dynamic allocation+ , malloc+ , mallocBytes++ -- | /TODO:/ Define and export: @realloc@ and @reallocBytes@.+ ) where+++--------------------------------------------------------------------------------+-- Imports+--------------------------------------------------------------------------------++-- from base:+import Prelude ( undefined )+import Data.Function ( ($) )+import Data.Int ( Int )+import Foreign.Storable ( Storable, sizeOf )++#ifdef __HADDOCK__+import qualified Foreign.Marshal.Alloc as FMA ( alloca, allocaBytes+ , malloc, mallocBytes+ )+#endif++-- from base-unicode-symbols:+import Data.Function.Unicode ( (∘) )++-- from MonadCatchIO-transformers:+import Control.Monad.CatchIO ( MonadCatchIO )++-- from regions:+import Control.Monad.Trans.Region ( RegionT, open, with )++-- from ourselves:+import Foreign.Ptr.Region ( Memory(Memory), RegionalPtr )+++--------------------------------------------------------------------------------+-- * 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.++This should provide a safer replacement for:+@Foreign.Marshal.Alloc.'FMA.alloca'@.++Note that: @alloca = 'allocaBytes' $ 'sizeOf' (undefined :: α)@+-}+alloca ∷ ∀ α pr β. (Storable α, MonadCatchIO pr)+ ⇒ (∀ s. RegionalPtr α (RegionT s pr) → RegionT s pr β)+ → pr β+alloca = allocaBytes $ sizeOf (undefined ∷ α)++{-| Convenience function which allocates the given number of bytes, applies the+given continuation function to the resulting regional pointer and runs the+resulting region.++This should provide a safer replacement for:+@Foreign.Marshal.Alloc.'FMA.allocaBytes'@.++Note that: @allocaBytes = 'with' . 'Memory'@+-}+allocaBytes ∷ ∀ α pr β. MonadCatchIO pr+ ⇒ Int+ → (∀ s. RegionalPtr α (RegionT s pr) → RegionT s pr β)+ → pr β+allocaBytes = with ∘ Memory+++--------------------------------------------------------------------------------+-- * Dynamic allocation+--------------------------------------------------------------------------------++{-| Convenience function which allocates sufficient memory to hold values of+type @α@ and returns a regional pointer to them.++This should provide a safer replacement for:+@Foreign.Marshal.Alloc.'FMA.malloc'@.++Note that: @malloc = 'mallocBytes' $ 'sizeOf' (undefined :: α)@+-}+malloc ∷ ∀ α pr s. (Storable α, MonadCatchIO pr)+ ⇒ RegionT s pr (RegionalPtr α (RegionT s pr))+malloc = mallocBytes $ sizeOf (undefined ∷ α)++{-| Convenience function which 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++-- TODO:+-- realloc ∷ (Storable β, pr `ParentOf` cr, MonadIO cr)+-- ⇒ RegionalPtr α pr → cr (RegionalPtr β pr)+-- realloc = ...+-- reallocBytes ∷ (pr `ParentOf` cr, MonadIO cr)+-- ⇒ RegionalPtr α pr → Int → cr (RegionalPtr α pr)+-- reallocBytes = ...+++-- The End ---------------------------------------------------------------------
+ Foreign/Marshal/Array/Region.hs view
@@ -0,0 +1,244 @@+{-# LANGUAGE UnicodeSyntax+ , NoImplicitPrelude+ , RankNTypes+ , ScopedTypeVariables+ #-}++-------------------------------------------------------------------------------+-- |+-- Module : Foreign.Marshal.Array.Region+-- Copyright : (c) 2010 Bas van Dijk+-- License : BSD3 (see the file LICENSE)+-- Maintainer : Bas van Dijk <v.dijk.bas@gmail.com>+--+-------------------------------------------------------------------------------++module Foreign.Marshal.Array.Region+ ( -- * Allocation+ mallocArray+ , mallocArray0+ , allocaArray+ , allocaArray0++ -- | /TODO:/ Define and export @reallocArray@ and @reallocArray0@++ -- * Marshalling+ , peekArray+ , peekArray0+ , pokeArray+ , pokeArray0++ -- * Combined allocation and marshalling+ , newArray+ , newArray0+ , withArray+ , withArray0+ , withArrayLen+ , withArrayLen0++ -- * Copying+ , copyArray+ , moveArray++ -- * Finding the length+ , lengthArray0++ -- * Indexing+ , advancePtr+ ) where+++--------------------------------------------------------------------------------+-- Imports+--------------------------------------------------------------------------------++-- from base:+import Prelude ( undefined, (*), succ )+import Data.Function ( ($), flip, const )+import Data.Int ( Int )+import Data.List ( length )+import Data.Eq ( Eq )+import Control.Monad ( return, (>>=), fail+ , (>>)+ )+import System.IO ( IO )+import Foreign.Ptr ( Ptr )+import Foreign.Storable ( Storable, sizeOf )+import qualified Foreign.Marshal.Array as FMA ( peekArray+ , peekArray0+ , pokeArray+ , pokeArray0+ , copyArray+ , moveArray+ , lengthArray0+ , advancePtr+ )+-- from base-unicode-symbols:+import Data.Function.Unicode ( (∘) )++-- from transformers:+import Control.Monad.Trans ( MonadIO, liftIO )++-- from MonadCatchIO-transformers:+import Control.Monad.CatchIO ( MonadCatchIO )++-- from regions:+import Control.Monad.Trans.Region ( RegionT , ParentOf )++-- from ourselves:+import Foreign.Ptr.Region ( RegionalPtr, mapRegionalPtr )+import Foreign.Ptr.Region.Unsafe ( unsafePtr, unsafeWrap2 )+import Foreign.Marshal.Alloc.Region ( mallocBytes, allocaBytes )+++--------------------------------------------------------------------------------+-- Allocation+--------------------------------------------------------------------------------++mallocArray ∷ ∀ α s pr. (Storable α, MonadCatchIO pr)+ ⇒ Int → RegionT s pr (RegionalPtr α (RegionT s pr))+mallocArray size = mallocBytes $ size * sizeOf (undefined ∷ α)++mallocArray0 ∷ (Storable α, MonadCatchIO pr)+ ⇒ Int → RegionT s pr (RegionalPtr α (RegionT s pr))+mallocArray0 = mallocArray ∘ succ++allocaArray ∷ ∀ α pr β. (Storable α, MonadCatchIO pr)+ ⇒ Int+ → (∀ s. RegionalPtr α (RegionT s pr) → RegionT s pr β)+ → pr β+allocaArray size = allocaBytes $ size * sizeOf (undefined ∷ α)++allocaArray0 ∷ ∀ α pr β. (Storable α, MonadCatchIO pr)+ ⇒ Int+ → (∀ s. RegionalPtr α (RegionT s pr) → RegionT s pr β)+ → pr β+allocaArray0 = allocaArray ∘ succ++-- TODO:+-- reallocArray ∷ Storable α ⇒ RegionalPtr α pr → Int → cr (RegionalPtr α pr)+-- reallocArray0 ∷ Storable α ⇒ RegionalPtr α pr → Int → cr (RegionalPtr α pr)+++--------------------------------------------------------------------------------+-- Marshalling+--------------------------------------------------------------------------------++unsafeWrap2flp ∷ MonadIO m+ ⇒ (γ → Ptr α → IO β)+ → (γ → RegionalPtr α r → m β)+unsafeWrap2flp = flip ∘ unsafeWrap2 ∘ flip++-- | 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'.+peekArray0 ∷ (Storable α, Eq α, pr `ParentOf` cr, MonadIO cr)+ ⇒ α → RegionalPtr α pr → cr [α]+peekArray0 = unsafeWrap2flp FMA.peekArray0++-- | 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'.+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+--------------------------------------------------------------------------------++newArray ∷ (Storable α, MonadCatchIO pr)+ ⇒ [α] → RegionT s pr (RegionalPtr α (RegionT s pr ))+newArray vals = do+ ptr ← mallocArray $ length vals+ pokeArray ptr vals+ return ptr++newArray0 ∷ (Storable α, MonadCatchIO pr)+ ⇒ α → [α] → RegionT s pr (RegionalPtr α (RegionT s pr))+newArray0 marker vals = do+ ptr ← mallocArray0 $ length vals+ pokeArray0 marker ptr vals+ return ptr++withArray ∷ (Storable α, MonadCatchIO pr)+ ⇒ [α]+ → (∀ s. RegionalPtr α (RegionT s pr) → RegionT s pr β)+ → pr β+withArray vals = withArrayLen vals ∘ const++withArray0 ∷ (Storable α, MonadCatchIO pr)+ ⇒ α+ → [α]+ → (∀ s. RegionalPtr α (RegionT s pr) → RegionT s pr β)+ → pr β+withArray0 marker vals = withArrayLen0 marker vals ∘ const++withArrayLen ∷ (Storable α, MonadCatchIO pr)+ ⇒ [α]+ → (∀ s. Int → RegionalPtr α (RegionT s pr) → RegionT s pr β)+ → pr β+withArrayLen vals f =+ allocaArray len $ \ptr → do+ pokeArray ptr vals+ res ← f len ptr+ return res+ where+ len = length vals++withArrayLen0 ∷ (Storable α, MonadCatchIO pr)+ ⇒ α+ → [α]+ → (∀ s. Int → RegionalPtr α (RegionT s pr) → RegionT s pr β)+ → pr β+withArrayLen0 marker vals f =+ allocaArray0 len $ \ptr → do+ pokeArray0 marker ptr vals+ res ← f len ptr+ return res+ where+ len = length vals+++--------------------------------------------------------------------------------+-- Copying+--------------------------------------------------------------------------------++-- | Wraps: @Foreign.Marshal.Array.@'FMA.copyArray'.+copyArray ∷ (Storable α, pr `ParentOf` cr, MonadIO cr)+ ⇒ RegionalPtr α pr → RegionalPtr α pr → Int → 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 ()+moveArray rp1 rp2 = liftIO ∘ FMA.moveArray (unsafePtr rp1) (unsafePtr rp2)+++--------------------------------------------------------------------------------+-- Finding the length+--------------------------------------------------------------------------------++-- | Wraps: @Foreign.Marshal.Array.@'FMA.lengthArray0'.+lengthArray0 ∷ (Storable α, Eq α, pr `ParentOf` cr, MonadIO cr)+ ⇒ α → RegionalPtr α pr → cr Int+lengthArray0 = unsafeWrap2flp FMA.lengthArray0+++--------------------------------------------------------------------------------+-- Indexing+--------------------------------------------------------------------------------++-- | Wraps: @Foreign.Marshal.Array.@'FMA.advancePtr'.+advancePtr ∷ Storable α ⇒ RegionalPtr α pr → Int → RegionalPtr α pr+advancePtr rp i = mapRegionalPtr (\p → FMA.advancePtr p i) rp+++-- The End ---------------------------------------------------------------------
+ Foreign/Marshal/Utils/Region.hs view
@@ -0,0 +1,116 @@+{-# LANGUAGE UnicodeSyntax+ , NoImplicitPrelude+ , RankNTypes+ #-}++-------------------------------------------------------------------------------+-- |+-- Module : Foreign.Marshal.Utils.Region+-- Copyright : (c) 2010 Bas van Dijk+-- License : BSD3 (see the file LICENSE)+-- Maintainer : Bas van Dijk <v.dijk.bas@gmail.com>+--+-------------------------------------------------------------------------------++module Foreign.Marshal.Utils.Region+ ( -- * General marshalling utilities+ -- ** Combined allocation and marshalling+ with+ , new++ -- * Marshalling of Boolean values (non-zero corresponds to 'True')+ , FMU.fromBool+ , FMU.toBool++ -- ** Marshalling of Maybe values+ -- | /TODO:/ Define and export: @maybeNew@, @maybeWith@ and @maybePeek@.++ -- ** Marshalling lists of storable objects+ -- | /TODO:/ Define and export: @withMany@.++ -- ** Haskellish interface to memcpy and memmove+ -- | (argument order: destination, source)+ , copyBytes+ , moveBytes+ ) where+++--------------------------------------------------------------------------------+-- Imports+--------------------------------------------------------------------------------++-- from base:+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+ )+-- from base-unicode-symbols:+import Data.Function.Unicode ( (∘) )++-- from transformers:+import Control.Monad.Trans ( MonadIO, liftIO )++-- from MonadCatchIO-transformers:+import Control.Monad.CatchIO ( MonadCatchIO )++-- from regions:+import Control.Monad.Trans.Region ( RegionT, ParentOf )++-- 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 )+++--------------------------------------------------------------------------------+-- * General marshalling utilities+--------------------------------------------------------------------------------++-- ** Combined allocation and marshalling++with ∷ (Storable α, MonadCatchIO pr)+ ⇒ α → (∀ s. RegionalPtr α (RegionT s pr) → RegionT s pr β) → pr β+with val f = alloca $ \ptr → poke ptr val >> f ptr++new ∷ (Storable α, MonadCatchIO pr)+ ⇒ α → RegionT s pr (RegionalPtr α (RegionT s pr))+new val = do ptr ← malloc+ poke ptr val+ return ptr++-- TODO:+-- -- ** Marshalling of Maybe values+-- maybeNew+-- maybeWith+-- maybePeek++-- TODO+-- -- ** Marshalling lists of storable objects+-- withMany :: (a -> (b -> res) -> res) -> [a] -> ([b] -> res) -> res++-- ** Haskellish interface to memcpy and memmove++copyBytes ∷ ( pr1 `ParentOf` cr+ , pr2 `ParentOf` cr+ , MonadIO cr+ )+ ⇒ RegionalPtr α pr1 -- ^ Destination+ → RegionalPtr α pr2 -- ^ Source+ → Int → cr ()+copyBytes rp1 rp2 = liftIO ∘ FMU.copyBytes (unsafePtr rp1) (unsafePtr rp2)++moveBytes ∷ ( pr1 `ParentOf` cr+ , pr2 `ParentOf` cr+ , MonadIO cr+ )+ ⇒ RegionalPtr α pr1 -- ^ Destination+ → RegionalPtr α pr2 -- ^ Source+ → Int → cr ()+moveBytes rp1 rp2 = liftIO ∘ FMU.moveBytes (unsafePtr rp1) (unsafePtr rp2)+++-- The End ---------------------------------------------------------------------
+ Foreign/Ptr/Region.hs view
@@ -0,0 +1,77 @@+{-# LANGUAGE UnicodeSyntax, NoImplicitPrelude #-}++-------------------------------------------------------------------------------+-- |+-- Module : Foreign.Ptr.Region+-- Copyright : (c) 2010 Bas van Dijk+-- License : BSD3 (see the file LICENSE)+-- Maintainer : Bas van Dijk <v.dijk.bas@gmail.com>+--+-------------------------------------------------------------------------------++module Foreign.Ptr.Region+ ( -- * Memory as a scarce resource+ Memory(..)+ , 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'.+ -}+ , module Control.Monad.Trans.Region++ -- * Pure functions on regional pointers+ , mapRegionalPtr++ , castPtr+ , plusPtr+ , alignPtr+ , minusPtr+ ) where+++--------------------------------------------------------------------------------+-- Imports+--------------------------------------------------------------------------------++-- from base:+import Data.Int ( Int )+import qualified Foreign.Ptr as FP ( castPtr, plusPtr, alignPtr, minusPtr )++-- from regions:+import Control.Monad.Trans.Region -- (re-exported entirely)++-- from ourselves:+import Foreign.Ptr.Region.Internal ( Memory(..), RegionalPtr, mapRegionalPtr )+import Foreign.Ptr.Region.Unsafe ( unsafePtr )+++--------------------------------------------------------------------------------+-- Pure functions on regional pointers+--------------------------------------------------------------------------------++-- | Wraps: @Foreign.Ptr.@'FP.castPtr'+castPtr ∷ RegionalPtr α r → RegionalPtr β r+castPtr = mapRegionalPtr FP.castPtr++-- | 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'+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+minusPtr rp1 rp2 = FP.minusPtr (unsafePtr rp1) (unsafePtr rp2)+++-- The End ---------------------------------------------------------------------
+ Foreign/Ptr/Region/Internal.hs view
@@ -0,0 +1,107 @@+{-# LANGUAGE UnicodeSyntax+ , NoImplicitPrelude+ , TypeFamilies+ , CPP+ #-}++-------------------------------------------------------------------------------+-- |+-- Module : Foreign.Ptr.Region.Internal+-- Copyright : (c) 2010 Bas van Dijk+-- License : BSD3 (see the file LICENSE)+-- Maintainer : Bas van Dijk <v.dijk.bas@gmail.com>+--+-------------------------------------------------------------------------------++module Foreign.Ptr.Region.Internal+ ( -- * Memory as a scarce resource+ Memory(..)+ , RegionalPtr++ -- * Utility functions for lifting operations on Ptrs to RegionalPtrs+ , mapRegionalPtr+ , unsafePtr+ , unsafeWrap, unsafeWrap2, unsafeWrap3+ ) where+++--------------------------------------------------------------------------------+-- Imports+--------------------------------------------------------------------------------++-- 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 ( (∘) )++-- from transformers:+import Control.Monad.Trans ( MonadIO, liftIO )++-- from regions:+import Control.Monad.Trans.Region ( RegionalHandle )+import Control.Monad.Trans.Region.Unsafe ( Resource+ , Handle+ , openResource+ , closeResource+ , internalHandle+ , mapInternalHandle+ )+#ifdef __HADDOCK__+import Control.Monad.Trans.Region ( open )+#endif+++--------------------------------------------------------------------------------+-- Memory as a scarce resource+--------------------------------------------------------------------------------++{-| 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 α }++ openResource = liftM Pointer ∘ FMA.mallocBytes ∘ size+ closeResource = FMA.free ∘ ptr++-- | 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+++--------------------------------------------------------------------------------+-- 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++unsafeWrap ∷ MonadIO m+ ⇒ (Ptr α → IO β)+ → (RegionalPtr α r → m β)+unsafeWrap f rp = liftIO $ f $ unsafePtr rp++unsafeWrap2 ∷ MonadIO m+ ⇒ (Ptr α → γ → IO β)+ → (RegionalPtr α r → γ → m β)+unsafeWrap2 f rp x = liftIO $ f (unsafePtr rp) x++unsafeWrap3 ∷ MonadIO m+ ⇒ (Ptr α → γ → δ → IO β)+ → (RegionalPtr α r → γ → δ → m β)+unsafeWrap3 f rp x y = liftIO $ f (unsafePtr rp) x y+++-- The End ---------------------------------------------------------------------
+ Foreign/Ptr/Region/Unsafe.hs view
@@ -0,0 +1,22 @@+{-# LANGUAGE NoImplicitPrelude #-}++-------------------------------------------------------------------------------+-- |+-- Module : Foreign.Ptr.Region.Unsfe+-- Copyright : (c) 2010 Bas van Dijk+-- 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.+--+-------------------------------------------------------------------------------++module Foreign.Ptr.Region.Unsafe+ ( unsafePtr+ , unsafeWrap, unsafeWrap2, unsafeWrap3+ ) where++import Foreign.Ptr.Region.Internal ( unsafePtr+ , unsafeWrap, unsafeWrap2, unsafeWrap3+ )
+ Foreign/Storable/Region.hs view
@@ -0,0 +1,79 @@+{-# LANGUAGE UnicodeSyntax, NoImplicitPrelude #-}++-------------------------------------------------------------------------------+-- |+-- Module : Foreign.Storable.Region+-- Copyright : (c) 2010 Bas van Dijk+-- License : BSD3 (see the file LICENSE)+-- Maintainer : Bas van Dijk <v.dijk.bas@gmail.com>+--+-- Lifts methods of the 'Storable' type class from @Foreign.Storable@ to+-- regional pointers.+--+-------------------------------------------------------------------------------++module Foreign.Storable.Region+ ( peekElemOff, pokeElemOff+ , peekByteOff, pokeByteOff+ , peek, poke+ ) where+++--------------------------------------------------------------------------------+-- Imports+--------------------------------------------------------------------------------++-- from base:+import Data.Int ( Int )+import Foreign.Storable ( Storable )+import qualified Foreign.Storable as FS ( peekElemOff, pokeElemOff+ , peekByteOff, pokeByteOff+ , peek, poke+ )+-- from transformers:+import Control.Monad.Trans ( MonadIO )++-- from regions:+import Control.Monad.Trans.Region ( ParentOf )++-- from ourselves:+import Foreign.Ptr.Region ( RegionalPtr )+import Foreign.Ptr.Region.Unsafe ( unsafeWrap, unsafeWrap2, unsafeWrap3 )+++--------------------------------------------------------------------------------+-- Storable methods lifted to a region+--------------------------------------------------------------------------------++-- | 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'@.+pokeElemOff ∷ (pr `ParentOf` cr, Storable α, MonadIO cr)+ ⇒ RegionalPtr α pr → Int → α → cr ()+pokeElemOff = unsafeWrap3 FS.pokeElemOff++-- | 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'@.+pokeByteOff ∷ (pr `ParentOf` cr, Storable α, MonadIO cr)+ ⇒ RegionalPtr β pr → Int → α → cr ()+pokeByteOff = unsafeWrap3 FS.pokeByteOff++-- | Wraps: @Foreign.Storable.'FS.peek'@.+peek ∷ (pr `ParentOf` cr, Storable α, MonadIO cr)+ ⇒ RegionalPtr α pr → cr α+peek = unsafeWrap FS.peek++-- | Wraps: @Foreign.Storable.'FS.poke'@.+poke ∷ (pr `ParentOf` cr, Storable α, MonadIO cr)+ ⇒ RegionalPtr α pr → α → cr ()+poke = unsafeWrap2 FS.poke+++-- The End ---------------------------------------------------------------------
+ LICENSE view
@@ -0,0 +1,31 @@+Copyright (c) 2009 Bas van Dijk++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are+met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * The name of Bas van Dijk and the names of contributors may NOT+ be used to endorse or promote products derived from this+ software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,21 @@+#! /usr/bin/env runhaskell++{-# OPTIONS -Wall #-}++import Distribution.Simple ( defaultMainWithHooks+ , simpleUserHooks+ , UserHooks(haddockHook)+ )+import Distribution.Simple.Setup ( HaddockFlags )+import Distribution.Simple.Program ( userSpecifyArgs )+import Distribution.Simple.LocalBuildInfo ( LocalBuildInfo(withPrograms) )+import Distribution.PackageDescription ( PackageDescription )++main :: IO ()+main = defaultMainWithHooks $ simpleUserHooks { haddockHook = haddockHook' }++-- Define __HADDOCK__ for CPP when running haddock.+haddockHook' :: PackageDescription -> LocalBuildInfo -> UserHooks -> HaddockFlags -> IO ()+haddockHook' pkg lbi = haddockHook simpleUserHooks pkg $ lbi { withPrograms = p }+ where+ p = userSpecifyArgs "haddock" ["--optghc=-D__HADDOCK__"] (withPrograms lbi)
+ regional-pointers.cabal view
@@ -0,0 +1,59 @@+name: regional-pointers+version: 0.1+cabal-version: >=1.6+build-type: Custom+license: BSD3+license-file: LICENSE+copyright: 2010 Bas van Dijk+author: Bas van Dijk+maintainer: Bas van Dijk <v.dijk.bas@gmail.com>+stability: experimental+category: System, Monadic Regions+synopsis: Regional memory pointers+description: The library allows you to allocate memory in a region yielding a+ regional pointer to it. When the region terminates all pointers+ are automatically freed. Most importantly, a pointer can't be+ returned from the region. So it's impossible to reference+ unallocated memory.++ .++ The primary technique used in this package is called \"Lightweight+ monadic regions\" which was invented by Oleg Kiselyov and+ Chung-chieh Shan. See:++ .++ <http://okmij.org/ftp/Haskell/regions.html#light-weight>++ .++ This technique is implemented in the @regions@ package which is+ re-exported from this library.++ .++ This library provides wrappers around all the @Ptr@ functions+ from the @Foreign.*@ modules from @base@.++source-repository head+ Type: darcs+ Location: http://code.haskell.org/~basvandijk/code/regional-pointers++Library+ GHC-Options: -Wall+ build-depends: base >= 4 && < 4.3+ , base-unicode-symbols >= 0.1.1 && < 0.2+ , regions == 0.3.*+ , transformers >= 0.1.4 && < 0.2+ , MonadCatchIO-transformers == 0.0.2.*+ exposed-modules: Foreign.Ptr.Region+ Foreign.Ptr.Region.Unsafe+ Foreign.Marshal.Alloc.Region+ Foreign.Marshal.Array.Region+ 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