Commit cbf6e1de authored by sheaf's avatar sheaf
Browse files

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.
parent c38bce73
......@@ -28,13 +28,17 @@ module GHC.Builtin.Types.Prim(
runtimeRep1TyVar, runtimeRep2TyVar, runtimeRep3TyVar,
runtimeRep1TyVarInf, runtimeRep2TyVarInf,
runtimeRep1Ty, runtimeRep2Ty, runtimeRep3Ty,
levity1TyVar, levity1TyVarInf, levity1Ty,
levity1TyVar, levity2TyVar,
levity1TyVarInf, levity2TyVarInf,
levity1Ty, levity2Ty,
openAlphaTyVar, openBetaTyVar, openGammaTyVar,
openAlphaTyVarSpec, openBetaTyVarSpec, openGammaTyVarSpec,
openAlphaTy, openBetaTy, openGammaTy,
levPolyTyVar1, levPolyTyVar1Spec, levPolyTy1,
levPolyAlphaTyVar, levPolyBetaTyVar,
levPolyAlphaTyVarSpec, levPolyBetaTyVarSpec,
levPolyAlphaTy, levPolyBetaTy,
multiplicityTyVar1, multiplicityTyVar2,
......@@ -416,25 +420,35 @@ openAlphaTy = mkTyVarTy openAlphaTyVar
openBetaTy = mkTyVarTy openBetaTyVar
openGammaTy = mkTyVarTy openGammaTyVar
levity1TyVar :: TyVar
(levity1TyVar : _)
= drop 11 (mkTemplateTyVars (repeat levityTy)) -- selects 'l'
levity1TyVar, levity2TyVar :: TyVar
(levity2TyVar : levity1TyVar : _) -- NB: levity2TyVar before levity1TyVar
= drop 10 (mkTemplateTyVars (repeat levityTy)) -- selects 'k', 'l'
-- The ordering of levity2TyVar before levity1TyVar is chosen so that
-- the more common levity1TyVar uses the levity variable 'l'.
levity1TyVarInf :: TyVarBinder
levity1TyVarInf, levity2TyVarInf :: TyVarBinder
levity1TyVarInf = mkTyVarBinder Inferred levity1TyVar
levity2TyVarInf = mkTyVarBinder Inferred levity2TyVar
levity1Ty :: Type
levity1Ty, levity2Ty :: Type
levity1Ty = mkTyVarTy levity1TyVar
levPolyTyVar1 :: TyVar
[levPolyTyVar1] = mkTemplateTyVars [tYPE (mkTyConApp boxedRepDataConTyCon [levity1Ty])]
-- tv :: TYPE ('BoxedRep l)
levPolyTyVar1Spec :: TyVarBinder
levPolyTyVar1Spec = mkTyVarBinder Specified levPolyTyVar1
levPolyTy1 :: Type
levPolyTy1 = mkTyVarTy levPolyTyVar1
levity2Ty = mkTyVarTy levity2TyVar
levPolyAlphaTyVar, levPolyBetaTyVar :: TyVar
[levPolyAlphaTyVar, levPolyBetaTyVar] =
mkTemplateTyVars
[tYPE (mkTyConApp boxedRepDataConTyCon [levity1Ty])
,tYPE (mkTyConApp boxedRepDataConTyCon [levity2Ty])]
-- alpha :: TYPE ('BoxedRep l)
-- beta :: TYPE ('BoxedRep k)
levPolyAlphaTyVarSpec, levPolyBetaTyVarSpec :: TyVarBinder
levPolyAlphaTyVarSpec = mkTyVarBinder Specified levPolyAlphaTyVar
levPolyBetaTyVarSpec = mkTyVarBinder Specified levPolyBetaTyVar
levPolyAlphaTy, levPolyBetaTy :: Type
levPolyAlphaTy = mkTyVarTy levPolyAlphaTyVar
levPolyBetaTy = mkTyVarTy levPolyBetaTyVar
multiplicityTyVar1, multiplicityTyVar2 :: TyVar
(multiplicityTyVar1 : multiplicityTyVar2 : _)
......
......@@ -187,6 +187,41 @@ defaults
-- description fields should be legal latex. Descriptions can contain
-- matched pairs of embedded curly brackets.
-- Note [Levity and representation polymorphic primops]
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-- In the types of primops in this module,
--
-- * The names `a,b,c,s` stand for type variables of kind Type
--
-- * The names `v` and `w` stand for levity-polymorphic
-- type variables.
-- For example:
-- op :: v -> w -> Int
-- really means
-- op :: forall {l :: Levity} (a :: TYPE (BoxedRep l))
-- {k :: Levity} (b :: TYPE (BoxedRep k)).
-- a -> b -> Int
-- Two important things to note:
-- - `v` and `w` have independent levities `l` and `k` (respectively), and
-- these are inferred (not specified), as seen from the curly brackets.
-- - `v` and `w` end up written as `a` and `b` (respectively) in types,
-- which means that one shouldn't write a primop type involving both
-- `a` and `v`, nor `b` and `w`.
--
-- * The names `o` and `p` stand for representation-polymorphic
-- type variables, similarly to `v` and `w` above. For example:
-- op :: o -> p -> Int
-- really means
-- op :: forall {q :: RuntimeRep} (a :: TYPE q)
-- {r :: RuntimeRep} (b :: TYPE r)
-- a -> b -> Int
-- We note:
-- - `o` and `p` have independent `RuntimeRep`s `q` and `r`, which are
-- inferred type variables (like for `v` and `w` above).
-- - `o` and `p` share textual names with `a` and `b` (respectively).
-- This means one shouldn't write a type involving both `a` and `o`,
-- nor `b` and `p`, nor `o` and `v`, etc.
#include "MachDeps.h"
section "The word size story."
......@@ -1278,9 +1313,6 @@ primop NewArrayOp "newArray#" GenPrimOp
out_of_line = True
has_side_effects = True
primop SameMutableArrayOp "sameMutableArray#" GenPrimOp
MutableArray# s a -> MutableArray# s a -> Int#
primop ReadArrayOp "readArray#" GenPrimOp
MutableArray# s a -> Int# -> State# s -> (# State# s, a #)
{Read from specified index of mutable array. Result is not yet evaluated.}
......@@ -1456,9 +1488,6 @@ primop NewSmallArrayOp "newSmallArray#" GenPrimOp
out_of_line = True
has_side_effects = True
primop SameSmallMutableArrayOp "sameSmallMutableArray#" GenPrimOp
SmallMutableArray# s a -> SmallMutableArray# s a -> Int#
primop ShrinkSmallMutableArrayOp_Char "shrinkSmallMutableArray#" GenPrimOp
SmallMutableArray# s a -> Int# -> State# s -> State# s
{Shrink mutable array to new specified size, in
......@@ -1659,9 +1688,6 @@ primop MutableByteArrayContents_Char "mutableByteArrayContents#" GenPrimOp
MutableByteArray# s -> Addr#
{Intended for use with pinned arrays; otherwise very unsafe!}
primop SameMutableByteArrayOp "sameMutableByteArray#" GenPrimOp
MutableByteArray# s -> MutableByteArray# s -> Int#
primop ShrinkMutableByteArrayOp_Char "shrinkMutableByteArray#" GenPrimOp
MutableByteArray# s -> Int# -> State# s -> State# s
{Shrink mutable byte array to new specified size (in bytes), in
......@@ -1890,9 +1916,6 @@ primop NewArrayArrayOp "newArrayArray#" GenPrimOp
out_of_line = True
has_side_effects = True
primop SameMutableArrayArrayOp "sameMutableArrayArray#" GenPrimOp
MutableArrayArray# s -> MutableArrayArray# s -> Int#
primop UnsafeFreezeArrayArrayOp "unsafeFreezeArrayArray#" GenPrimOp
MutableArrayArray# s -> State# s -> (# State# s, ArrayArray# #)
{Make a mutable array of arrays immutable, without copying.}
......@@ -2387,9 +2410,6 @@ primop WriteMutVarOp "writeMutVar#" GenPrimOp
has_side_effects = True
code_size = { primOpCodeSizeForeignCall } -- for the write barrier
primop SameMutVarOp "sameMutVar#" GenPrimOp
MutVar# s a -> MutVar# s a -> Int#
-- Note [Why not an unboxed tuple in atomicModifyMutVar2#?]
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
--
......@@ -2466,6 +2486,7 @@ primop RaiseOp "raise#" GenPrimOp
a -> p
-- NB: "p" is the same as "b" except it is representation-polymorphic
-- (we shouldn't use "o" here as that would conflict with "a")
-- See Note [Levity and representation polymorphic primops]
with
-- In contrast to 'raiseIO#', which throws a *precise* exception,
-- exceptions thrown by 'raise#' are considered *imprecise*.
......@@ -2608,9 +2629,6 @@ primop WriteTVarOp "writeTVar#" GenPrimOp
out_of_line = True
has_side_effects = True
primop SameTVarOp "sameTVar#" GenPrimOp
TVar# s a -> TVar# s a -> Int#
------------------------------------------------------------------------
section "Synchronized Mutable Variables"
......@@ -2678,9 +2696,6 @@ primop TryReadMVarOp "tryReadMVar#" GenPrimOp
out_of_line = True
has_side_effects = True
primop SameMVarOp "sameMVar#" GenPrimOp
MVar# s a -> MVar# s a -> Int#
primop IsEmptyMVarOp "isEmptyMVar#" GenPrimOp
MVar# s a -> State# s -> (# State# s, Int# #)
{Return 1 if {\tt MVar\#} is empty; 0 otherwise.}
......@@ -2723,10 +2738,6 @@ primop WriteIOPortOp "writeIOPort#" GenPrimOp
out_of_line = True
has_side_effects = True
primop SameIOPortOp "sameIOPort#" GenPrimOp
IOPort# s a -> IOPort# s a -> Int#
------------------------------------------------------------------------
section "Delay/wait operations"
------------------------------------------------------------------------
......@@ -2840,6 +2851,7 @@ section "Weak pointers"
primtype Weak# b
-- Note: "v" denotes a levity-polymorphic type variable
-- See Note [Levity and representation polymorphic primops]
primop MkWeakOp "mkWeak#" GenPrimOp
v -> b -> (State# RealWorld -> (# State# RealWorld, c #))
......@@ -2927,9 +2939,6 @@ primop MakeStableNameOp "makeStableName#" GenPrimOp
has_side_effects = True
out_of_line = True
primop EqStableNameOp "eqStableName#" GenPrimOp
StableName# a -> StableName# b -> Int#
primop StableNameToIntOp "stableNameToInt#" GenPrimOp
StableName# a -> Int#
......@@ -3061,25 +3070,74 @@ section "Unsafe pointer equality"
-- (#1 Bad Guy: Alastair Reid :)
------------------------------------------------------------------------
-- `v` and `w` are levity-polymorphic type variables with independent levities.
-- See Note [Levity and representation polymorphic primops]
primop ReallyUnsafePtrEqualityOp "reallyUnsafePtrEquality#" GenPrimOp
a -> a -> Int#
v -> w -> Int#
{ Returns {\texttt 1\#} if the given pointers are equal and {\texttt 0\#} otherwise. }
with
can_fail = True -- See Note [reallyUnsafePtrEquality#]
can_fail = True -- See Note [reallyUnsafePtrEquality# can_fail]
-- Note [reallyUnsafePtrEquality#]
-- Note [Pointer comparison operations]
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-- The primop `reallyUnsafePtrEquality#` does a direct pointer
-- equality between two (boxed) values. Several things to note:
--
-- * It is levity-polymorphic. It works for TYPE (BoxedRep Lifted) and
-- TYPE (BoxedRep Unlifted). But not TYPE IntRep, for example.
-- This levity-polymorphism comes from the use of the type variables
-- "v" and "w". See Note [Levity and representation polymorphic primops]
--
-- * It does not evaluate its arguments. The user of the primop is responsible
-- for doing so.
--
-- * It is hetero-typed; you can compare pointers of different types.
-- This is used in various packages such as containers & unordered-containers.
--
-- * It is obviously very dangerous, because
-- let x = f y in reallyUnsafePtrEquality# x x
-- will probably return True, whereas
-- reallyUnsafePtrEquality# (f y) (f y)
-- will probably return False. ("probably", because it's affected
-- by CSE and inlining).
--
-- * reallyUnsafePtrEquality# can't fail, but it is marked as such
-- to prevent it from floating out.
-- See Note [reallyUnsafePtrEquality# can_fail]
--
-- The library GHC.Exts provides several less Wild-West functions
-- for use in specific cases, namely:
--
-- reallyUnsafePtrEquality :: a -> a -> Int# -- not levity-polymorphic, nor hetero-typed
-- sameArray# :: Array# a -> Array# a -> Int#
-- sameMutableArray# :: MutableArray# s a -> MutableArray# s a -> Int#
-- sameSmallArray# :: SmallArray# a -> SmallArray# a -> Int#
-- sameSmallMutableArray# :: SmallMutableArray# s a -> SmallMutableArray# s a -> Int#
-- sameByteArray# :: ByteArray# -> ByteArray# -> Int#
-- sameMutableByteArray# :: MutableByteArray# s -> MutableByteArray# s -> Int#
-- sameArrayArray# :: ArrayArray# -> ArrayArray# -> Int#
-- sameMutableArrayArray# :: MutableArrayArray# s -> MutableArrayArray# s -> Int#
-- sameMutVar# :: MutVar# s a -> MutVar# s a -> Int#
-- sameTVar# :: TVar# s a -> TVar# s a -> Int#
-- sameMVar# :: MVar# s a -> MVar# s a -> Int#
-- sameIOPort# :: IOPort# s a -> IOPort# s a -> Int#
-- eqStableName# :: StableName# a -> StableName# b -> Int#
--
-- These operations are all specialisations of reallyUnsafePtrEquality#.
-- Note [reallyUnsafePtrEquality# can_fail]
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
--
-- 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 #13027 and the discussion in #11444). Now that
-- ok_for_speculation skips over lifted arguments, we need to explicitly prevent
-- reallyUnsafePtrEquality# from floating out. Imagine if we had
-- 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 #13027 and the
-- discussion in #11444). Now that ok_for_speculation skips over lifted
-- arguments, we need to explicitly prevent reallyUnsafePtrEquality#
-- from floating out. Imagine if we had
--
-- \x y . case x of x'
-- DEFAULT ->
......@@ -3140,7 +3198,8 @@ section "Controlling object lifetime"
-- See Note [keepAlive# magic] in GHC.CoreToStg.Prep.
-- NB: "v" is the same as "a" except levity-polymorphic,
-- and "p" is the same as "b" except representation-polymorphic.
-- See Note [Levity and representation polymorphic primops]
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
......
......@@ -340,6 +340,8 @@ emitPrimOp dflags primop = case primop of
StableNameToIntOp -> \[arg] -> opIntoRegs $ \[res] ->
emitAssign (CmmLocal res) (cmmLoadIndexW platform arg (fixedHdrSizeW profile) (bWord platform))
EqStablePtrOp -> \args -> opTranslate args (mo_wordEq platform)
ReallyUnsafePtrEqualityOp -> \[arg1, arg2] -> opIntoRegs $ \[res] ->
emitAssign (CmmLocal res) (CmmMachOp (mo_wordEq platform) [arg1,arg2])
......@@ -1408,20 +1410,6 @@ emitPrimOp dflags primop = case primop of
FloatToDoubleOp -> \args -> opTranslate args (MO_FF_Conv W32 W64)
DoubleToFloatOp -> \args -> opTranslate args (MO_FF_Conv W64 W32)
-- Word comparisons masquerading as more exotic things.
SameMutVarOp -> \args -> opTranslate args (mo_wordEq platform)
SameMVarOp -> \args -> opTranslate args (mo_wordEq platform)
SameIOPortOp -> \args -> opTranslate args (mo_wordEq platform)
SameMutableArrayOp -> \args -> opTranslate args (mo_wordEq platform)
SameMutableByteArrayOp -> \args -> opTranslate args (mo_wordEq platform)
SameMutableArrayArrayOp -> \args -> opTranslate args (mo_wordEq platform)
SameSmallMutableArrayOp -> \args -> opTranslate args (mo_wordEq platform)
SameTVarOp -> \args -> opTranslate args (mo_wordEq platform)
EqStablePtrOp -> \args -> opTranslate args (mo_wordEq platform)
-- See Note [Comparing stable names]
EqStableNameOp -> \args -> opTranslate args (mo_wordEq platform)
IntQuotRemOp -> \args -> opCallishHandledLater args $
if ncg && (x86ish || ppc) && not (quotRemCanBeOptimized args)
then Left (MO_S_QuotRem (wordWidth platform))
......@@ -2026,17 +2014,6 @@ genericFabsOp w [res_r] [aa]
genericFabsOp _ _ _ = panic "genericFabsOp"
-- 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.
------------------------------------------------------------------------------
-- Helpers for translating various minor variants of array indexing.
......
......@@ -41,6 +41,32 @@ Version 9.4.1
raise# :: forall (a :: Type) {r :: RuntimeRep} (b :: TYPE r). a -> b
- ``GHC.Exts.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 ``GHC.Exts.reallyUnsafePtrEquality#`` can be used
on primitive arrays such as ``GHC.Exts.Array#`` and ``GHC.Exts.ByteArray#``.
It can also be used on values of different types, without needing to call
``GHC.Exts.unsafeCoerce#``.
- Added ``GHC.Exts.reallyUnsafePtrEquality`` which recovers the
previous behaviour of ``GHC.Exts.reallyUnsafePtrEquality#``: ::
reallyUnsafePtrEquality :: forall (a :: Type). a -> a -> Int#
- Added ``GHC.Exts.sameArray#``, ``GHC.Exts.sameSmallArray#``,
``GHC.Exts.sameByteArray#`` and ``GHC.Exts.sameArrayArray#``: ::
sameArray# :: Array# a -> Array# a -> Int#
sameSmallArray# :: SmallArray# a -> SmallArray# a -> Int#
sameByteArray# :: ByteArray# -> ByteArray# -> Int#
sameArrayArray# :: ArrayArray# -> ArrayArray# -> Int#
``ghc`` library
~~~~~~~~~~~~~~~
......
......@@ -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)
......
......@@ -40,7 +40,24 @@ module GHC.Exts
uncheckedShiftL64#, uncheckedShiftRL64#,
uncheckedIShiftL64#, uncheckedIShiftRA64#,
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#,
......@@ -349,3 +366,4 @@ resizeSmallMutableArray# arr0 szNew a s0 =
-- accessible\" by word.
considerAccessible :: Bool
considerAccessible = True
Subproject commit 7fb91ca53b1aca7c077b36a0c1f8f785d177da34
Subproject commit f90e38cb170dcd68de8660dfd9d0e879921acc28
{-# 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#
......@@ -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#`