Generalise reallyUnsafePtrEquality# and use it

fixes #9192 and #17126
updates containers submodule

1. Changes the type of the primop `reallyUnsafePtrEquality#` to the most
general version possible (heterogeneous as well as levity-polymorphic):

> reallyUnsafePtrEquality#
>   :: forall {l :: Levity} {k :: Levity}
>        (a :: TYPE (BoxedRep l)) (b :: TYPE (BoxedRep k))
>   . a -> b -> Int#

2. Adds a new internal module, `GHC.Ext.PtrEq`, which contains pointer
equality operations that are now subsumed by `reallyUnsafePtrEquality#`.
These functions are then re-exported by `GHC.Exts` (so that no function
goes missing from the export list of `GHC.Exts`, which is user-facing).
More specifically, `GHC.Ext.PtrEq` defines:

  - A new function:
    * reallyUnsafePtrEquality :: forall (a :: Type). a -> a -> Int#

  - Library definitions of ex-primops:
     * `sameMutableArray#`
     * `sameSmallMutableArray`
     * `sameMutableByteArray#`
     * `sameMutableArrayArray#`
     * `sameMutVar#`
     * `sameTVar#`
     * `sameMVar#`
     * `sameIOPort#`
     * `eqStableName#`

  - New functions for comparing non-mutable arrays:
     * `sameArray#`
     * `sameSmallArray#`
     * `sameByteArray#`
     * `sameArrayArray#`

  These were requested in #9192.

Generally speaking, existing libraries that
use `reallyUnsafePtrEquality#` will continue to work with the new,
levity-polymorphic version. But not all!
Some (`containers`, `unordered-containers`, `dependent-map`) contain
the following:

> unsafeCoerce# reallyUnsafePtrEquality# a b

If we make `reallyUnsafePtrEquality#` levity-polymorphic, this code
fails the current GHC representation-polymorphism checks.
We agreed that the right solution here is to modify the library;
in this case by deleting the call to `unsafeCoerce#`,
since `reallyUnsafePtrEquality#` is now type-heterogeneous too.

6 files changed, 194 insertions, 4 deletions

diff --git a/libraries/base/GHC/Base.hs b/libraries/base/GHC/Base.hs
index b037951fa8..5a9d38f147 100644
--- a/libraries/base/GHC/Base.hs
+++ b/libraries/base/GHC/Base.hs
@@ -102,9 +102,10 @@ module GHC.Base
         module GHC.Magic,
         module GHC.Magic.Dict,
         module GHC.Types,
-        module GHC.Prim,        -- Re-export GHC.Prim and [boot] GHC.Err,
-        module GHC.Prim.Ext,    -- to avoid lots of people having to
-        module GHC.Err,         -- import it explicitly
+        module GHC.Prim,        -- Re-export GHC.Prim, GHC.Prim.Ext,
+        module GHC.Prim.Ext,    -- GHC.Prim.PtrEq and [boot] GHC.Err
+        module GHC.Prim.PtrEq,  -- to avoid lots of people having to
+        module GHC.Err,         -- import these modules explicitly
         module GHC.Maybe
   )
         where
@@ -116,6 +117,7 @@ import GHC.Magic
 import GHC.Magic.Dict
 import GHC.Prim
 import GHC.Prim.Ext
