[commit: ghc] master: Weak: Don't require wrapping/unwrapping of finalizers (fb40926)
git at git.haskell.org
git at git.haskell.org
Fri Sep 25 10:40:24 UTC 2015
Repository : ssh://git@git.haskell.org/ghc
On branch : master
Link : http://ghc.haskell.org/trac/ghc/changeset/fb4092642f057f258d07cd6979925f4e2579eda6/ghc
>---------------------------------------------------------------
commit fb4092642f057f258d07cd6979925f4e2579eda6
Author: Ben Gamari <ben at smart-cactus.org>
Date: Wed Sep 23 14:36:40 2015 +0200
Weak: Don't require wrapping/unwrapping of finalizers
To quote Simon Marlow,
We don't expect users to ever write code that uses mkWeak# or
finalizeWeak#, we have safe interfaces to these. Let's document the type
unsafety and fix the problem with () without introducing any overhead.
Updates stm submodule.
>---------------------------------------------------------------
fb4092642f057f258d07cd6979925f4e2579eda6
compiler/prelude/primops.txt.pp | 10 ++++++++--
libraries/base/Control/Concurrent/MVar.hs | 5 +----
libraries/base/Data/IORef.hs | 5 +----
libraries/base/GHC/ForeignPtr.hs | 17 +++++------------
libraries/base/GHC/MVar.hs | 5 +----
libraries/base/GHC/Weak.hs | 7 ++-----
libraries/stm | 2 +-
7 files changed, 19 insertions(+), 32 deletions(-)
diff --git a/compiler/prelude/primops.txt.pp b/compiler/prelude/primops.txt.pp
index d1786a0..e060deb 100644
--- a/compiler/prelude/primops.txt.pp
+++ b/compiler/prelude/primops.txt.pp
@@ -2332,7 +2332,8 @@ primtype Weak# b
-- note that tyvar "o" denotes openAlphaTyVar
primop MkWeakOp "mkWeak#" GenPrimOp
- o -> b -> (State# RealWorld -> State# RealWorld) -> State# RealWorld -> (# State# RealWorld, Weak# b #)
+ o -> b -> (State# RealWorld -> (# State# RealWorld, c #))
+ -> State# RealWorld -> (# State# RealWorld, Weak# b #)
with
has_side_effects = True
out_of_line = True
@@ -2364,7 +2365,12 @@ primop DeRefWeakOp "deRefWeak#" GenPrimOp
primop FinalizeWeakOp "finalizeWeak#" GenPrimOp
Weak# a -> State# RealWorld -> (# State# RealWorld, Int#,
- (State# RealWorld -> State# RealWorld) #)
+ (State# RealWorld -> (# State# RealWorld, b #) ) #)
+ { Finalize a weak pointer. The return value is an unboxed tuple
+ containing the new state of the world and an "unboxed Maybe",
+ represented by an {\tt Int#} and a (possibly invalid) finalization
+ action. An {\tt Int#} of {\tt 1} indicates that the finalizer is valid. The
+ return value {\tt b} from the finalizer should be ignored. }
with
has_side_effects = True
out_of_line = True
diff --git a/libraries/base/Control/Concurrent/MVar.hs b/libraries/base/Control/Concurrent/MVar.hs
index 5ffac11..f76eaeb 100644
--- a/libraries/base/Control/Concurrent/MVar.hs
+++ b/libraries/base/Control/Concurrent/MVar.hs
@@ -271,7 +271,4 @@ addMVarFinalizer = GHC.MVar.addMVarFinalizer
-- @since 4.6.0.0
mkWeakMVar :: MVar a -> IO () -> IO (Weak (MVar a))
mkWeakMVar m@(MVar m#) (IO f) = IO $ \s ->
- case mkWeak# m# m finalizer s of (# s1, w #) -> (# s1, Weak w #)
- where
- finalizer :: State# RealWorld -> State# RealWorld
- finalizer s' = case f s' of (# s'', () #) -> s''
+ case mkWeak# m# m f s of (# s1, w #) -> (# s1, Weak w #)
diff --git a/libraries/base/Data/IORef.hs b/libraries/base/Data/IORef.hs
index bcd1a65..c6275f5 100644
--- a/libraries/base/Data/IORef.hs
+++ b/libraries/base/Data/IORef.hs
@@ -43,11 +43,8 @@ import GHC.Weak
-- |Make a 'Weak' pointer to an 'IORef', using the second argument as a finalizer
-- to run when 'IORef' is garbage-collected
mkWeakIORef :: IORef a -> IO () -> IO (Weak (IORef a))
-mkWeakIORef r@(IORef (STRef r#)) (IO f) = IO $ \s ->
+mkWeakIORef r@(IORef (STRef r#)) (IO finalizer) = IO $ \s ->
case mkWeak# r# r finalizer s of (# s1, w #) -> (# s1, Weak w #)
- where
- finalizer :: State# RealWorld -> State# RealWorld
- finalizer s' = case f s' of (# s'', () #) -> s''
-- |Mutate the contents of an 'IORef'.
--
diff --git a/libraries/base/GHC/ForeignPtr.hs b/libraries/base/GHC/ForeignPtr.hs
index a1ff1ba..d0688f0 100644
--- a/libraries/base/GHC/ForeignPtr.hs
+++ b/libraries/base/GHC/ForeignPtr.hs
@@ -296,14 +296,9 @@ addForeignPtrConcFinalizer_ (PlainForeignPtr r) finalizer = do
if noFinalizers
then IO $ \s ->
case r of { IORef (STRef r#) ->
- case mkWeak# r# () finalizer' s of { (# s1, _ #) ->
- (# s1, () #) }}
+ case mkWeak# r# () (unIO $ foreignPtrFinalizer r) s of {
+ (# s1, _ #) -> (# s1, () #) }}
else return ()
- where
- finalizer' :: State# RealWorld -> State# RealWorld
- finalizer' s =
- case unIO (foreignPtrFinalizer r) s of
- (# s', () #) -> s'
addForeignPtrConcFinalizer_ f@(MallocPtr fo r) finalizer = do
noFinalizers <- insertHaskellFinalizer r finalizer
if noFinalizers
@@ -312,10 +307,8 @@ addForeignPtrConcFinalizer_ f@(MallocPtr fo r) finalizer = do
(# s1, _ #) -> (# s1, () #)
else return ()
where
- finalizer' :: State# RealWorld -> State# RealWorld
- finalizer' s =
- case unIO (foreignPtrFinalizer r >> touch f) s of
- (# s', () #) -> s'
+ finalizer' :: State# RealWorld -> (# State# RealWorld, () #)
+ finalizer' = unIO (foreignPtrFinalizer r >> touch f)
addForeignPtrConcFinalizer_ _ _ =
error "GHC.ForeignPtr: attempt to add a finalizer to plain pointer"
@@ -375,7 +368,7 @@ foreignPtrFinalizer r = do
case fs of
NoFinalizers -> return ()
CFinalizers w -> IO $ \s -> case finalizeWeak# w s of
- (# s1, 1#, f #) -> case f s1 of s2 -> (# s2, () #)
+ (# s1, 1#, f #) -> f s1
(# s1, _, _ #) -> (# s1, () #)
HaskellFinalizers actions -> sequence_ actions
diff --git a/libraries/base/GHC/MVar.hs b/libraries/base/GHC/MVar.hs
index bdad179..6cbbe7b 100644
--- a/libraries/base/GHC/MVar.hs
+++ b/libraries/base/GHC/MVar.hs
@@ -177,8 +177,5 @@ isEmptyMVar (MVar mv#) = IO $ \ s# ->
-- "System.Mem.Weak" for more about finalizers.
addMVarFinalizer :: MVar a -> IO () -> IO ()
addMVarFinalizer (MVar m) (IO finalizer) =
- IO $ \s -> case mkWeak# m () finalizer' s of { (# s1, _ #) -> (# s1, () #) }
- where
- finalizer' :: State# RealWorld -> State# RealWorld
- finalizer' s' = case finalizer s' of (# s'', () #) -> s''
+ IO $ \s -> case mkWeak# m () finalizer s of { (# s1, _ #) -> (# s1, () #) }
diff --git a/libraries/base/GHC/Weak.hs b/libraries/base/GHC/Weak.hs
index b2c3273..8f886a6 100644
--- a/libraries/base/GHC/Weak.hs
+++ b/libraries/base/GHC/Weak.hs
@@ -101,10 +101,7 @@ mkWeak :: k -- ^ key
-> IO (Weak v) -- ^ returns: a weak pointer object
mkWeak key val (Just (IO finalizer)) = IO $ \s ->
- case mkWeak# key val finalizer' s of { (# s1, w #) -> (# s1, Weak w #) }
- where
- finalizer' :: State# RealWorld -> State# RealWorld
- finalizer' s' = case finalizer s' of (# s'', () #) -> s''
+ case mkWeak# key val finalizer s of { (# s1, w #) -> (# s1, Weak w #) }
mkWeak key val Nothing = IO $ \s ->
case mkWeakNoFinalizer# key val s of { (# s1, w #) -> (# s1, Weak w #) }
@@ -129,7 +126,7 @@ finalize :: Weak v -> IO ()
finalize (Weak w) = IO $ \s ->
case finalizeWeak# w s of
(# s1, 0#, _ #) -> (# s1, () #) -- already dead, or no finalizer
- (# s1, _, f #) -> case f s1 of s2 -> (# s2, () #)
+ (# s1, _, f #) -> f s1
{-
Instance Eq (Weak v) where
diff --git a/libraries/stm b/libraries/stm
index 8fb3b33..f7db2c3d 160000
--- a/libraries/stm
+++ b/libraries/stm
@@ -1 +1 @@
-Subproject commit 8fb3b3336971d784c091dbca674ae1401e506e76
+Subproject commit f7db2c3df86ec644e5e06baa8090a1cb525754e2
More information about the ghc-commits
mailing list