Mark reallyUnsafePtrEquality# as can_fail

As described in the note, floating `reallyUnsafePtrEquality#`
out can make it much less precise. Marking it `can_fail` will
prevent it from floating out, which I believe is particularly
important in light of 5a9a1738023aeb742e537fb4a59c4aa8fecc1f8a,
and should also help prevent let/app invariant failures as seen
in #11444 and #13027.

Reviewers: simonpj, austin, bgamari

Subscribers: thomie

Differential Revision: https://phabricator.haskell.org/D2987

GHC Trac Issues: #13027, #11444

1 files changed, 35 insertions, 0 deletions

diff --git a/compiler/prelude/primops.txt.pp b/compiler/prelude/primops.txt.pp
index 6795ca700c..524527282a 100644
--- a/compiler/prelude/primops.txt.pp
+++ b/compiler/prelude/primops.txt.pp
@@ -2542,6 +2542,41 @@ section "Unsafe pointer equality"
 
 primop  ReallyUnsafePtrEqualityOp "reallyUnsafePtrEquality#" GenPrimOp
    a -> a -> Int#
+   { Returns 1# if the given pointers are equal and 0# otherwise. }
+   with
+   can_fail   = True -- See Note [reallyUnsafePtrEquality#]
+
+
+-- Note [reallyUnsafePtrEquality#]
+-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+-- 
+-- reallyUnsafePtrEquality# can't actually fail, per se, but we mark it can_fail
+-- anyway. Until 5a9a1738023a, GHC considered primops okay for speculation only
+-- when their arguments were known to be forced. This was unnecessarily
+-- conservative, but it prevented reallyUnsafePtrEquality# from floating out of
+-- places where its arguments were known to be forced. Unfortunately, GHC could
+-- sometimes lose track of whether those arguments were forced, leading to let/app
+-- invariant failures (see Trac 13027 and the discussion in Trac 11444). Now that
+-- ok_for_speculation skips over lifted arguments, we need to explicitly prevent
+-- reallyUnsafePtrEquality# from floating out. The reasons are closely related
+-- to those described in Note [dataToTag#], although the consequences are less
+-- severe. Imagine if we had
+-- 
+--     \x y . case x of x'
+--              DEFAULT ->
+--            case y of y'
+--              DEFAULT ->
+--               let eq = reallyUnsafePtrEquality# x' y'
+--               in ...
+-- 
+-- If the let floats out, we'll get
+-- 
+--     \x y . let eq = reallyUnsafePtrEquality# x y
+--            in case x of ...
+-- 
+-- The trouble is that pointer equality between thunks is very different
+-- from pointer equality between the values those thunks reduce to, and the latter
+-- is typically much more precise.
 
 ------------------------------------------------------------------------
 section "Parallelism"