Document RuntimeRep polymorphism limitations of catch#, et al

As noted in #21868, several primops accepting continuations producing
RuntimeRep-polymorphic results aren't nearly as polymorphic as their
types suggest. Document this limitation and adapt the `UnliftedWeakPtr`
test to avoid breaking this limitation in `keepAlive#`.

(cherry picked from commit 3d5f9ba19fea5455d778d2ee9c3fdcaad77d1db7)

2 files changed, 14 insertions, 7 deletions

diff --git a/compiler/GHC/Builtin/primops.txt.pp b/compiler/GHC/Builtin/primops.txt.pp
index 4db381f691..625c512cc6 100644
--- a/compiler/GHC/Builtin/primops.txt.pp
+++ b/compiler/GHC/Builtin/primops.txt.pp
@@ -3281,7 +3281,10 @@ section "Controlling object lifetime"
 primop KeepAliveOp "keepAlive#" GenPrimOp
    v -> State# RealWorld -> (State# RealWorld -> p) -> p
    { \tt{keepAlive# x s k} keeps the value \tt{x} alive during the execution
-     of the computation \tt{k}. }
+     of the computation \tt{k}.
+
+     Note that the result type here isn't quite as unrestricted as the
+     polymorphic type might suggest; ticket \#21868 for details. }
    with
    out_of_line = True
    strictness = { \ _arity -> mkClosedDmdSig [topDmd, topDmd, strictOnceApply1Dmd] topDiv }
diff --git a/testsuite/tests/primops/should_run/UnliftedWeakPtr.hs b/testsuite/tests/primops/should_run/UnliftedWeakPtr.hs
index d957485eba..f10d9a16d3 100644
--- a/testsuite/tests/primops/should_run/UnliftedWeakPtr.hs
+++ b/testsuite/tests/primops/should_run/UnliftedWeakPtr.hs
@@ -23,7 +23,7 @@ main = do
         case newMutVar# False s1 of
           (# s2, val_var #) ->
             case keepAlive# val_var s2 (inner mvar val_var) of
-              (# s3, wk, strs #) ->
+              (# s3, Res wk strs #) ->
                 case unIO performGC s3 of
                   (# s4, _ #) ->
                     case deRefWeak# wk s4 of
@@ -33,15 +33,19 @@ main = do
                             (# s6, strs ++ [ show (I# j), r ] #)
   print res
 
+data Res = Res (Weak# (MutableByteArray# RealWorld)) [String]
+
 inner :: MVar# RealWorld String
       -> MutVar# RealWorld Bool
       -> State# RealWorld
-      -> (# State# RealWorld, Weak# U, [String] #)
+      -> (# State# RealWorld, Res #)
 inner mvar u s0 =
-  case mkWeak# u (U 42#) (finalise mvar) s0 of
-    (# s1, wk #) ->
-      case deRefWeak# wk s1 of
-        (# s2, i, U u #) -> (# s2, wk, [ show (I# i), show (I# u) ] #)
+  case newByteArray# 42# s0 of
+    (# s1, ba# #) ->
+      case mkWeak# u ba# (finalise mvar) s1 of
+        (# s2, wk #) ->
+          case deRefWeak# wk s2 of
+            (# s3, i, ba'# #) -> (# s3, Res wk [ show (I# i), show (I# (sizeofMutableByteArray# ba'#)) ] #)
 
 finalise :: MVar# RealWorld String -> State# RealWorld -> (# State# RealWorld, () #)
 finalise mvar s0 =