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.

7 files changed, 38 insertions, 15 deletions

diff --git a/libraries/base/Control/Concurrent/MVar.hs b/libraries/base/Control/Concurrent/MVar.hs
index 45c05fdc9b..5ffac11077 100644
--- a/libraries/base/Control/Concurrent/MVar.hs
+++ b/libraries/base/Control/Concurrent/MVar.hs
@@ -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''
diff --git a/libraries/base/Data/IORef.hs b/libraries/base/Data/IORef.hs
index c2bc1f7318..bcd1a652d8 100644
--- a/libraries/base/Data/IORef.hs
+++ b/libraries/base/Data/IORef.hs
@@ -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'.
 --
diff --git a/libraries/base/GHC/Conc/Sync.hs b/libraries/base/GHC/Conc/Sync.hs
index c417226da9..81ec7fabe7 100644
--- a/libraries/base/GHC/Conc/Sync.hs
+++ b/libraries/base/GHC/Conc/Sync.hs
@@ -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
diff --git a/libraries/base/GHC/ForeignPtr.hs b/libraries/base/GHC/ForeignPtr.hs
index 6e288483ea..0b9118ea07 100644
--- a/libraries/base/GHC/ForeignPtr.hs
+++ b/libraries/base/GHC/ForeignPtr.hs
@@ -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
 
diff --git a/libraries/base/GHC/MVar.hs b/libraries/base/GHC/MVar.hs
index 911c024128..bdad179004 100644
--- a/libraries/base/GHC/MVar.hs
+++ b/libraries/base/GHC/MVar.hs
@@ -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''
 
diff --git a/libraries/base/GHC/Weak.hs b/libraries/base/GHC/Weak.hs
index 6d4d80eb72..b2c327399c 100644
--- a/libraries/base/GHC/Weak.hs
+++ b/libraries/base/GHC/Weak.hs
@@ -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
diff --git a/libraries/stm b/libraries/stm
-Subproject 826ad990713c5ba57b93a51e2514e48b40dff22
+Subproject 8fb3b3336971d784c091dbca674ae1401e506e7