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.

7 files changed, 18 insertions, 31 deletions

diff --git a/compiler/prelude/primops.txt.pp b/compiler/prelude/primops.txt.pp
index d1786a032f..e060deb747 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 5ffac11077..f76eaeb906 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 bcd1a652d8..c6275f5433 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 a1ff1ba6bf..d0688f0cbf 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 bdad179004..6cbbe7bfb6 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 b2c327399c..8f886a6d23 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
-Subproject 8fb3b3336971d784c091dbca674ae1401e506e7
+Subproject f7db2c3df86ec644e5e06baa8090a1cb525754e