diff --git a/Control/Monad/Trans/Region.hs b/Control/Monad/Trans/Region.hs --- a/Control/Monad/Trans/Region.hs +++ b/Control/Monad/Trans/Region.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE CPP #-} - ------------------------------------------------------------------------------- -- | -- Module : Control.Monad.Trans.Region @@ -26,9 +24,15 @@ -- * Ancestor relation between regions , AncestorRegion + + -- * Special regions + -- ** The root region , RootRegion - -- * Handy functions for writing monadic instances + -- ** Local regions + , LocalRegion, Local + + -- * Utilities for writing monadic instances , liftCallCC , mapRegionT , liftCatch diff --git a/Control/Monad/Trans/Region/Concurrent.hs b/Control/Monad/Trans/Region/Concurrent.hs deleted file mode 100644 --- a/Control/Monad/Trans/Region/Concurrent.hs +++ /dev/null @@ -1,39 +0,0 @@ -{-# LANGUAGE CPP #-} - -------------------------------------------------------------------------------- --- | --- Module : Control.Monad.Trans.Region.Concurrent --- Copyright : (c) 2009-2010 Bas van Dijk --- License : BSD3 (see the file LICENSE) --- Maintainer : Bas van Dijk --- --- Concurrently executing regions. --- --- This module exports functions with equivalent names from @Control.Concurrent@ --- and @GHC.Conc@. May I suggest you import this module qualified as in: --- --- @import qualified Control.Monad.Trans.Region.Concurrent as Region@ --- --------------------------------------------------------------------------------- - -module Control.Monad.Trans.Region.Concurrent - ( forkIO - , forkOS -#ifdef __GLASGOW_HASKELL__ - , forkOnIO -#if MIN_VERSION_base(4,3,0) - , forkIOUnmasked -#endif -#endif - ) where - -import Control.Monad.Trans.Region.Internal - ( forkIO - , forkOS -#ifdef __GLASGOW_HASKELL__ - , forkOnIO -#if MIN_VERSION_base(4,3,0) - , forkIOUnmasked -#endif -#endif - ) diff --git a/Control/Monad/Trans/Region/Internal.hs b/Control/Monad/Trans/Region/Internal.hs --- a/Control/Monad/Trans/Region/Internal.hs +++ b/Control/Monad/Trans/Region/Internal.hs @@ -11,10 +11,6 @@ , OverlappingInstances -- ,, ,, ,, #-} -#if MIN_VERSION_base(4,3,0) -{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-} -- For block and unblock -#endif - ------------------------------------------------------------------------------- -- | -- Module : Control.Monad.Trans.Region.Internal @@ -44,23 +40,20 @@ -- * Running regions , runRegionT - -- ** Forking regions - , forkIO - , forkOS -#ifdef __GLASGOW_HASKELL__ - , forkOnIO -#if MIN_VERSION_base(4,3,0) - , forkIOUnmasked -#endif -#endif -- * Duplication , Dup(dup) -- * Ancestor relation between regions , AncestorRegion + + -- * Special regions + -- ** The root region , RootRegion - -- * Handy functions for writing monadic instances + -- ** Local regions + , LocalRegion, Local, unsafeStripLocal + + -- * Utilities for writing monadic instances , liftCallCC , mapRegionT , liftCatch @@ -76,30 +69,22 @@ import Control.Applicative ( Applicative, Alternative ) import Control.Monad ( Monad, return, when, forM_, MonadPlus ) import Control.Monad.Fix ( MonadFix ) +import Control.Exception ( bracket ) import System.IO ( IO ) import Data.Function ( ($) ) import Data.Functor ( Functor ) import Data.Int ( Int ) -import Data.IORef ( IORef, newIORef, readIORef, modifyIORef, atomicModifyIORef ) -import Control.Concurrent ( ThreadId ) -import qualified Control.Concurrent ( forkIO, forkOS ) -#ifdef __GLASGOW_HASKELL__ -import qualified GHC.Conc ( forkOnIO ) -#endif - +import Data.IORef ( IORef, newIORef + , readIORef, modifyIORef, atomicModifyIORef + ) #if __GLASGOW_HASKELL__ < 700 import Prelude ( fromInteger ) import Control.Monad ( (>>=), (>>), fail ) #endif -#if MIN_VERSION_base(4,3,0) -import Control.Exception ( block, unblock ) -#endif - --- from monad-peel: -import Control.Monad.Trans.Peel ( MonadTransPeel ) -import Control.Monad.IO.Peel ( MonadPeelIO, liftIOOp_ ) -import Control.Exception.Peel ( bracket ) +-- from monad-control: +import Control.Monad.Trans.Control ( MonadTransControl ) +import Control.Monad.IO.Control ( MonadControlIO, controlIO ) -- from transformers: import Control.Monad.Trans.Class ( MonadTrans, lift ) @@ -114,14 +99,9 @@ -- Handling the new asynchronous exceptions API in base-4.3: #if MIN_VERSION_base(4,3,0) -import Control.Exception ( mask, mask_ ) +import Control.Exception ( mask_ ) #else -import Control.Exception ( blocked, block, unblock ) -import Data.Function ( id ) - -mask ∷ ((∀ α. IO α → IO α) → IO β) → IO β -mask io = blocked >>= \b → if b then io id else block $ io unblock - +import Control.Exception ( block ) mask_ ∷ IO α → IO α mask_ = block #endif @@ -144,9 +124,9 @@ , MonadPlus , MonadFix , MonadTrans - , MonadTransPeel + , MonadTransControl , MonadIO - , MonadPeelIO + , MonadControlIO ) unRegionT ∷ RegionT s pr α → ReaderT (IORef [RefCountedFinalizer]) pr α @@ -222,15 +202,11 @@ Note that it is possible to run a region inside another region. -} -runRegionT ∷ MonadPeelIO pr ⇒ (∀ s. RegionT s pr α) → pr α -runRegionT m = runRegionWith [] m - -runRegionWith ∷ ∀ s pr α. MonadPeelIO pr - ⇒ [RefCountedFinalizer] → RegionT s pr α → pr α -runRegionWith hs r = bracket (liftIO $ newIORef hs) - (liftIO ∘ after) - (runReaderT $ unRegionT r) +runRegionT ∷ MonadControlIO pr ⇒ (∀ s. RegionT s pr α) → pr α +runRegionT r = bracketIO before after thing where + before = newIORef [] + thing hsIORef = runReaderT (unRegionT r) hsIORef after hsIORef = do hs' ← readIORef hsIORef forM_ hs' $ \(RefCountedFinalizer finalizer refCntIORef) → do @@ -242,78 +218,17 @@ let refCnt' = refCnt - 1 in (refCnt', refCnt') - --------------------------------------------------------------------------------- --- ** Forking regions --------------------------------------------------------------------------------- - -{-| Return a region which executes the given region in a new thread. - -Note that the forked region has the same type variable @s@ as the resulting -region. This means that all values which can be referenced in the resulting -region can also be referenced in the forked region. - -For example the following is allowed: - -@ -'runRegionT' $ do - regionalHndl <- open resource - threadId <- Region.'forkIO' $ doSomethingWith regionalHndl - doSomethingElseWith regionalHndl -@ - -Note that the @regionalHndl@ and all other resources opened in the current -thread are closed only when the current thread or the forked thread terminates -whichever comes /last/. --} -forkIO ∷ MonadIO pr ⇒ RegionT s IO () → RegionT s pr ThreadId -forkIO = fork Control.Concurrent.forkIO - --- | Like 'forkIO' but internally uses @Control.Concurrent.'Control.Concurrent.forkOS'@. -forkOS ∷ MonadIO pr ⇒ RegionT s IO () → RegionT s pr ThreadId -forkOS = fork Control.Concurrent.forkOS - -#ifdef __GLASGOW_HASKELL__ --- | Like 'forkIO' but internally uses @GHC.Conc.'GHC.Conc.forkOnIO'@. -forkOnIO ∷ MonadIO pr ⇒ Int → RegionT s IO () → RegionT s pr ThreadId -forkOnIO = fork ∘ GHC.Conc.forkOnIO - -#if MIN_VERSION_base(4,3,0) --- | Like 'forkIO', but the child thread is created with asynchronous exceptions --- unmasked (see 'Control.Exception.mask'). -forkIOUnmasked ∷ MonadIO pr ⇒ RegionT s IO () → RegionT s pr ThreadId -forkIOUnmasked r = - RegionT $ ReaderT $ \hsIORef → liftIO $ do - hs ← readIORef hsIORef - block $ do - forM_ hs $ \(RefCountedFinalizer _ refCntIORef) → increment refCntIORef - Control.Concurrent.forkIO $ runRegionWith hs $ liftIOOp_ unblock r -#endif -#endif - -fork ∷ MonadIO pr - ⇒ (IO () → IO ThreadId) - → (RegionT s IO () → RegionT s pr ThreadId) -fork doFork = \r → - RegionT $ ReaderT $ \hsIORef → liftIO $ do - hs ← readIORef hsIORef - mask $ \restore → do - forM_ hs $ \(RefCountedFinalizer _ refCntIORef) → increment refCntIORef - doFork $ runRegionWith hs $ liftIOOp_ restore r - -increment ∷ IORef RefCnt → IO () -increment ioRef = do refCnt' ← atomicModifyIORef ioRef $ \refCnt → - let refCnt' = refCnt + 1 - in (refCnt', refCnt') - refCnt' `seq` return () +bracketIO ∷ MonadControlIO m ⇒ IO α → (α → IO ()) → (α → m β) → m β +bracketIO before after thing = controlIO $ \runInIO → + bracket before after (runInIO ∘ thing) -------------------------------------------------------------------------------- -- * Duplication -------------------------------------------------------------------------------- -{-| Duplicate an @α@ in the parent region. This @α@ will usually be -some type of regional handle. +{-| Duplicate an @h@ in the parent region. This @h@ will usually be some type of +regional handle. For example, suppose you run the following region: @@ -355,20 +270,31 @@ Back in the parent region you can safely operate on @r1hDup@. -} -class Dup α where +class Dup h where dup ∷ MonadIO ppr - ⇒ α (RegionT cs (RegionT ps ppr)) - → RegionT cs (RegionT ps ppr) - (α (RegionT ps ppr)) + ⇒ h (RegionT cs (RegionT ps ppr)) + → RegionT cs (RegionT ps ppr) + (h (RegionT ps ppr)) instance Dup FinalizerHandle where - dup (FinalizerHandle h@(RefCountedFinalizer _ refCntIORef)) = - lift $ RegionT $ ReaderT $ \hsIORef → liftIO $ mask_ $ do - increment refCntIORef - modifyIORef hsIORef (h:) - return $ FinalizerHandle h + dup = lift ∘ copy +copy ∷ MonadIO pr + ⇒ FinalizerHandle r + → RegionT s pr (FinalizerHandle (RegionT s pr)) +copy (FinalizerHandle h@(RefCountedFinalizer _ refCntIORef)) = + RegionT $ ReaderT $ \hsIORef → liftIO $ mask_ $ do + increment refCntIORef + modifyIORef hsIORef (h:) + return $ FinalizerHandle h +increment ∷ IORef RefCnt → IO () +increment ioRef = do refCnt' ← atomicModifyIORef ioRef $ \refCnt → + let refCnt' = refCnt + 1 + in (refCnt', refCnt') + refCnt' `seq` return () + + -------------------------------------------------------------------------------- -- * Ancestor relation between regions -------------------------------------------------------------------------------- @@ -409,7 +335,10 @@ instance InternalAncestorRegion (RegionT s m) (RegionT s m) instance (InternalAncestorRegion pr cr) ⇒ InternalAncestorRegion pr (RegionT s cr) + -------------------------------------------------------------------------------- +-- * The root region +-------------------------------------------------------------------------------- {-| The @RootRegion@ is the ancestor of any region. @@ -425,7 +354,56 @@ -------------------------------------------------------------------------------- --- * Handy functions for writing monadic instances +-- * Local regions +-------------------------------------------------------------------------------- + +{-| +A @LocalRegion@ is used to tag regional handles which are created locally. + +An example is the @LocalPtr@ in the @alloca@ function from the +@regional-pointers@ package: + +@ +alloca :: (Storable a, MonadControlIO pr) + => (forall sl. LocalPtr a ('LocalRegion' sl s) -> RegionT ('Local' s) pr b) + -> RegionT s pr b +@ + +The finalisation of the @LocalPtr@ is not performed by the @regions@ library but +is handled locally by @alloca@ instead. + +The type variable @sl@, which is only quantified over the continuation, ensures +that locally opened resources don't escape. +-} +data LocalRegion sl s α + +{-| +A type used to tag regions in which locally created handles (handles tagged with +'LocalRegion') can be used. + +Note than any handle which is created in a @RegionT (Local s)@ can be used +outside that region (@RegionT s@) and visa versa +(except for 'LocalRegion'-tagged handles). +-} +data Local s + +instance InternalAncestorRegion (LocalRegion sf s) (RegionT (Local s) m) + +instance InternalAncestorRegion (RegionT s m) (RegionT (Local s) m) +instance InternalAncestorRegion (RegionT (Local s) m) (RegionT s m) + +{-| +Convert a 'Local' region to a regular region. + +This function is unsafe because it allows you to use a 'LocalRegion'-tagged +handle outside its 'Local' region. +-} +unsafeStripLocal ∷ RegionT (Local s) pr α → RegionT s pr α +unsafeStripLocal = RegionT ∘ unRegionT + + +-------------------------------------------------------------------------------- +-- * Utilities for writing monadic instances -------------------------------------------------------------------------------- -- | Lift a @callCC@ operation to the new monad. diff --git a/Control/Monad/Trans/Region/OnExit.hs b/Control/Monad/Trans/Region/OnExit.hs --- a/Control/Monad/Trans/Region/OnExit.hs +++ b/Control/Monad/Trans/Region/OnExit.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE UnicodeSyntax #-} - ------------------------------------------------------------------------------- -- | -- Module : Control.Monad.Trans.Region.OnExit diff --git a/Control/Monad/Trans/Region/Unsafe.hs b/Control/Monad/Trans/Region/Unsafe.hs new file mode 100644 --- /dev/null +++ b/Control/Monad/Trans/Region/Unsafe.hs @@ -0,0 +1,13 @@ +------------------------------------------------------------------------------- +-- | +-- Module : Control.Monad.Trans.Region.Unsafe +-- Copyright : (c) 2009-2010 Bas van Dijk +-- License : BSD3 (see the file LICENSE) +-- Maintainer : Bas van Dijk +-- +-- +-------------------------------------------------------------------------------- + +module Control.Monad.Trans.Region.Unsafe ( unsafeStripLocal ) where + +import Control.Monad.Trans.Region.Internal ( unsafeStripLocal ) diff --git a/Data/RegionRef.hs b/Data/RegionRef.hs deleted file mode 100644 --- a/Data/RegionRef.hs +++ /dev/null @@ -1,105 +0,0 @@ -{-# LANGUAGE UnicodeSyntax, NoImplicitPrelude, KindSignatures #-} - -------------------------------------------------------------------------------- --- | --- Module : Data.RegionRef --- Copyright : (c) 2009-2010 Bas van Dijk --- License : BSD3 (see the file LICENSE) --- Maintainer : Bas van Dijk --- --- A mutable variable in the region monad that should provide a safer --- replacement for an 'IORef' because you can't use it outside the region in --- which it was created (unless you explicitly duplicate it). --- --------------------------------------------------------------------------------- - -module Data.RegionRef - ( RegionRef - , pureDup - , newRegionRef - , readRegionRef - , writeRegionRef - , modifyRegionRef - , atomicModifyRegionRef - ) where - --------------------------------------------------------------------------------- --- Imports --------------------------------------------------------------------------------- - --- from base: -import Data.Function ( ($) ) -import Control.Monad ( liftM ) -import Data.Eq ( Eq ) -import Data.IORef ( IORef - , newIORef - , readIORef, writeIORef - , modifyIORef, atomicModifyIORef - ) - --- from base-unicode-symbols: -import Data.Function.Unicode ( (∘) ) - --- from transformers: -import Control.Monad.IO.Class ( MonadIO, liftIO ) - --- from ourselves: -import Control.Monad.Trans.Region ( RegionT, AncestorRegion ) - - --------------------------------------------------------------------------------- --- Mutable references in the region monad --------------------------------------------------------------------------------- - --- | A mutable variable storing a value of type @α@ which can only be used --- in region @r@, @r@'s children or @r@'s parent when you duplicate it using --- 'pureDup'. -newtype RegionRef (r ∷ * → *) α = RegionRef { unRegionRef ∷ IORef α } - deriving ( Eq ) - --- | Transform the region type @r@ of the regional reference to @r@'s parent so --- that it can be used in that region. -pureDup ∷ RegionRef (RegionT cs (RegionT ps ppr)) α - → RegionRef (RegionT ps ppr) α -pureDup = RegionRef ∘ unRegionRef - -{-| Yield a regional computation that returns a new regional reference that -stores the given value. - -Note that the reference is parameterized by the same region in which it was -created. This ensures you can never use this reference outside that region and -it allows you to use this reference in a child region of that region --} -newRegionRef ∷ MonadIO pr - ⇒ α → RegionT s pr (RegionRef (RegionT s pr) α) -newRegionRef = liftM RegionRef ∘ liftIO ∘ newIORef - --- | Read the value of the given regional reference. -readRegionRef ∷ (pr `AncestorRegion` cr, MonadIO cr) - ⇒ RegionRef pr α → cr α -readRegionRef = liftIO ∘ readIORef ∘ unRegionRef - --- | Write a new value into the given regional reference. -writeRegionRef ∷ (pr `AncestorRegion` cr, MonadIO cr) - ⇒ RegionRef pr α → α → cr () -writeRegionRef ref x = liftIO $ writeIORef (unRegionRef ref) x - --- | Mutate the contents of the given regional reference using the given --- function. -modifyRegionRef ∷ (pr `AncestorRegion` cr, MonadIO cr) - ⇒ RegionRef pr α → (α → α) → cr () -modifyRegionRef ref f = liftIO $ modifyIORef (unRegionRef ref) f - -{-| Atomically modifies the contents of the given regional reference using the -given function. - -This function is useful for using a regional reference in a safe way in a -multithreaded program. If you only have one regional reference, then using -@atomicModifyRegionRef@ to access and modify it will prevent race conditions. --} -atomicModifyRegionRef ∷ (pr `AncestorRegion` cr, MonadIO cr) - ⇒ RegionRef pr α → (α → (α, β)) → cr β -atomicModifyRegionRef ref f = liftIO $ atomicModifyIORef (unRegionRef ref) f - - --- The End --------------------------------------------------------------------- diff --git a/regions.cabal b/regions.cabal --- a/regions.cabal +++ b/regions.cabal @@ -1,5 +1,5 @@ name: regions -version: 0.8.1 +version: 0.9 cabal-version: >=1.6 build-type: Simple license: BSD3 @@ -39,9 +39,8 @@ build-depends: base >= 4 && < 4.4 , base-unicode-symbols >= 0.1.1 && < 0.3 , transformers >= 0.2 && < 0.3 - , monad-peel >= 0.1 && < 0.2 + , monad-control >= 0.2 && < 0.3 exposed-modules: Control.Monad.Trans.Region - Control.Monad.Trans.Region.Concurrent Control.Monad.Trans.Region.OnExit - Data.RegionRef + Control.Monad.Trans.Region.Unsafe other-modules: Control.Monad.Trans.Region.Internal