{-# language MagicHash #-}
{-# language UnboxedTuples #-}
{-# language DataKinds #-}
{-# language PolyKinds #-}
{-# language RoleAnnotations #-}
{-# language ScopedTypeVariables #-}
{-# language TypeFamilies #-}
{-# language TypeOperators #-}
{-# language DataKinds #-}
module Data.Primitive.Unlifted.Weak.IO
( UnliftedWeak_ (..)
, UnliftedWeak
, mkWeakFromUnliftedToUnlifted
, mkWeakToUnlifted
, mkWeakFromUnlifted
, deRefUnliftedWeak
, finalizeUnlifted
, mkUnliftedWeakPtr
, addFinalizerUnlifted
, addCFinalizerToUnliftedWeak1
, addCFinalizerToUnliftedWeak2
, touchUnlifted
) where
import GHC.Exts ( mkWeak#, mkWeakNoFinalizer# )
import Data.Primitive.Unlifted.Class (PrimUnlifted (..))
import Data.Primitive.Unlifted.Weak.Primops
import GHC.IO (IO (..))
import qualified GHC.Weak
import GHC.Ptr (Ptr (..), FunPtr (..))
import qualified GHC.Exts as Exts
import Data.Primitive.Unlifted.Type
data UnliftedWeak_ a (unlifted_a :: UnliftedType) = UnliftedWeak (UnliftedWeak# unlifted_a)
type role UnliftedWeak_ phantom representational
type UnliftedWeak a = UnliftedWeak_ a (Unlifted a)
instance unlifted_a ~ Unlifted a => PrimUnlifted (UnliftedWeak_ a unlifted_a) where
{-# INLINE toUnlifted# #-}
{-# INLINE fromUnlifted# #-}
type Unlifted (UnliftedWeak_ _ unlifted_a) = UnliftedWeak# unlifted_a
toUnlifted# :: UnliftedWeak_ a unlifted_a -> Unlifted (UnliftedWeak_ a unlifted_a)
toUnlifted# (UnliftedWeak UnliftedWeak# unlifted_a
w) = Unlifted (UnliftedWeak_ a unlifted_a)
UnliftedWeak# unlifted_a
w
fromUnlifted# :: Unlifted (UnliftedWeak_ a unlifted_a) -> UnliftedWeak_ a unlifted_a
fromUnlifted# Unlifted (UnliftedWeak_ a unlifted_a)
w = UnliftedWeak# unlifted_a -> UnliftedWeak_ a unlifted_a
forall {k} (a :: k) (unlifted_a :: UnliftedType).
UnliftedWeak# unlifted_a -> UnliftedWeak_ a unlifted_a
UnliftedWeak Unlifted (UnliftedWeak_ a unlifted_a)
UnliftedWeak# unlifted_a
w
mkWeakFromUnliftedToUnlifted
:: (PrimUnlifted k, PrimUnlifted v)
=> k -> v -> Maybe (IO ()) -> IO (UnliftedWeak v)
{-# INLINE mkWeakFromUnliftedToUnlifted #-}
mkWeakFromUnliftedToUnlifted :: forall k v.
(PrimUnlifted k, PrimUnlifted v) =>
k -> v -> Maybe (IO ()) -> IO (UnliftedWeak v)
mkWeakFromUnliftedToUnlifted k
k v
v (Just (IO State# RealWorld -> (# State# RealWorld, () #)
finalizer)) = (State# RealWorld -> (# State# RealWorld, UnliftedWeak v #))
-> IO (UnliftedWeak v)
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO ((State# RealWorld -> (# State# RealWorld, UnliftedWeak v #))
-> IO (UnliftedWeak v))
-> (State# RealWorld -> (# State# RealWorld, UnliftedWeak v #))
-> IO (UnliftedWeak v)
forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s ->
case Unlifted k
-> Unlifted v
-> (State# RealWorld -> (# State# RealWorld, () #))
-> State# RealWorld
-> (# State# RealWorld, UnliftedWeak# (Unlifted v) #)
forall (k :: UnliftedType) (v :: UnliftedType) c.
k
-> v
-> (State# RealWorld -> (# State# RealWorld, c #))
-> State# RealWorld
-> (# State# RealWorld, UnliftedWeak# v #)
mkWeakFromUnliftedToUnlifted# (k -> Unlifted k
forall a. PrimUnlifted a => a -> Unlifted a
toUnlifted# k
k) (v -> Unlifted v
forall a. PrimUnlifted a => a -> Unlifted a
toUnlifted# v
v) State# RealWorld -> (# State# RealWorld, () #)
finalizer State# RealWorld
s of
(# State# RealWorld
s', UnliftedWeak# (Unlifted v)
w #) -> (# State# RealWorld
s', UnliftedWeak# (Unlifted v) -> UnliftedWeak v
forall {k} (a :: k) (unlifted_a :: UnliftedType).
UnliftedWeak# unlifted_a -> UnliftedWeak_ a unlifted_a
UnliftedWeak UnliftedWeak# (Unlifted v)
w #)
mkWeakFromUnliftedToUnlifted k
k v
v Maybe (IO ())
Nothing = (State# RealWorld -> (# State# RealWorld, UnliftedWeak v #))
-> IO (UnliftedWeak v)
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO ((State# RealWorld -> (# State# RealWorld, UnliftedWeak v #))
-> IO (UnliftedWeak v))
-> (State# RealWorld -> (# State# RealWorld, UnliftedWeak v #))
-> IO (UnliftedWeak v)
forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s ->
case Unlifted k
-> Unlifted v
-> State# RealWorld
-> (# State# RealWorld, UnliftedWeak# (Unlifted v) #)
forall (k :: UnliftedType) (v :: UnliftedType).
k
-> v -> State# RealWorld -> (# State# RealWorld, UnliftedWeak# v #)
mkWeakFromUnliftedToUnliftedNoFinalizer# (k -> Unlifted k
forall a. PrimUnlifted a => a -> Unlifted a
toUnlifted# k
k) (v -> Unlifted v
forall a. PrimUnlifted a => a -> Unlifted a
toUnlifted# v
v) State# RealWorld
s of
(# State# RealWorld
s', UnliftedWeak# (Unlifted v)
w #) -> (# State# RealWorld
s', UnliftedWeak# (Unlifted v) -> UnliftedWeak v
forall {k} (a :: k) (unlifted_a :: UnliftedType).
UnliftedWeak# unlifted_a -> UnliftedWeak_ a unlifted_a
UnliftedWeak UnliftedWeak# (Unlifted v)
w #)
mkWeakToUnlifted
:: PrimUnlifted v
=> k -> v -> Maybe (IO ()) -> IO (UnliftedWeak v)
{-# INLINE mkWeakToUnlifted #-}
mkWeakToUnlifted :: forall v k.
PrimUnlifted v =>
k -> v -> Maybe (IO ()) -> IO (UnliftedWeak v)
mkWeakToUnlifted k
k v
v (Just (IO State# RealWorld -> (# State# RealWorld, () #)
finalizer)) = (State# RealWorld -> (# State# RealWorld, UnliftedWeak v #))
-> IO (UnliftedWeak v)
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO ((State# RealWorld -> (# State# RealWorld, UnliftedWeak v #))
-> IO (UnliftedWeak v))
-> (State# RealWorld -> (# State# RealWorld, UnliftedWeak v #))
-> IO (UnliftedWeak v)
forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s ->
case k
-> Unlifted v
-> (State# RealWorld -> (# State# RealWorld, () #))
-> State# RealWorld
-> (# State# RealWorld, UnliftedWeak# (Unlifted v) #)
forall k (v :: UnliftedType) c.
k
-> v
-> (State# RealWorld -> (# State# RealWorld, c #))
-> State# RealWorld
-> (# State# RealWorld, UnliftedWeak# v #)
mkWeakToUnlifted# k
k (v -> Unlifted v
forall a. PrimUnlifted a => a -> Unlifted a
toUnlifted# v
v) State# RealWorld -> (# State# RealWorld, () #)
finalizer State# RealWorld
s of
(# State# RealWorld
s', UnliftedWeak# (Unlifted v)
w #) -> (# State# RealWorld
s', UnliftedWeak# (Unlifted v) -> UnliftedWeak v
forall {k} (a :: k) (unlifted_a :: UnliftedType).
UnliftedWeak# unlifted_a -> UnliftedWeak_ a unlifted_a
UnliftedWeak UnliftedWeak# (Unlifted v)
w #)
mkWeakToUnlifted k
k v
v Maybe (IO ())
Nothing = (State# RealWorld -> (# State# RealWorld, UnliftedWeak v #))
-> IO (UnliftedWeak v)
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO ((State# RealWorld -> (# State# RealWorld, UnliftedWeak v #))
-> IO (UnliftedWeak v))
-> (State# RealWorld -> (# State# RealWorld, UnliftedWeak v #))
-> IO (UnliftedWeak v)
forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s ->
case k
-> Unlifted v
-> State# RealWorld
-> (# State# RealWorld, UnliftedWeak# (Unlifted v) #)
forall k (v :: UnliftedType).
k
-> v -> State# RealWorld -> (# State# RealWorld, UnliftedWeak# v #)
mkWeakToUnliftedNoFinalizer# k
k (v -> Unlifted v
forall a. PrimUnlifted a => a -> Unlifted a
toUnlifted# v
v) State# RealWorld
s of
(# State# RealWorld
s', UnliftedWeak# (Unlifted v)
w #) -> (# State# RealWorld
s', UnliftedWeak# (Unlifted v) -> UnliftedWeak v
forall {k} (a :: k) (unlifted_a :: UnliftedType).
UnliftedWeak# unlifted_a -> UnliftedWeak_ a unlifted_a
UnliftedWeak UnliftedWeak# (Unlifted v)
w #)
mkWeakFromUnlifted
:: PrimUnlifted k
=> k -> v -> Maybe (IO ()) -> IO (GHC.Weak.Weak v)
{-# INLINE mkWeakFromUnlifted #-}
mkWeakFromUnlifted :: forall k v.
PrimUnlifted k =>
k -> v -> Maybe (IO ()) -> IO (Weak v)
mkWeakFromUnlifted k
k v
v (Just (IO State# RealWorld -> (# State# RealWorld, () #)
finalizer)) = (State# RealWorld -> (# State# RealWorld, Weak v #)) -> IO (Weak v)
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO ((State# RealWorld -> (# State# RealWorld, Weak v #))
-> IO (Weak v))
-> (State# RealWorld -> (# State# RealWorld, Weak v #))
-> IO (Weak v)
forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s ->
case Unlifted k
-> v
-> (State# RealWorld -> (# State# RealWorld, () #))
-> State# RealWorld
-> (# State# RealWorld, Weak# v #)
forall a b c.
a
-> b
-> (State# RealWorld -> (# State# RealWorld, c #))
-> State# RealWorld
-> (# State# RealWorld, Weak# b #)
mkWeak# (k -> Unlifted k
forall a. PrimUnlifted a => a -> Unlifted a
toUnlifted# k
k) v
v State# RealWorld -> (# State# RealWorld, () #)
finalizer State# RealWorld
s of
(# State# RealWorld
s', Weak# v
w #) -> (# State# RealWorld
s', Weak# v -> Weak v
forall v. Weak# v -> Weak v
GHC.Weak.Weak Weak# v
w #)
mkWeakFromUnlifted k
k v
v Maybe (IO ())
Nothing = (State# RealWorld -> (# State# RealWorld, Weak v #)) -> IO (Weak v)
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO ((State# RealWorld -> (# State# RealWorld, Weak v #))
-> IO (Weak v))
-> (State# RealWorld -> (# State# RealWorld, Weak v #))
-> IO (Weak v)
forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s ->
case Unlifted k
-> v -> State# RealWorld -> (# State# RealWorld, Weak# v #)
forall a b.
a -> b -> State# RealWorld -> (# State# RealWorld, Weak# b #)
mkWeakNoFinalizer# (k -> Unlifted k
forall a. PrimUnlifted a => a -> Unlifted a
toUnlifted# k
k) v
v State# RealWorld
s of
(# State# RealWorld
s', Weak# v
w #) -> (# State# RealWorld
s', Weak# v -> Weak v
forall v. Weak# v -> Weak v
GHC.Weak.Weak Weak# v
w #)
deRefUnliftedWeak :: PrimUnlifted v => UnliftedWeak v -> IO (Maybe v)
{-# INLINE deRefUnliftedWeak #-}
deRefUnliftedWeak :: forall v. PrimUnlifted v => UnliftedWeak v -> IO (Maybe v)
deRefUnliftedWeak (UnliftedWeak UnliftedWeak# (Unlifted v)
w) = (State# RealWorld -> (# State# RealWorld, Maybe v #))
-> IO (Maybe v)
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO ((State# RealWorld -> (# State# RealWorld, Maybe v #))
-> IO (Maybe v))
-> (State# RealWorld -> (# State# RealWorld, Maybe v #))
-> IO (Maybe v)
forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s ->
case UnliftedWeak# (Unlifted v)
-> State# RealWorld
-> (# State# RealWorld, (# (# #) | Unlifted v #) #)
forall (v :: UnliftedType).
UnliftedWeak# v
-> State# RealWorld -> (# State# RealWorld, (# (# #) | v #) #)
deRefUnliftedWeak# UnliftedWeak# (Unlifted v)
w State# RealWorld
s of
(# State# RealWorld
s', (# (# #) | Unlifted v #)
res #) -> case (# (# #) | Unlifted v #)
res of
(# (# #) | #) -> (# State# RealWorld
s', Maybe v
forall a. Maybe a
Nothing #)
(# | Unlifted v
p #) -> (# State# RealWorld
s', v -> Maybe v
forall a. a -> Maybe a
Just (Unlifted v -> v
forall a. PrimUnlifted a => Unlifted a -> a
fromUnlifted# Unlifted v
p) #)
finalizeUnlifted :: UnliftedWeak v -> IO ()
{-# INLINE finalizeUnlifted #-}
finalizeUnlifted :: forall v. UnliftedWeak v -> IO ()
finalizeUnlifted (UnliftedWeak UnliftedWeak# (Unlifted v)
w) = (State# RealWorld -> (# State# RealWorld, () #)) -> IO ()
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO ((State# RealWorld -> (# State# RealWorld, () #)) -> IO ())
-> (State# RealWorld -> (# State# RealWorld, () #)) -> IO ()
forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s ->
case UnliftedWeak# (Unlifted v)
-> State# RealWorld
-> (# State# RealWorld,
(# (# #) | State# RealWorld -> (# State# RealWorld, () #) #) #)
forall (v :: UnliftedType) b.
UnliftedWeak# v
-> State# RealWorld
-> (# State# RealWorld,
(# (# #) | State# RealWorld -> (# State# RealWorld, b #) #) #)
finalizeUnliftedWeak# UnliftedWeak# (Unlifted v)
w State# RealWorld
s of
(# State# RealWorld
s', (# (# #) | #) #) -> (# State# RealWorld
s', () #)
(# State# RealWorld
s', (# | State# RealWorld -> (# State# RealWorld, () #)
f #) #) -> State# RealWorld -> (# State# RealWorld, () #)
f State# RealWorld
s'
mkUnliftedWeakPtr :: PrimUnlifted k => k -> Maybe (IO ()) -> IO (UnliftedWeak k)
{-# INLINE mkUnliftedWeakPtr #-}
mkUnliftedWeakPtr :: forall k.
PrimUnlifted k =>
k -> Maybe (IO ()) -> IO (UnliftedWeak k)
mkUnliftedWeakPtr k
k Maybe (IO ())
fin = k -> k -> Maybe (IO ()) -> IO (UnliftedWeak_ k (Unlifted k))
forall k v.
(PrimUnlifted k, PrimUnlifted v) =>
k -> v -> Maybe (IO ()) -> IO (UnliftedWeak v)
mkWeakFromUnliftedToUnlifted k
k k
k Maybe (IO ())
fin
addFinalizerUnlifted :: PrimUnlifted k => k -> IO () -> IO ()
{-# INLINE addFinalizerUnlifted #-}
addFinalizerUnlifted :: forall k. PrimUnlifted k => k -> IO () -> IO ()
addFinalizerUnlifted k
k IO ()
fin = do
UnliftedWeak_ k (Unlifted k)
_ <- k -> Maybe (IO ()) -> IO (UnliftedWeak_ k (Unlifted k))
forall k.
PrimUnlifted k =>
k -> Maybe (IO ()) -> IO (UnliftedWeak k)
mkUnliftedWeakPtr k
k (IO () -> Maybe (IO ())
forall a. a -> Maybe a
Just IO ()
fin)
() -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
addCFinalizerToUnliftedWeak1 :: FunPtr (a -> IO ()) -> Ptr a -> UnliftedWeak b -> IO Bool
{-# INLINE addCFinalizerToUnliftedWeak1 #-}
addCFinalizerToUnliftedWeak1 :: forall a b.
FunPtr (a -> IO ()) -> Ptr a -> UnliftedWeak b -> IO Bool
addCFinalizerToUnliftedWeak1 (FunPtr Addr#
f) (Ptr Addr#
a) (UnliftedWeak UnliftedWeak# (Unlifted b)
w) =
(State# RealWorld -> (# State# RealWorld, Bool #)) -> IO Bool
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO ((State# RealWorld -> (# State# RealWorld, Bool #)) -> IO Bool)
-> (State# RealWorld -> (# State# RealWorld, Bool #)) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s -> case Addr#
-> Addr#
-> UnliftedWeak# (Unlifted b)
-> State# RealWorld
-> (# State# RealWorld, Int# #)
forall (b :: UnliftedType).
Addr#
-> Addr#
-> UnliftedWeak# b
-> State# RealWorld
-> (# State# RealWorld, Int# #)
addCFinalizerToUnliftedWeak1# Addr#
f Addr#
a UnliftedWeak# (Unlifted b)
w State# RealWorld
s of
(# State# RealWorld
s', Int#
0# #) -> (# State# RealWorld
s', Bool
False #)
(# State# RealWorld
s', Int#
_ #) -> (# State# RealWorld
s', Bool
True #)
addCFinalizerToUnliftedWeak2 :: FunPtr (a -> b -> IO ()) -> Ptr a -> Ptr b -> UnliftedWeak c -> IO Bool
{-# INLINE addCFinalizerToUnliftedWeak2 #-}
addCFinalizerToUnliftedWeak2 :: forall a b c.
FunPtr (a -> b -> IO ())
-> Ptr a -> Ptr b -> UnliftedWeak c -> IO Bool
addCFinalizerToUnliftedWeak2 (FunPtr Addr#
f) (Ptr Addr#
a) (Ptr Addr#
b) (UnliftedWeak UnliftedWeak# (Unlifted c)
w) =
(State# RealWorld -> (# State# RealWorld, Bool #)) -> IO Bool
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO ((State# RealWorld -> (# State# RealWorld, Bool #)) -> IO Bool)
-> (State# RealWorld -> (# State# RealWorld, Bool #)) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s -> case Addr#
-> Addr#
-> Addr#
-> UnliftedWeak# (Unlifted c)
-> State# RealWorld
-> (# State# RealWorld, Int# #)
forall (b :: UnliftedType).
Addr#
-> Addr#
-> Addr#
-> UnliftedWeak# b
-> State# RealWorld
-> (# State# RealWorld, Int# #)
addCFinalizerToUnliftedWeak2# Addr#
f Addr#
a Addr#
b UnliftedWeak# (Unlifted c)
w State# RealWorld
s of
(# State# RealWorld
s', Int#
0# #) -> (# State# RealWorld
s', Bool
False #)
(# State# RealWorld
s', Int#
_ #) -> (# State# RealWorld
s', Bool
True #)
touchUnlifted
:: PrimUnlifted a
=> a -> IO ()
touchUnlifted :: forall a. PrimUnlifted a => a -> IO ()
touchUnlifted a
a = (State# RealWorld -> (# State# RealWorld, () #)) -> IO ()
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO ((State# RealWorld -> (# State# RealWorld, () #)) -> IO ())
-> (State# RealWorld -> (# State# RealWorld, () #)) -> IO ()
forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s ->
(# Unlifted a -> State# RealWorld -> State# RealWorld
forall a. a -> State# RealWorld -> State# RealWorld
Exts.touch# (a -> Unlifted a
forall a. PrimUnlifted a => a -> Unlifted a
toUnlifted# a
a) State# RealWorld
s, () #)