diff options
| -rw-r--r-- | compiler/GHC/Builtin/primops.txt.pp | 56 | ||||
| -rw-r--r-- | libraries/base/GHC/ArrayArray.hs | 5 | ||||
| -rwxr-xr-x | libraries/base/GHC/Exts.hs | 1 | ||||
| -rw-r--r-- | libraries/ghc-prim/GHC/Prim/PtrEq.hs | 42 |
4 files changed, 70 insertions, 34 deletions
diff --git a/compiler/GHC/Builtin/primops.txt.pp b/compiler/GHC/Builtin/primops.txt.pp index 1fc7bd5f23..617abe5f9e 100644 --- a/compiler/GHC/Builtin/primops.txt.pp +++ b/compiler/GHC/Builtin/primops.txt.pp @@ -3429,29 +3429,47 @@ primop ReallyUnsafePtrEqualityOp "reallyUnsafePtrEquality#" GenPrimOp -- 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] +-- (PE1) 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. +-- (PE2) It is hetero-typed; you can compare pointers of different types. +-- This is used in various packages such as containers & unordered-containers. -- --- * It is hetero-typed; you can compare pointers of different types. --- This is used in various packages such as containers & unordered-containers. +-- (PE3) It does not evaluate its arguments. The user of the primop is responsible +-- for doing so. Consider +-- let { x = p+q; y = q+p } in reallyUnsafePtrEquality# x y +-- Here `x` and `y` point to different closures, so the expression will +-- probably return False; but if `x` and/or `y` were evaluated for some +-- other reason, then it might return True. -- --- * 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). +-- (PE4) It is obviously very dangerous, because replacing equals with equals +-- in the program can change the result. For example +-- 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] +-- (PE5) 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 +-- The library GHC.Prim.PtrEq (and GHC.Exts) provides +-- +-- unsafePtrEquality# :: +-- forall (a :: UnliftedType) (b :: UnliftedType). a -> b -> Int# +-- +-- It is still heterotyped (like (PE2)), but it's restricted to unlifted types +-- (unlike (PE1)). That means that (PE3) doesn't apply: unlifted types are +-- always evaluated, which makes it a bit less unsafe. +-- +-- However unsafePtrEquality# is /implemented/ by a call to +-- reallyUnsafePtrEquality#, so using the former is really just a documentation +-- hint to the reader of the code. GHC behaves no differently. +-- +-- The same library provides less Wild-West functions -- for use in specific cases, namely: -- -- reallyUnsafePtrEquality :: a -> a -> Int# -- not levity-polymorphic, nor hetero-typed @@ -3469,7 +3487,7 @@ primop ReallyUnsafePtrEqualityOp "reallyUnsafePtrEquality#" GenPrimOp -- sameIOPort# :: IOPort# s a -> IOPort# s a -> Int# -- eqStableName# :: StableName# a -> StableName# b -> Int# -- --- These operations are all specialisations of reallyUnsafePtrEquality#. +-- These operations are all specialisations of unsafePtrEquality#. -- Note [reallyUnsafePtrEquality# can_fail] -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ diff --git a/libraries/base/GHC/ArrayArray.hs b/libraries/base/GHC/ArrayArray.hs index 199bac3a15..bd154c1943 100644 --- a/libraries/base/GHC/ArrayArray.hs +++ b/libraries/base/GHC/ArrayArray.hs @@ -49,6 +49,7 @@ module GHC.ArrayArray where import GHC.Prim +import GHC.Prim.PtrEq ( unsafePtrEquality# ) import GHC.Types ( Type, UnliftedType, isTrue# ) import Unsafe.Coerce ( unsafeCoerce, unsafeCoerceUnlifted ) default () @@ -148,8 +149,8 @@ copyMutableArrayArray# = unsafeCoerce copyMutableArray# -- | Compare the underlying pointers of two arrays of arrays. sameArrayArray# :: ArrayArray# -> ArrayArray# -> Int# -sameArrayArray# (ArrayArray# arr1) (ArrayArray# arr2) = reallyUnsafePtrEquality# arr1 arr2 +sameArrayArray# (ArrayArray# arr1) (ArrayArray# arr2) = unsafePtrEquality# arr1 arr2 -- | Compare the underlying pointers of two mutable arrays of arrays. sameMutableArrayArray# :: MutableArrayArray# s -> MutableArrayArray# s -> Int# -sameMutableArrayArray# (MutableArrayArray# marr1) (MutableArrayArray# marr2 ) = reallyUnsafePtrEquality# marr1 marr2 +sameMutableArrayArray# (MutableArrayArray# marr1) (MutableArrayArray# marr2 ) = unsafePtrEquality# marr1 marr2 diff --git a/libraries/base/GHC/Exts.hs b/libraries/base/GHC/Exts.hs index 90a37be35b..9114a398e7 100755 --- a/libraries/base/GHC/Exts.hs +++ b/libraries/base/GHC/Exts.hs @@ -48,6 +48,7 @@ module GHC.Exts -- ** Pointer comparison operations -- See `Note [Pointer comparison operations]` in primops.txt.pp reallyUnsafePtrEquality, + unsafePtrEquality#, eqStableName#, sameArray#, sameMutableArray#, diff --git a/libraries/ghc-prim/GHC/Prim/PtrEq.hs b/libraries/ghc-prim/GHC/Prim/PtrEq.hs index 49e78b1713..9e8e0d04a0 100644 --- a/libraries/ghc-prim/GHC/Prim/PtrEq.hs +++ b/libraries/ghc-prim/GHC/Prim/PtrEq.hs @@ -1,6 +1,8 @@ {-# LANGUAGE Unsafe #-} {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE MagicHash #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE KindSignatures #-} ----------------------------------------------------------------------------- -- | @@ -20,6 +22,7 @@ module GHC.Prim.PtrEq ( reallyUnsafePtrEquality, + unsafePtrEquality#, sameArray#, sameMutableArray#, sameSmallArray#, @@ -35,7 +38,7 @@ module GHC.Prim.PtrEq ) where import GHC.Prim -import GHC.Types () -- Make implicit dependency known to build system +import GHC.Types (UnliftedType) -- Also make implicit dependency known to build system default () -- Double and Integer aren't available yet {- ********************************************************************** @@ -74,49 +77,62 @@ reallyUnsafePtrEquality = reallyUnsafePtrEquality# -- See Note [Pointer comparison operations] -- in primops.txt.pp +-- | Compare the underlying pointers of two unlifted values for equality. +-- +-- This is less dangerous than 'reallyUnsafePtrEquality', +-- since the arguments are guaranteed to be evaluated. +-- This means there is no risk of accidentally comparing +-- a thunk. +-- It's however still more dangerous than e.g. 'sameArray#'. +-- +unsafePtrEquality# :: forall (a :: UnliftedType) (b :: UnliftedType). a -> b -> Int# +unsafePtrEquality# = 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# +sameArray# = unsafePtrEquality# -- | Compare the underlying pointers of two mutable arrays. sameMutableArray# :: MutableArray# s a -> MutableArray# s a -> Int# -sameMutableArray# = reallyUnsafePtrEquality# +sameMutableArray# = unsafePtrEquality# -- | Compare the underlying pointers of two small arrays. sameSmallArray# :: SmallArray# a -> SmallArray# a -> Int# -sameSmallArray# = reallyUnsafePtrEquality# +sameSmallArray# = unsafePtrEquality# -- | Compare the underlying pointers of two small mutable arrays. sameSmallMutableArray# :: SmallMutableArray# s a -> SmallMutableArray# s a -> Int# -sameSmallMutableArray# = reallyUnsafePtrEquality# +sameSmallMutableArray# = unsafePtrEquality# -- | Compare the pointers of two byte arrays. sameByteArray# :: ByteArray# -> ByteArray# -> Int# -sameByteArray# = reallyUnsafePtrEquality# +sameByteArray# = unsafePtrEquality# -- | Compare the underlying pointers of two mutable byte arrays. sameMutableByteArray# :: MutableByteArray# s -> MutableByteArray# s -> Int# -sameMutableByteArray# = reallyUnsafePtrEquality# +sameMutableByteArray# = unsafePtrEquality# -- | Compare the underlying pointers of two 'MutVar#'s. sameMutVar# :: MutVar# s a -> MutVar# s a -> Int# -sameMutVar# = reallyUnsafePtrEquality# +sameMutVar# = unsafePtrEquality# -- | Compare the underlying pointers of two 'TVar#'s. sameTVar# :: TVar# s a -> TVar# s a -> Int# -sameTVar# = reallyUnsafePtrEquality# +sameTVar# = unsafePtrEquality# -- | Compare the underlying pointers of two 'MVar#'s. sameMVar# :: MVar# s a -> MVar# s a -> Int# -sameMVar# = reallyUnsafePtrEquality# +sameMVar# = unsafePtrEquality# -- | Compare the underlying pointers of two 'IOPort#'s. sameIOPort# :: IOPort# s a -> IOPort# s a -> Int# -sameIOPort# = reallyUnsafePtrEquality# +sameIOPort# = unsafePtrEquality# -- | Compare the underlying pointers of two 'PromptTag#'s. samePromptTag# :: PromptTag# a -> PromptTag# a -> Int# -samePromptTag# = reallyUnsafePtrEquality# +samePromptTag# = unsafePtrEquality# -- Note [Comparing stable names] -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -130,4 +146,4 @@ samePromptTag# = reallyUnsafePtrEquality# -- | Compare two stable names for equality. eqStableName# :: StableName# a -> StableName# b -> Int# -eqStableName# = reallyUnsafePtrEquality# +eqStableName# = unsafePtrEquality# |