-- --< Header >-- {{{

{-# LANGUAGE MagicHash, DataKinds, QuantifiedConstraints #-}

{- |

Description : Heterogeneous pointer equality
Copyright   : (c) L. S. Leary, 2025

Heterogeneous pointer equality.

The offerings of this module should eventually be incorporated into /base/, /stm/ and /primitive/ by:

 * Generalising the types of pointer equality primitives ([#24994](https://gitlab.haskell.org/ghc/ghc/-/issues/24994))

 * Thereby providing 'Data.Type.Coercion.TestCoercion' instances for the the boxings of those primitive types ([#17076](https://gitlab.haskell.org/ghc/ghc/-/issues/17076))

 * Thereby providing 'Data.Type.Coercion.TestCoercion' instances for derived types

-}

-- }}}

-- --< Exports & Imports >-- {{{

module Data.Hetero.PtrEq (

  -- * Pointer Equality

  -- ** Primitive
  -- $primitive
  Array#, sameArray#,
  MutableArray#, sameMutableArray#,
  SmallArray#, sameSmallArray#,
  SmallMutableArray#, sameSmallMutableArray#,
  MutVar#, sameMutVar#,
  TVar#, sameTVar#,
  MVar#, sameMVar#,
  IOPort#, sameIOPort#,
  PromptTag#, samePromptTag#,

  -- ** Derived
  -- $derived
  Chan, sameChan,
  TBQueue, sameTBQueue,
  TChan, sameTChan,
  TMVar, sameTMVar,
  TQueue, sameTQueue,

) where

-- GHC/base
import GHC.Exts
  ( TYPE, RuntimeRep(BoxedRep), UnliftedType, unsafePtrEquality#, isTrue#
  , Array#, MutableArray#, SmallArray#, SmallMutableArray#
  , MutVar#, TVar#, MVar#, IOPort#, PromptTag#
  )

-- base
import Unsafe.Coerce (unsafeCoerce)
import Data.Type.Coercion (Coercion(..))
import Control.Concurrent.Chan (Chan)

-- stm
import Control.Concurrent.STM (TBQueue, TChan, TMVar, TQueue)

-- }}}

-- --< Pointer Equality: Primitive >-- {{{

{- $primitive

"GHC.Exts" provides pointer equality functions for primitive unlifted types of the form:

> sameFoo# :: Foo# a -> Foo# a -> Int#

When appropriate, we generalise the above to:

> sameFoo# :: Foo# a -> Foo# b -> Maybe (Coercion a b)

\[ \]

-}

unsafeSame
  :: forall {k} (f :: k -> UnliftedType) a b
  .  f a -> f b -> Maybe (Coercion a b)
unsafeSame :: forall {k} (f :: k -> UnliftedType) (a :: k) (b :: k).
f a -> f b -> Maybe (Coercion a b)
unsafeSame f a
x f b
y = if Int# -> Bool
isTrue# (f a -> f b -> Int#
forall (a :: UnliftedType) (b :: UnliftedType). a -> b -> Int#
unsafePtrEquality# f a
x f b
y)
  then Coercion a b -> Maybe (Coercion a b)
forall a. a -> Maybe a
Just (Coercion a a -> Coercion a b
forall a b. a -> b
unsafeCoerce (forall (a :: k) (b :: k). Coercible a b => Coercion a b
forall {k} (a :: k) (b :: k). Coercible a b => Coercion a b
Coercion @a @a))
  else Maybe (Coercion a b)
forall a. Maybe a
Nothing

sameArray#
  :: forall {l} (a :: TYPE (BoxedRep l)) (b :: TYPE (BoxedRep l))
  .  Array# a -> Array# b {- ^ -}
  -> Maybe (Coercion a b)
sameArray# :: forall a b. Array# a -> Array# b -> Maybe (Coercion a b)
sameArray# = Array# a -> Array# b -> Maybe (Coercion a b)
forall {k} (f :: k -> UnliftedType) (a :: k) (b :: k).
f a -> f b -> Maybe (Coercion a b)
unsafeSame

sameMutableArray#
  :: forall {l} s (a :: TYPE (BoxedRep l)) (b :: TYPE (BoxedRep l))
  .  MutableArray# s a -> MutableArray# s b {- ^ -}
  -> Maybe (Coercion a b)
sameMutableArray# :: forall s a b.
MutableArray# s a -> MutableArray# s b -> Maybe (Coercion a b)
sameMutableArray# = MutableArray# s a -> MutableArray# s b -> Maybe (Coercion a b)
forall {k} (f :: k -> UnliftedType) (a :: k) (b :: k).
f a -> f b -> Maybe (Coercion a b)
unsafeSame

sameSmallArray#
  :: forall {l} (a :: TYPE (BoxedRep l)) (b :: TYPE (BoxedRep l))
  .  SmallArray# a -> SmallArray# b {- ^ -}
  -> Maybe (Coercion a b)
sameSmallArray# :: forall a b. SmallArray# a -> SmallArray# b -> Maybe (Coercion a b)
sameSmallArray# = SmallArray# a -> SmallArray# b -> Maybe (Coercion a b)
forall {k} (f :: k -> UnliftedType) (a :: k) (b :: k).
f a -> f b -> Maybe (Coercion a b)
unsafeSame

sameSmallMutableArray#
  :: forall {l} s (a :: TYPE (BoxedRep l)) (b :: TYPE (BoxedRep l))
  .  SmallMutableArray# s a -> SmallMutableArray# s b {- ^ -}
  -> Maybe (Coercion a b)
sameSmallMutableArray# :: forall s a b.
SmallMutableArray# s a
-> SmallMutableArray# s b -> Maybe (Coercion a b)
sameSmallMutableArray# = SmallMutableArray# s a
-> SmallMutableArray# s b -> Maybe (Coercion a b)
forall {k} (f :: k -> UnliftedType) (a :: k) (b :: k).
f a -> f b -> Maybe (Coercion a b)
unsafeSame

sameMutVar#
  :: forall {l} s (a :: TYPE (BoxedRep l)) (b :: TYPE (BoxedRep l))
  .  MutVar# s a -> MutVar# s b {- ^ -}
  -> Maybe (Coercion a b)
sameMutVar# :: forall s a b. MutVar# s a -> MutVar# s b -> Maybe (Coercion a b)
sameMutVar# = MutVar# s a -> MutVar# s b -> Maybe (Coercion a b)
forall {k} (f :: k -> UnliftedType) (a :: k) (b :: k).
f a -> f b -> Maybe (Coercion a b)
unsafeSame

sameTVar#
  :: forall {l} s (a :: TYPE (BoxedRep l)) (b :: TYPE (BoxedRep l))
  .  TVar# s a -> TVar# s b {- ^ -}
  -> Maybe (Coercion a b)
sameTVar# :: forall s a b. TVar# s a -> TVar# s b -> Maybe (Coercion a b)
sameTVar# = TVar# s a -> TVar# s b -> Maybe (Coercion a b)
forall {k} (f :: k -> UnliftedType) (a :: k) (b :: k).
f a -> f b -> Maybe (Coercion a b)
unsafeSame

sameMVar#
  :: forall {l} s (a :: TYPE (BoxedRep l)) (b :: TYPE (BoxedRep l))
  .  MVar# s a -> MVar# s b {- ^ -}
  -> Maybe (Coercion a b)
sameMVar# :: forall s a b. MVar# s a -> MVar# s b -> Maybe (Coercion a b)
sameMVar# = MVar# s a -> MVar# s b -> Maybe (Coercion a b)
forall {k} (f :: k -> UnliftedType) (a :: k) (b :: k).
f a -> f b -> Maybe (Coercion a b)
unsafeSame

sameIOPort#
  :: forall {l} s (a :: TYPE (BoxedRep l)) (b :: TYPE (BoxedRep l))
  .  IOPort# s a -> IOPort# s b {- ^ -}
  -> Maybe (Coercion a b)
sameIOPort# :: forall s a b. IOPort# s a -> IOPort# s b -> Maybe (Coercion a b)
sameIOPort# = IOPort# s a -> IOPort# s b -> Maybe (Coercion a b)
forall {k} (f :: k -> UnliftedType) (a :: k) (b :: k).
f a -> f b -> Maybe (Coercion a b)
unsafeSame

samePromptTag# :: PromptTag# a -> PromptTag# b -> Maybe (Coercion a b)
samePromptTag# :: forall a b. PromptTag# a -> PromptTag# b -> Maybe (Coercion a b)
samePromptTag# = PromptTag# a -> PromptTag# b -> Maybe (Coercion a b)
forall {k} (f :: k -> UnliftedType) (a :: k) (b :: k).
f a -> f b -> Maybe (Coercion a b)
unsafeSame

-- }}}

-- --< Pointer Equality: Derived >-- {{{

{- $derived

There are various types in /base/ and /stm/ derived from the primitive types above, but for which opacity precludes leveraging the corresponding functions.
Accordingly, we provide additional @sameFoo@ functions for them here.

\[ \]

-}

unsafeSameC
  :: forall f a b
   . (forall x. Eq (f x))
  => f a -> f b -> Maybe (Coercion a b)
unsafeSameC :: forall {k} (f :: k -> *) (a :: k) (b :: k).
(forall (x :: k). Eq (f x)) =>
f a -> f b -> Maybe (Coercion a b)
unsafeSameC f a
x f b
y = if f a
x f a -> f a -> Bool
forall a. Eq a => a -> a -> Bool
== f b -> f a
forall a b. a -> b
unsafeCoerce f b
y
  then Coercion a b -> Maybe (Coercion a b)
forall a. a -> Maybe a
Just (Coercion a a -> Coercion a b
forall a b. a -> b
unsafeCoerce (forall (a :: k) (b :: k). Coercible a b => Coercion a b
forall {k} (a :: k) (b :: k). Coercible a b => Coercion a b
Coercion @a @a))
  else Maybe (Coercion a b)
forall a. Maybe a
Nothing

sameChan :: Chan a -> Chan b -> Maybe (Coercion a b)
sameChan :: forall a b. Chan a -> Chan b -> Maybe (Coercion a b)
sameChan = Chan a -> Chan b -> Maybe (Coercion a b)
forall {k} (f :: k -> *) (a :: k) (b :: k).
(forall (x :: k). Eq (f x)) =>
f a -> f b -> Maybe (Coercion a b)
unsafeSameC

sameTBQueue :: TBQueue a -> TBQueue b -> Maybe (Coercion a b)
sameTBQueue :: forall a b. TBQueue a -> TBQueue b -> Maybe (Coercion a b)
sameTBQueue = TBQueue a -> TBQueue b -> Maybe (Coercion a b)
forall {k} (f :: k -> *) (a :: k) (b :: k).
(forall (x :: k). Eq (f x)) =>
f a -> f b -> Maybe (Coercion a b)
unsafeSameC

sameTChan :: TChan a -> TChan b -> Maybe (Coercion a b)
sameTChan :: forall a b. TChan a -> TChan b -> Maybe (Coercion a b)
sameTChan = TChan a -> TChan b -> Maybe (Coercion a b)
forall {k} (f :: k -> *) (a :: k) (b :: k).
(forall (x :: k). Eq (f x)) =>
f a -> f b -> Maybe (Coercion a b)
unsafeSameC

sameTMVar :: TMVar a -> TMVar b -> Maybe (Coercion a b)
sameTMVar :: forall a b. TMVar a -> TMVar b -> Maybe (Coercion a b)
sameTMVar = TMVar a -> TMVar b -> Maybe (Coercion a b)
forall {k} (f :: k -> *) (a :: k) (b :: k).
(forall (x :: k). Eq (f x)) =>
f a -> f b -> Maybe (Coercion a b)
unsafeSameC

sameTQueue :: TQueue a -> TQueue b -> Maybe (Coercion a b)
sameTQueue :: forall a b. TQueue a -> TQueue b -> Maybe (Coercion a b)
sameTQueue = TQueue a -> TQueue b -> Maybe (Coercion a b)
forall {k} (f :: k -> *) (a :: k) (b :: k).
(forall (x :: k). Eq (f x)) =>
f a -> f b -> Maybe (Coercion a b)
unsafeSameC

-- }}}