{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE MagicHash, UnboxedTuples, RankNTypes, TypeOperators #-}
module Data.Ref (Ref, module Data.Ref) where

import Control.Monad.RT.Unsafe (RT(RT))
import Data.Ref.Impl (Ref(Ref))

import GHC.Base (newMutVar#, readMutVar#, writeMutVar#)

import GHC.IORef (IORef(IORef))
import GHC.STRef (STRef(STRef))

import Data.Type.Equality ((:~:)(Refl))
import Unsafe.Coerce (unsafeCoerce)


{-# INLINABLE newRef #-}
newRef :: a -> (forall r. Ref r a -> RT b) -> RT b
newRef :: forall a b. a -> (forall r. Ref r a -> RT b) -> RT b
newRef a
x forall r. Ref r a -> RT b
k = (State# RealWorld -> (# State# RealWorld, b #)) -> RT b
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> RT a
RT ((State# RealWorld -> (# State# RealWorld, b #)) -> RT b)
-> (State# RealWorld -> (# State# RealWorld, b #)) -> RT b
forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s# ->
  case a
-> State# RealWorld -> (# State# RealWorld, MutVar# RealWorld a #)
forall a d. a -> State# d -> (# State# d, MutVar# d a #)
newMutVar# a
x State# RealWorld
s# of
    (# State# RealWorld
s'#, MutVar# RealWorld a
ref# #) -> let RT State# RealWorld -> (# State# RealWorld, b #)
k' = Ref Any a -> RT b
forall r. Ref r a -> RT b
k (MutVar# RealWorld a -> Ref Any a
forall r a. MutVar# RealWorld a -> Ref r a
Ref MutVar# RealWorld a
ref#) in State# RealWorld -> (# State# RealWorld, b #)
k' State# RealWorld
s'#

{-# INLINE readRef #-}
readRef :: Ref r a -> RT a
readRef :: forall r a. Ref r a -> RT a
readRef (Ref MutVar# RealWorld a
ref#) = (State# RealWorld -> (# State# RealWorld, a #)) -> RT a
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> RT a
RT ((State# RealWorld -> (# State# RealWorld, a #)) -> RT a)
-> (State# RealWorld -> (# State# RealWorld, a #)) -> RT a
forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s# -> MutVar# RealWorld a
-> State# RealWorld -> (# State# RealWorld, a #)
forall d a. MutVar# d a -> State# d -> (# State# d, a #)
readMutVar# MutVar# RealWorld a
ref# State# RealWorld
s#

{-# INLINABLE writeRef #-}
writeRef :: Ref r a -> a -> RT ()
writeRef :: forall r a. Ref r a -> a -> RT ()
writeRef (Ref MutVar# RealWorld a
ref#) a
x = (State# RealWorld -> (# State# RealWorld, () #)) -> RT ()
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> RT a
RT ((State# RealWorld -> (# State# RealWorld, () #)) -> RT ())
-> (State# RealWorld -> (# State# RealWorld, () #)) -> RT ()
forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s# ->
  case MutVar# RealWorld a -> a -> State# RealWorld -> State# RealWorld
forall d a. MutVar# d a -> a -> State# d -> State# d
writeMutVar# MutVar# RealWorld a
ref# a
x State# RealWorld
s# of
    State# RealWorld
s'# -> (# State# RealWorld
s'#, () #)

-- unsafeFromIORef?
{-# INLINE fromIORef #-}
fromIORef :: IORef a -> Ref r a
fromIORef :: forall a r. IORef a -> Ref r a
fromIORef (IORef (STRef MutVar# RealWorld a
ref#)) = MutVar# RealWorld a -> Ref r a
forall r a. MutVar# RealWorld a -> Ref r a
Ref MutVar# RealWorld a
ref#

-- returns a proof that if two references are equal, they must have the same lifetime
lifetimeEqual :: Ref r1 a -> Ref r2 a -> Maybe (r1 :~: r2)
lifetimeEqual :: forall r1 a r2. Ref r1 a -> Ref r2 a -> Maybe (r1 :~: r2)
lifetimeEqual (Ref MutVar# RealWorld a
ref1#) Ref r2 a
ref2
  | MutVar# RealWorld a -> Ref r2 a
forall r a. MutVar# RealWorld a -> Ref r a
Ref MutVar# RealWorld a
ref1# Ref r2 a -> Ref r2 a -> Bool
forall a. Eq a => a -> a -> Bool
== Ref r2 a
ref2 = (r1 :~: r2) -> Maybe (r1 :~: r2)
forall a. a -> Maybe a
Just ((Any :~: Any) -> r1 :~: r2
forall a b. a -> b
unsafeCoerce Any :~: Any
forall {k} (a :: k). a :~: a
Refl)
  | Bool
otherwise         = Maybe (r1 :~: r2)
forall a. Maybe a
Nothing