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
-- 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
......
......@@ -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 #)
......@@ -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'.
--
......
......@@ -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
......
......@@ -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, () #) }
......@@ -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
......
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