X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=Foreign%2FMarshal%2FPool.hs;h=f15d048a9518b13a2cdb2f0f82d311a993e47f5a;hb=4c29f6f110d23b890567b8696a964bb212eba52e;hp=754b48419c403fb77e851e3a0e1217f8fffc188f;hpb=b3768993c0fa634d54a15a0eefa370208110be21;p=ghc-base.git diff --git a/Foreign/Marshal/Pool.hs b/Foreign/Marshal/Pool.hs index 754b484..f15d048 100644 --- a/Foreign/Marshal/Pool.hs +++ b/Foreign/Marshal/Pool.hs @@ -48,8 +48,8 @@ module Foreign.Marshal.Pool ( import GHC.Base ( Int, Monad(..), (.), not ) import GHC.Err ( undefined ) import GHC.Exception ( throw ) -import GHC.IOBase ( IO, IORef, newIORef, readIORef, writeIORef - block, unblock, catchAny ) +import GHC.IO ( IO, mask, catchAny ) +import GHC.IORef ( IORef, newIORef, readIORef, writeIORef ) import GHC.List ( elem, length ) import GHC.Num ( Num(..) ) #else @@ -57,7 +57,7 @@ import Data.IORef ( IORef, newIORef, readIORef, writeIORef ) #if defined(__NHC__) import IO ( bracket ) #else -import Control.Exception ( bracket ) +import Control.Exception.Base ( bracket ) #endif #endif @@ -97,10 +97,10 @@ freePool (Pool pool) = readIORef pool >>= freeAll withPool :: (Pool -> IO b) -> IO b #ifdef __GLASGOW_HASKELL__ withPool act = -- ATTENTION: cut-n-paste from Control.Exception below! - block (do + mask (\restore -> do pool <- newPool val <- catchAny - (unblock (act pool)) + (restore (act pool)) (\e -> do freePool pool; throw e) freePool pool return val) @@ -143,7 +143,7 @@ pooledRealloc = pr undefined pooledReallocBytes :: Pool -> Ptr a -> Int -> IO (Ptr a) pooledReallocBytes (Pool pool) ptr size = do let cPtr = castPtr ptr - throwIf (not . (cPtr `elem`)) (\_ -> "pointer not in pool") (readIORef pool) + _ <- throwIf (not . (cPtr `elem`)) (\_ -> "pointer not in pool") (readIORef pool) newPtr <- reallocBytes cPtr size ptrs <- readIORef pool writeIORef pool (newPtr : delete cPtr ptrs)