Commit fb409264 authored by Ben Gamari's avatar Ben Gamari 🐢

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.
parent 1395185f
...@@ -2332,7 +2332,8 @@ primtype Weak# b ...@@ -2332,7 +2332,8 @@ primtype Weak# b
-- note that tyvar "o" denotes openAlphaTyVar -- note that tyvar "o" denotes openAlphaTyVar
primop MkWeakOp "mkWeak#" GenPrimOp 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 with
has_side_effects = True has_side_effects = True
out_of_line = True out_of_line = True
...@@ -2364,7 +2365,12 @@ primop DeRefWeakOp "deRefWeak#" GenPrimOp ...@@ -2364,7 +2365,12 @@ primop DeRefWeakOp "deRefWeak#" GenPrimOp
primop FinalizeWeakOp "finalizeWeak#" GenPrimOp primop FinalizeWeakOp "finalizeWeak#" GenPrimOp
Weak# a -> State# RealWorld -> (# State# RealWorld, Int#, 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 with
has_side_effects = True has_side_effects = True
out_of_line = True out_of_line = True
......
...@@ -271,7 +271,4 @@ addMVarFinalizer = GHC.MVar.addMVarFinalizer ...@@ -271,7 +271,4 @@ addMVarFinalizer = GHC.MVar.addMVarFinalizer
-- @since 4.6.0.0 -- @since 4.6.0.0
mkWeakMVar :: MVar a -> IO () -> IO (Weak (MVar a)) mkWeakMVar :: MVar a -> IO () -> IO (Weak (MVar a))
mkWeakMVar m@(MVar m#) (IO f) = IO $ \s -> mkWeakMVar m@(MVar m#) (IO f) = IO $ \s ->
case mkWeak# m# m finalizer s of (# s1, w #) -> (# s1, Weak w #) case mkWeak# m# m f s of (# s1, w #) -> (# s1, Weak w #)
where
finalizer :: State# RealWorld -> State# RealWorld
finalizer s' = case f s' of (# s'', () #) -> s''
...@@ -43,11 +43,8 @@ import GHC.Weak ...@@ -43,11 +43,8 @@ import GHC.Weak
-- |Make a 'Weak' pointer to an 'IORef', using the second argument as a finalizer -- |Make a 'Weak' pointer to an 'IORef', using the second argument as a finalizer
-- to run when 'IORef' is garbage-collected -- to run when 'IORef' is garbage-collected
mkWeakIORef :: IORef a -> IO () -> IO (Weak (IORef a)) 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 #) 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'. -- |Mutate the contents of an 'IORef'.
-- --
......
...@@ -296,14 +296,9 @@ addForeignPtrConcFinalizer_ (PlainForeignPtr r) finalizer = do ...@@ -296,14 +296,9 @@ addForeignPtrConcFinalizer_ (PlainForeignPtr r) finalizer = do
if noFinalizers if noFinalizers
then IO $ \s -> then IO $ \s ->
case r of { IORef (STRef r#) -> case r of { IORef (STRef r#) ->
case mkWeak# r# () finalizer' s of { (# s1, _ #) -> case mkWeak# r# () (unIO $ foreignPtrFinalizer r) s of {
(# s1, () #) }} (# s1, _ #) -> (# s1, () #) }}
else return () 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 addForeignPtrConcFinalizer_ f@(MallocPtr fo r) finalizer = do
noFinalizers <- insertHaskellFinalizer r finalizer noFinalizers <- insertHaskellFinalizer r finalizer
if noFinalizers if noFinalizers
...@@ -312,10 +307,8 @@ addForeignPtrConcFinalizer_ f@(MallocPtr fo r) finalizer = do ...@@ -312,10 +307,8 @@ addForeignPtrConcFinalizer_ f@(MallocPtr fo r) finalizer = do
(# s1, _ #) -> (# s1, () #) (# s1, _ #) -> (# s1, () #)
else return () else return ()
where where
finalizer' :: State# RealWorld -> State# RealWorld finalizer' :: State# RealWorld -> (# State# RealWorld, () #)
finalizer' s = finalizer' = unIO (foreignPtrFinalizer r >> touch f)
case unIO (foreignPtrFinalizer r >> touch f) s of
(# s', () #) -> s'
addForeignPtrConcFinalizer_ _ _ = addForeignPtrConcFinalizer_ _ _ =
error "GHC.ForeignPtr: attempt to add a finalizer to plain pointer" error "GHC.ForeignPtr: attempt to add a finalizer to plain pointer"
...@@ -375,7 +368,7 @@ foreignPtrFinalizer r = do ...@@ -375,7 +368,7 @@ foreignPtrFinalizer r = do
case fs of case fs of
NoFinalizers -> return () NoFinalizers -> return ()
CFinalizers w -> IO $ \s -> case finalizeWeak# w s of 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, () #) (# s1, _, _ #) -> (# s1, () #)
HaskellFinalizers actions -> sequence_ actions HaskellFinalizers actions -> sequence_ actions
......
...@@ -177,8 +177,5 @@ isEmptyMVar (MVar mv#) = IO $ \ s# -> ...@@ -177,8 +177,5 @@ isEmptyMVar (MVar mv#) = IO $ \ s# ->
-- "System.Mem.Weak" for more about finalizers. -- "System.Mem.Weak" for more about finalizers.
addMVarFinalizer :: MVar a -> IO () -> IO () addMVarFinalizer :: MVar a -> IO () -> IO ()
addMVarFinalizer (MVar m) (IO finalizer) = addMVarFinalizer (MVar m) (IO finalizer) =
IO $ \s -> case mkWeak# m () finalizer' s of { (# s1, _ #) -> (# s1, () #) } IO $ \s -> case mkWeak# m () finalizer s of { (# s1, _ #) -> (# s1, () #) }
where
finalizer' :: State# RealWorld -> State# RealWorld
finalizer' s' = case finalizer s' of (# s'', () #) -> s''
...@@ -101,10 +101,7 @@ mkWeak :: k -- ^ key ...@@ -101,10 +101,7 @@ mkWeak :: k -- ^ key
-> IO (Weak v) -- ^ returns: a weak pointer object -> IO (Weak v) -- ^ returns: a weak pointer object
mkWeak key val (Just (IO finalizer)) = IO $ \s -> mkWeak key val (Just (IO finalizer)) = IO $ \s ->
case mkWeak# key val finalizer' s of { (# s1, w #) -> (# s1, Weak w #) } 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''
mkWeak key val Nothing = IO $ \s -> mkWeak key val Nothing = IO $ \s ->
case mkWeakNoFinalizer# key val s of { (# s1, w #) -> (# s1, Weak w #) } case mkWeakNoFinalizer# key val s of { (# s1, w #) -> (# s1, Weak w #) }
...@@ -129,7 +126,7 @@ finalize :: Weak v -> IO () ...@@ -129,7 +126,7 @@ finalize :: Weak v -> IO ()
finalize (Weak w) = IO $ \s -> finalize (Weak w) = IO $ \s ->
case finalizeWeak# w s of case finalizeWeak# w s of
(# s1, 0#, _ #) -> (# s1, () #) -- already dead, or no finalizer (# 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 Instance Eq (Weak v) where
......
Subproject commit 8fb3b3336971d784c091dbca674ae1401e506e76 Subproject commit f7db2c3df86ec644e5e06baa8090a1cb525754e2
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment