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

Remove references to () from types of mkWeak# and friends

Previously the types needlessly used (), which is defined ghc-prim,
leading to unfortunate import cycles. See #10867 for details.

Updates stm submodule.
parent 79f57325
......@@ -2081,7 +2081,7 @@ primop CatchSTMOp "catchSTM#" GenPrimOp
primop Check "check#" GenPrimOp
(State# RealWorld -> (# State# RealWorld, a #) )
-> (State# RealWorld -> (# State# RealWorld, () #) )
-> (State# RealWorld -> State# RealWorld)
with
out_of_line = True
has_side_effects = True
......@@ -2332,7 +2332,7 @@ primtype Weak# b
-- note that tyvar "o" denotes openAlphaTyVar
primop MkWeakOp "mkWeak#" GenPrimOp
o -> b -> c -> State# RealWorld -> (# State# RealWorld, Weak# b #)
o -> b -> (State# RealWorld -> State# RealWorld) -> State# RealWorld -> (# State# RealWorld, Weak# b #)
with
has_side_effects = True
out_of_line = True
......@@ -2364,7 +2364,7 @@ primop DeRefWeakOp "deRefWeak#" GenPrimOp
primop FinalizeWeakOp "finalizeWeak#" GenPrimOp
Weak# a -> State# RealWorld -> (# State# RealWorld, Int#,
(State# RealWorld -> (# State# RealWorld, () #)) #)
(State# RealWorld -> State# RealWorld) #)
with
has_side_effects = True
out_of_line = True
......
......@@ -270,5 +270,8 @@ addMVarFinalizer = GHC.MVar.addMVarFinalizer
--
-- @since 4.6.0.0
mkWeakMVar :: MVar a -> IO () -> IO (Weak (MVar a))
mkWeakMVar m@(MVar m#) f = IO $ \s ->
case mkWeak# m# m f s of (# s1, w #) -> (# s1, Weak w #)
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''
......@@ -43,8 +43,11 @@ 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#)) f = IO $ \s ->
case mkWeak# r# r f s of (# s1, w #) -> (# s1, Weak w #)
mkWeakIORef r@(IORef (STRef r#)) (IO f) = 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'.
--
......
......@@ -748,7 +748,7 @@ catchSTM (STM m) handler = STM $ catchSTM# m handler'
-- subsequent transcations, (ii) the invariant failure is indicated
-- by raising an exception.
checkInv :: STM a -> STM ()
checkInv (STM m) = STM (\s -> (check# m) s)
checkInv (STM m) = STM (\s -> case (check# m) s of s' -> (# s', () #))
-- | alwaysSucceeds adds a new invariant that must be true when passed
-- to alwaysSucceeds, at the end of the current transaction, and at
......
......@@ -291,16 +291,26 @@ addForeignPtrConcFinalizer_ (PlainForeignPtr r) finalizer = do
if noFinalizers
then IO $ \s ->
case r of { IORef (STRef r#) ->
case mkWeak# r# () (foreignPtrFinalizer r) s of { (# s1, _ #) ->
case mkWeak# r# () finalizer' 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
then IO $ \s ->
case mkWeak# fo () (do foreignPtrFinalizer r; touch f) s of
case mkWeak# fo () finalizer' s of
(# s1, _ #) -> (# s1, () #)
else return ()
where
finalizer' :: State# RealWorld -> State# RealWorld
finalizer' s =
case unIO (foreignPtrFinalizer r >> touch f) s of
(# s', () #) -> s'
addForeignPtrConcFinalizer_ _ _ =
error "GHC.ForeignPtr: attempt to add a finalizer to plain pointer"
......@@ -359,7 +369,7 @@ foreignPtrFinalizer r = do
case fs of
NoFinalizers -> return ()
CFinalizers w -> IO $ \s -> case finalizeWeak# w s of
(# s1, 1#, f #) -> f s1
(# s1, 1#, f #) -> case f s1 of s2 -> (# s2, () #)
(# s1, _, _ #) -> (# s1, () #)
HaskellFinalizers actions -> sequence_ actions
......
......@@ -176,6 +176,9 @@ isEmptyMVar (MVar mv#) = IO $ \ s# ->
-- |Add a finalizer to an 'MVar' (GHC only). See "Foreign.ForeignPtr" and
-- "System.Mem.Weak" for more about finalizers.
addMVarFinalizer :: MVar a -> IO () -> IO ()
addMVarFinalizer (MVar m) finalizer =
IO $ \s -> case mkWeak# m () finalizer s of { (# s1, _ #) -> (# s1, () #) }
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''
......@@ -100,8 +100,11 @@ mkWeak :: k -- ^ key
-> Maybe (IO ()) -- ^ finalizer
-> IO (Weak v) -- ^ returns: a weak pointer object
mkWeak key val (Just finalizer) = IO $ \s ->
case mkWeak# key val finalizer s of { (# s1, w #) -> (# s1, Weak w #) }
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''
mkWeak key val Nothing = IO $ \s ->
case mkWeakNoFinalizer# key val s of { (# s1, w #) -> (# s1, Weak w #) }
......@@ -126,7 +129,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 #) -> f s1
(# s1, _, f #) -> case f s1 of s2 -> (# s2, () #)
{-
Instance Eq (Weak v) where
......@@ -141,14 +144,15 @@ Instance Eq (Weak v) where
-- the IO primitives are inlined by hand here to get the optimal
-- code (sigh) --SDM.
runFinalizerBatch :: Int -> Array# (IO ()) -> IO ()
runFinalizerBatch :: Int -> Array# (State# RealWorld -> State# RealWorld)
-> IO ()
runFinalizerBatch (I# n) arr =
let go m = IO $ \s ->
case m of
0# -> (# s, () #)
_ -> let !m' = m -# 1# in
case indexArray# arr m' of { (# io #) ->
case unIO io s of { (# s', _ #) ->
case io s of { s' ->
unIO (go m') s'
}}
in
......
Subproject commit 826ad990713c5ba57b93a51e2514e48b40dff224
Subproject commit 8fb3b3336971d784c091dbca674ae1401e506e76
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