{-# language MagicHash #-}
{-# language UnboxedTuples #-}
{-# language DataKinds #-}
{-# language PolyKinds #-}
{-# language RoleAnnotations #-}
{-# language ScopedTypeVariables #-}
{-# language TypeFamilies #-}
{-# language TypeOperators #-}

-- | "System.Mem.Weak" provides weak references from lifted keys to lifted
-- values. "Data.IORef", "Control.Concurrent.MVar", and
-- @Control.Concurrent.STM.TVar@ provide operations for producing weak
-- references from unlifted keys /of specific types/ to lifted values.
--
-- This module fills in the gaps. It offers a type ('UnliftedWeak') for weak
-- references from (lifted or unlifted) keys to unlifted values. It also
-- provides fully general operations for producing weak references from
-- unlifted keys to lifted values.
--
-- Usage note: Weak references /from/ lifted types can be fragile in the face
-- of GHC's unboxing optimizations. Weak references from unlifted types are
-- much more reliable. Weak references /to/ boxed types that wrap unlifted
-- types tend to be inefficient, because they keep not only the actual value
-- alive but also its box. Unless it's necessary to create a 'SMW.Weak'
-- reference to an unevaluated thunk, it's generally best to create an
-- 'UnliftedWeak' reference to the unlifted value instead.
module Data.Primitive.Unlifted.Weak
  ( UnliftedWeak_ (..)
  , UnliftedWeak
  , mkWeakFromUnliftedToUnlifted
  , mkWeakToUnlifted
  , mkWeakFromUnlifted
  , deRefUnliftedWeak
  , finalizeUnlifted
  , mkUnliftedWeakPtr
  , addFinalizerUnlifted
  , addCFinalizerToUnliftedWeak1
  , addCFinalizerToUnliftedWeak2
  , touchUnlifted
  ) where
import Control.Monad.Primitive (PrimMonad,PrimState,ioToPrim)
import GHC.Exts (RealWorld)
import Data.Primitive.Unlifted.Class (PrimUnlifted)
import Data.Primitive.Unlifted.Weak.IO (UnliftedWeak_ (..), UnliftedWeak)
import qualified Data.Primitive.Unlifted.Weak.IO as W
import qualified System.Mem.Weak as SMW
import Foreign.Ptr (Ptr, FunPtr)

-- | Establishes a weak pointer from an unlifted value @k@ to an
-- unlifted value @v@ with an optional finalizer.
mkWeakFromUnliftedToUnlifted
  :: (PrimUnlifted k, PrimUnlifted v, PrimMonad m, PrimState m ~ RealWorld)
  => k -> v -> Maybe (IO ()) -> m (UnliftedWeak v)
{-# INLINE mkWeakFromUnliftedToUnlifted #-}
-- Why do we insist on an IO argument and not just a PrimBase one?
-- No particular reason. But that seems likely to make the type
-- harder to read without much practical benefit. Users can always use
-- primToIO if necessary to write their finalizers.
mkWeakFromUnliftedToUnlifted :: forall k v (m :: * -> *).
(PrimUnlifted k, PrimUnlifted v, PrimMonad m,
 PrimState m ~ RealWorld) =>
k -> v -> Maybe (IO ()) -> m (UnliftedWeak v)
mkWeakFromUnliftedToUnlifted k
k v
v Maybe (IO ())
mf = IO (UnliftedWeak v) -> m (UnliftedWeak v)
forall (m :: * -> *) a.
(PrimMonad m, PrimState m ~ RealWorld) =>
IO a -> m a
ioToPrim (IO (UnliftedWeak v) -> m (UnliftedWeak v))
-> IO (UnliftedWeak v) -> m (UnliftedWeak v)
forall a b. (a -> b) -> a -> b
$ k -> v -> Maybe (IO ()) -> IO (UnliftedWeak v)
forall k v.
(PrimUnlifted k, PrimUnlifted v) =>
k -> v -> Maybe (IO ()) -> IO (UnliftedWeak v)
W.mkWeakFromUnliftedToUnlifted k
k v
v Maybe (IO ())
mf

-- | Establishes a weak pointer from a lifted value @k@ to an
-- unlifted value @v@ with an optional finalizer.
mkWeakToUnlifted
  :: (PrimUnlifted v, PrimMonad m, PrimState m ~ RealWorld)
  => k -> v -> Maybe (IO ()) -> m (UnliftedWeak v)
{-# INLINE mkWeakToUnlifted #-}
mkWeakToUnlifted :: forall v (m :: * -> *) k.
(PrimUnlifted v, PrimMonad m, PrimState m ~ RealWorld) =>
k -> v -> Maybe (IO ()) -> m (UnliftedWeak v)
mkWeakToUnlifted k
k v
v Maybe (IO ())
mf = IO (UnliftedWeak v) -> m (UnliftedWeak v)
forall (m :: * -> *) a.
(PrimMonad m, PrimState m ~ RealWorld) =>
IO a -> m a
ioToPrim (IO (UnliftedWeak v) -> m (UnliftedWeak v))
-> IO (UnliftedWeak v) -> m (UnliftedWeak v)
forall a b. (a -> b) -> a -> b
$ k -> v -> Maybe (IO ()) -> IO (UnliftedWeak v)
forall v k.
PrimUnlifted v =>
k -> v -> Maybe (IO ()) -> IO (UnliftedWeak v)
W.mkWeakToUnlifted k
k v
v Maybe (IO ())
mf

-- | Establishes a weak pointer from an unlifted value @k@ to a
-- lifted value @v@ with an optional finalizer.
mkWeakFromUnlifted
  :: (PrimUnlifted k, PrimMonad m, PrimState m ~ RealWorld)
  => k -> v -> Maybe (IO ()) -> m (SMW.Weak v)
{-# INLINE mkWeakFromUnlifted #-}
mkWeakFromUnlifted :: forall k (m :: * -> *) v.
(PrimUnlifted k, PrimMonad m, PrimState m ~ RealWorld) =>
k -> v -> Maybe (IO ()) -> m (Weak v)
mkWeakFromUnlifted k
k v
v Maybe (IO ())
mf = IO (Weak v) -> m (Weak v)
forall (m :: * -> *) a.
(PrimMonad m, PrimState m ~ RealWorld) =>
IO a -> m a
ioToPrim (IO (Weak v) -> m (Weak v)) -> IO (Weak v) -> m (Weak v)
forall a b. (a -> b) -> a -> b
$ k -> v -> Maybe (IO ()) -> IO (Weak v)
forall k v.
PrimUnlifted k =>
k -> v -> Maybe (IO ()) -> IO (Weak v)
W.mkWeakFromUnlifted k
k v
v Maybe (IO ())
mf

-- | Derefences a weak pointer. If the key is still alive and the
-- pointer has not been finalized with 'finalizeUnlifted', then
-- @Just v@ is returned, where @v@ is the /value/ in the weak
-- pointer. Otherwise, @Nothing@ is returned.
deRefUnliftedWeak
  :: (PrimUnlifted v, PrimMonad m, PrimState m ~ RealWorld)
   => UnliftedWeak v -> m (Maybe v)
{-# INLINE deRefUnliftedWeak #-}
deRefUnliftedWeak :: forall v (m :: * -> *).
(PrimUnlifted v, PrimMonad m, PrimState m ~ RealWorld) =>
UnliftedWeak v -> m (Maybe v)
deRefUnliftedWeak UnliftedWeak v
w = IO (Maybe v) -> m (Maybe v)
forall (m :: * -> *) a.
(PrimMonad m, PrimState m ~ RealWorld) =>
IO a -> m a
ioToPrim (IO (Maybe v) -> m (Maybe v)) -> IO (Maybe v) -> m (Maybe v)
forall a b. (a -> b) -> a -> b
$ UnliftedWeak v -> IO (Maybe v)
forall v. PrimUnlifted v => UnliftedWeak v -> IO (Maybe v)
W.deRefUnliftedWeak UnliftedWeak v
w

-- | Immediately finalize a weak pointer.
finalizeUnlifted
  :: (PrimMonad m, PrimState m ~ RealWorld)
  => UnliftedWeak v -> m ()
{-# INLINE finalizeUnlifted #-}
finalizeUnlifted :: forall (m :: * -> *) v.
(PrimMonad m, PrimState m ~ RealWorld) =>
UnliftedWeak v -> m ()
finalizeUnlifted UnliftedWeak v
w = IO () -> m ()
forall (m :: * -> *) a.
(PrimMonad m, PrimState m ~ RealWorld) =>
IO a -> m a
ioToPrim (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ UnliftedWeak v -> IO ()
forall v. UnliftedWeak v -> IO ()
W.finalizeUnlifted UnliftedWeak v
w

-- | Make a weak pointer from an unlifted value to itself.
--
-- Note: This should generally be preferred to @Data.IORef.mkWeakIORef@
-- and similar for making weak pointers to @IORef@s, @MVar@s, @TVar@s,
-- etc, as the values are stored more directly and compactly this way.
mkUnliftedWeakPtr
  :: (PrimUnlifted k, PrimMonad m, PrimState m ~ RealWorld)
  => k -> Maybe (IO ()) -> m (UnliftedWeak k)
{-# INLINE mkUnliftedWeakPtr #-}
mkUnliftedWeakPtr :: forall k (m :: * -> *).
(PrimUnlifted k, PrimMonad m, PrimState m ~ RealWorld) =>
k -> Maybe (IO ()) -> m (UnliftedWeak k)
mkUnliftedWeakPtr k
k Maybe (IO ())
fin = IO (UnliftedWeak k) -> m (UnliftedWeak k)
forall (m :: * -> *) a.
(PrimMonad m, PrimState m ~ RealWorld) =>
IO a -> m a
ioToPrim (IO (UnliftedWeak k) -> m (UnliftedWeak k))
-> IO (UnliftedWeak k) -> m (UnliftedWeak k)
forall a b. (a -> b) -> a -> b
$ k -> Maybe (IO ()) -> IO (UnliftedWeak k)
forall k.
PrimUnlifted k =>
k -> Maybe (IO ()) -> IO (UnliftedWeak k)
W.mkUnliftedWeakPtr k
k Maybe (IO ())
fin

-- | A specialised version of @mkUnliftedWeakPtr@, where the @UnliftedWeak@
-- object returned is simply thrown away (however the finalizer will be
-- remembered by the garbage collector, and will still be run when the key
-- becomes unreachable).
addFinalizerUnlifted
  :: (PrimUnlifted k, PrimMonad m, PrimState m ~ RealWorld)
   => k -> IO () -> m ()
{-# INLINE addFinalizerUnlifted #-}
addFinalizerUnlifted :: forall k (m :: * -> *).
(PrimUnlifted k, PrimMonad m, PrimState m ~ RealWorld) =>
k -> IO () -> m ()
addFinalizerUnlifted k
k IO ()
fin = IO () -> m ()
forall (m :: * -> *) a.
(PrimMonad m, PrimState m ~ RealWorld) =>
IO a -> m a
ioToPrim (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ k -> IO () -> IO ()
forall k. PrimUnlifted k => k -> IO () -> IO ()
W.addFinalizerUnlifted k
k IO ()
fin

-- | Add a finalizer written in C to an 'UnliftedWeak'. Takes a pointer to a C
-- function of one argument and an argument to call it with. Returns 'True'
-- on success, or 'False' if the 'UnliftedWeak' is already dead.
addCFinalizerToUnliftedWeak1
  :: (PrimMonad m, PrimState m ~ RealWorld)
  => FunPtr (a -> IO ()) -> Ptr a -> UnliftedWeak b -> m Bool
{-# INLINE addCFinalizerToUnliftedWeak1 #-}
addCFinalizerToUnliftedWeak1 :: forall (m :: * -> *) a b.
(PrimMonad m, PrimState m ~ RealWorld) =>
FunPtr (a -> IO ()) -> Ptr a -> UnliftedWeak b -> m Bool
addCFinalizerToUnliftedWeak1 FunPtr (a -> IO ())
f Ptr a
a UnliftedWeak b
w = IO Bool -> m Bool
forall (m :: * -> *) a.
(PrimMonad m, PrimState m ~ RealWorld) =>
IO a -> m a
ioToPrim (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ FunPtr (a -> IO ()) -> Ptr a -> UnliftedWeak b -> IO Bool
forall a b.
FunPtr (a -> IO ()) -> Ptr a -> UnliftedWeak b -> IO Bool
W.addCFinalizerToUnliftedWeak1 FunPtr (a -> IO ())
f Ptr a
a UnliftedWeak b
w

-- | Add a finalizer written in C to an 'UnliftedWeak'. Takes a pointer to a C
-- function of two arguments and arguments to call it with. Returns 'True'
-- on success, or 'False' if the 'UnliftedWeak' is already dead.
addCFinalizerToUnliftedWeak2
  :: (PrimMonad m, PrimState m ~ RealWorld)
  => FunPtr (a -> b -> IO ()) -> Ptr a -> Ptr b -> UnliftedWeak c -> m Bool
{-# INLINE addCFinalizerToUnliftedWeak2 #-}
addCFinalizerToUnliftedWeak2 :: forall (m :: * -> *) a b c.
(PrimMonad m, PrimState m ~ RealWorld) =>
FunPtr (a -> b -> IO ())
-> Ptr a -> Ptr b -> UnliftedWeak c -> m Bool
addCFinalizerToUnliftedWeak2 FunPtr (a -> b -> IO ())
f Ptr a
a Ptr b
b UnliftedWeak c
w = IO Bool -> m Bool
forall (m :: * -> *) a.
(PrimMonad m, PrimState m ~ RealWorld) =>
IO a -> m a
ioToPrim (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ FunPtr (a -> b -> IO ())
-> Ptr a -> Ptr b -> UnliftedWeak c -> IO Bool
forall a b c.
FunPtr (a -> b -> IO ())
-> Ptr a -> Ptr b -> UnliftedWeak c -> IO Bool
W.addCFinalizerToUnliftedWeak2 FunPtr (a -> b -> IO ())
f Ptr a
a Ptr b
b UnliftedWeak c
w

-- | Ensure that a value is considered live by the garbage collector at a
-- particular point in the program. Typically, this is used to prevent foreign
-- resources from being finalized while they are still being used.
--
-- Considerable care is required when using this operation (see GHC ticket
-- 14346). In particular, if GHC sees that an action @m@ will never complete
-- normally, then it will simplify @m >> touchUnlifted a@ to @m@, allowing @a@
-- to die prematurely. For now, functions using @touchUnlifted@ may require
-- careful use of @NOINLINE@ to work around this; in the future, GHC will
-- probably provide a more robust operation for keeping values alive.
touchUnlifted
  :: (PrimUnlifted a, PrimMonad m, PrimState m ~ RealWorld)
  => a -> m ()
touchUnlifted :: forall a (m :: * -> *).
(PrimUnlifted a, PrimMonad m, PrimState m ~ RealWorld) =>
a -> m ()
touchUnlifted a
a = IO () -> m ()
forall (m :: * -> *) a.
(PrimMonad m, PrimState m ~ RealWorld) =>
IO a -> m a
ioToPrim (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ a -> IO ()
forall a. PrimUnlifted a => a -> IO ()
W.touchUnlifted a
a