+import GHC.Prim.PtrEq
 import GHC.Err
 import GHC.Maybe
 import {-# SOURCE #-} GHC.IO (mkUserError, mplusIO)
diff --git a/libraries/base/GHC/Exts.hs b/libraries/base/GHC/Exts.hs
index 86890b6a8b..29f6bdaca0 100755
--- a/libraries/base/GHC/Exts.hs
+++ b/libraries/base/GHC/Exts.hs
@@ -38,7 +38,24 @@ module GHC.Exts
         module GHC.Prim.Ext,
         shiftL#, shiftRL#, iShiftL#, iShiftRA#, iShiftRL#,
         isTrue#,
-        Void#,  -- Previously exported by GHC.Prim
+        Void#, -- Previously exported by GHC.Prim
+
+        -- * Pointer comparison operations
+        -- See `Note [Pointer comparison operations]` in primops.txt.pp
+        reallyUnsafePtrEquality,
+        eqStableName#,
+        sameArray#,
+        sameMutableArray#,
+        sameSmallArray#,
+        sameSmallMutableArray#,
+        sameByteArray#,
+        sameMutableByteArray#,
+        sameArrayArray#,
+        sameMutableArrayArray#,
+        sameMVar#,
+        sameMutVar#,
+        sameTVar#,
+        sameIOPort#,
 
         -- * Compat wrapper
         atomicModifyMutVar#,
@@ -345,3 +362,4 @@ resizeSmallMutableArray# arr0 szNew a s0 =
 -- accessible\" by word.
 considerAccessible :: Bool
 considerAccessible = True
+
diff --git a/libraries/containers b/libraries/containers
-Subproject 7fb91ca53b1aca7c077b36a0c1f8f785d177da3
+Subproject f90e38cb170dcd68de8660dfd9d0e879921acc2
diff --git a/libraries/ghc-prim/GHC/Prim/PtrEq.hs b/libraries/ghc-prim/GHC/Prim/PtrEq.hs
new file mode 100644
index 0000000000..5e9d2e564b
--- /dev/null
+++ b/libraries/ghc-prim/GHC/Prim/PtrEq.hs
@@ -0,0 +1,140 @@
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE MagicHash #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  GHC.Prim.PtrEq
+-- License     :  see libraries/ghc-prim/LICENSE
+--
+-- Maintainer  :  cvs-ghc@haskell.org
+-- Stability   :  internal
+-- Portability :  non-portable (GHC Extensions)
+--
+-- Comparing underlying pointers for equality.
+--
+-- Use GHC.Exts from the base package instead of importing this
+-- module directly.
+--
+-----------------------------------------------------------------------------
+
+module GHC.Prim.PtrEq
+  ( reallyUnsafePtrEquality,
+    sameArray#,
+    sameMutableArray#,
+    sameSmallArray#,
+    sameSmallMutableArray#,
+    sameByteArray#,
+    sameMutableByteArray#,
+    sameArrayArray#,
+    sameMutableArrayArray#,
+    sameMutVar#,
+    sameTVar#,
+    sameMVar#,
+    sameIOPort#,
+    eqStableName#
+  ) where
+
+import GHC.Prim
+import GHC.Types () -- Make implicit dependency known to build system
+default () -- Double and Integer aren't available yet
+
+{- **********************************************************************
+*                                                                       *
+*                        Pointer equality                               *
+*                                                                       *
+********************************************************************** -}
+
+{- Note [Pointer equality operations]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+Many primitive types - such as Array#, ByteArray#, MVar#, ... - are boxed:
+they are represented by pointers to the underlying data. It is thus possible
+to directly compare these pointers for equality, as opposed to comparing
+the underlying data that the pointers refer to (for instance, comparing
+two arrays element-wise).
+
+To do this, GHC provides the primop reallyUnsafePtrEquality#, which is
+both levity-polymorphic and heterogeneous. As its name indicates, it is an
+unsafe operation which can yield unpredictable results, as explained in
+  Note [Pointer comparison operations] in primops.txt.pp
+
+For a more user-friendly interface, this module defines specialisations of
+the reallyUnsafePtrEquality# primop at various primitive types, such as
+Array#, ByteArray#, MVar#, ...
+-}
+
+-- | Compare the underlying pointers of two values for equality.
+--
+-- Returns @1@ if the pointers are equal and @0@ otherwise.
+--
+-- The two values must be of the same type, of kind 'Type'.
+-- See also 'GHC.Exts.reallyUnsafePtrEquality#', which doesn't have
+-- such restrictions.
+reallyUnsafePtrEquality :: a -> a -> Int#
+reallyUnsafePtrEquality = reallyUnsafePtrEquality#
+-- See Note [Pointer comparison operations]
+--   in primops.txt.pp
+
+-- | Compare the underlying pointers of two arrays.
+sameArray# :: Array# a -> Array# a -> Int#
+sameArray# = reallyUnsafePtrEquality#
+
+-- | Compare the underlying pointers of two mutable arrays.
+sameMutableArray# :: MutableArray# s a -> MutableArray# s a -> Int#
+sameMutableArray# = reallyUnsafePtrEquality#
+
+-- | Compare the underlying pointers of two small arrays.
+sameSmallArray# :: SmallArray# a -> SmallArray# a -> Int#
+sameSmallArray# = reallyUnsafePtrEquality#
+
+-- | Compare the underlying pointers of two small mutable arrays.
+sameSmallMutableArray# :: SmallMutableArray# s a -> SmallMutableArray# s a -> Int#
+sameSmallMutableArray# = reallyUnsafePtrEquality#
+
+-- | Compare the pointers of two byte arrays.
+sameByteArray# :: ByteArray# -> ByteArray# -> Int#
+sameByteArray# = reallyUnsafePtrEquality#
+
+-- | Compare the underlying pointers of two mutable byte arrays.
+sameMutableByteArray# :: MutableByteArray# s -> MutableByteArray# s -> Int#
+sameMutableByteArray# = reallyUnsafePtrEquality#
+
+-- | Compare the underlying pointers of two arrays of arrays.
+sameArrayArray# :: ArrayArray# -> ArrayArray# -> Int#
+sameArrayArray# = reallyUnsafePtrEquality#
+
+-- | Compare the underlying pointers of two mutable arrays of arrays.
+sameMutableArrayArray# :: MutableArrayArray# s -> MutableArrayArray# s -> Int#
+sameMutableArrayArray# = reallyUnsafePtrEquality#
+
+-- | Compare the underlying pointers of two 'MutVar#'s.
+sameMutVar# :: MutVar# s a -> MutVar# s a -> Int#
+sameMutVar# = reallyUnsafePtrEquality#
+
+-- | Compare the underlying pointers of two 'TVar#'s.
+sameTVar# :: TVar# s a -> TVar# s a -> Int#
+sameTVar# = reallyUnsafePtrEquality#
+
+-- | Compare the underlying pointers of two 'MVar#'s.
+sameMVar# :: MVar# s a -> MVar# s a -> Int#
+sameMVar# = reallyUnsafePtrEquality#
+
+-- | Compare the underlying pointers of two 'IOPort#'s.
+sameIOPort# :: IOPort# s a -> IOPort# s a -> Int#
+sameIOPort# = reallyUnsafePtrEquality#
+
+-- Note [Comparing stable names]
+-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+--
+-- A StableName# is actually a pointer to a stable name object (SNO)
+-- containing an index into the stable name table (SNT). We
+-- used to compare StableName#s by following the pointers to the
+-- SNOs and checking whether they held the same SNT indices. However,
+-- this is not necessary: there is a one-to-one correspondence
+-- between SNOs and entries in the SNT, so simple pointer equality
+-- does the trick.
+
+-- | Compare two stable names for equality.
+eqStableName# :: StableName# a -> StableName# b -> Int#
+eqStableName# = reallyUnsafePtrEquality#
diff --git a/libraries/ghc-prim/changelog.md b/libraries/ghc-prim/changelog.md
index 122856346f..5d27ec197a 100644
--- a/libraries/ghc-prim/changelog.md
+++ b/libraries/ghc-prim/changelog.md
@@ -39,6 +39,35 @@
   raise# :: forall (a :: Type) {r :: RuntimeRep} (b :: TYPE r). a -> b
   ```
 
+- `reallyUnsafePtrEquality#` has been made more general, as it is now
+   both levity-polymorphic and heterogeneous:
+
+  ```
+  reallyUnsafePtrEquality#
+    :: forall {l :: Levity} (a :: TYPE (BoxedRep l))
+              {k :: Levity} (b :: TYPE (BoxedRep k))
+    . a -> b -> Int#
+  ```
+
+   This means that `reallyUnsafePtrEquality#` can be used on primitive arrays
+   such as `Array#` and `ByteArray#`. It can also be used on values of
+   different types, without needing to call `unsafeCoerce#`.
+
+- The following functions have been moved from `GHC.Prim` to `GHC.Exts`:
+  - `sameMutableArray#`, `sameSmallMutableArray#`, `sameMutableByteArray#`
+     and `sameMutableArrayArray#`,
+  - `sameMutVar#`, `sameTVar#` and`sameMVar#`,
+  - `sameIOPort#`,
+  - `eqStableName#`.
+
+- The following functions have been added to `GHC.Exts`:
+ 
+  ```
+  sameArray# :: Array# a -> Array# a -> Int#
+  sameSmallArray# :: SmallArray# a -> SmallArray# a -> Int#
+  sameByteArray# :: ByteArray# -> ByteArray# -> Int#
+  sameArrayArray# :: ArrayArray# -> ArrayArray# -> Int#
+  ```
 
 ## 0.8.0 (edit as necessary)
 
diff --git a/libraries/ghc-prim/ghc-prim.cabal b/libraries/ghc-prim/ghc-prim.cabal
index 812324e117..e207b3f24c 100644
--- a/libraries/ghc-prim/ghc-prim.cabal
+++ b/libraries/ghc-prim/ghc-prim.cabal
@@ -48,6 +48,7 @@ Library
         GHC.Prim.Ext
         GHC.Prim.Panic
         GHC.Prim.Exception
+        GHC.Prim.PtrEq
         GHC.PrimopWrappers
         GHC.Tuple
         GHC.Types