{-# language ConstraintKinds #-}
{-# language UndecidableInstances #-}
{-# options_ghc -Wno-unused-do-bind #-}


module Nix.Thunk.Basic
  ( NThunkF(..)
  , Deferred(..)
  , deferred
  , MonadBasicThunk
  ) where

import           Nix.Prelude
import           Control.Monad.Ref              ( MonadRef(Ref, newRef, readRef, writeRef)
                                                , MonadAtomicRef(atomicModifyRef)
                                                )
import           Control.Monad.Catch            ( MonadCatch(..)
                                                , MonadThrow(throwM)
                                                )
import qualified Text.Show
import           Nix.Thunk


-- * Data type @Deferred@

-- | Data is computed OR in a lazy thunk state which
-- is still not evaluated.
data Deferred m v = Computed v | Deferred (m v)
  deriving (a -> Deferred m b -> Deferred m a
(a -> b) -> Deferred m a -> Deferred m b
(forall a b. (a -> b) -> Deferred m a -> Deferred m b)
-> (forall a b. a -> Deferred m b -> Deferred m a)
-> Functor (Deferred m)
forall a b. a -> Deferred m b -> Deferred m a
forall a b. (a -> b) -> Deferred m a -> Deferred m b
forall (m :: * -> *) a b.
Functor m =>
a -> Deferred m b -> Deferred m a
forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> Deferred m a -> Deferred m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Deferred m b -> Deferred m a
$c<$ :: forall (m :: * -> *) a b.
Functor m =>
a -> Deferred m b -> Deferred m a
fmap :: (a -> b) -> Deferred m a -> Deferred m b
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> Deferred m a -> Deferred m b
Functor, Deferred m a -> Bool
(a -> m) -> Deferred m a -> m
(a -> b -> b) -> b -> Deferred m a -> b
(forall m. Monoid m => Deferred m m -> m)
-> (forall m a. Monoid m => (a -> m) -> Deferred m a -> m)
-> (forall m a. Monoid m => (a -> m) -> Deferred m a -> m)
-> (forall a b. (a -> b -> b) -> b -> Deferred m a -> b)
-> (forall a b. (a -> b -> b) -> b -> Deferred m a -> b)
-> (forall b a. (b -> a -> b) -> b -> Deferred m a -> b)
-> (forall b a. (b -> a -> b) -> b -> Deferred m a -> b)
-> (forall a. (a -> a -> a) -> Deferred m a -> a)
-> (forall a. (a -> a -> a) -> Deferred m a -> a)
-> (forall a. Deferred m a -> [a])
-> (forall a. Deferred m a -> Bool)
-> (forall a. Deferred m a -> Int)
-> (forall a. Eq a => a -> Deferred m a -> Bool)
-> (forall a. Ord a => Deferred m a -> a)
-> (forall a. Ord a => Deferred m a -> a)
-> (forall a. Num a => Deferred m a -> a)
-> (forall a. Num a => Deferred m a -> a)
-> Foldable (Deferred m)
forall a. Eq a => a -> Deferred m a -> Bool
forall a. Num a => Deferred m a -> a
forall a. Ord a => Deferred m a -> a
forall m. Monoid m => Deferred m m -> m
forall a. Deferred m a -> Bool
forall a. Deferred m a -> Int
forall a. Deferred m a -> [a]
forall a. (a -> a -> a) -> Deferred m a -> a
forall m a. Monoid m => (a -> m) -> Deferred m a -> m
forall b a. (b -> a -> b) -> b -> Deferred m a -> b
forall a b. (a -> b -> b) -> b -> Deferred m a -> b
forall (m :: * -> *) a.
(Foldable m, Eq a) =>
a -> Deferred m a -> Bool
forall (m :: * -> *) a. (Foldable m, Num a) => Deferred m a -> a
forall (m :: * -> *) a. (Foldable m, Ord a) => Deferred m a -> a
forall (m :: * -> *) m. (Foldable m, Monoid m) => Deferred m m -> m
forall (m :: * -> *) a. Foldable m => Deferred m a -> Bool
forall (m :: * -> *) a. Foldable m => Deferred m a -> Int
forall (m :: * -> *) a. Foldable m => Deferred m a -> [a]
forall (m :: * -> *) a.
Foldable m =>
(a -> a -> a) -> Deferred m a -> a
forall (m :: * -> *) m a.
(Foldable m, Monoid m) =>
(a -> m) -> Deferred m a -> m
forall (m :: * -> *) b a.
Foldable m =>
(b -> a -> b) -> b -> Deferred m a -> b
forall (m :: * -> *) a b.
Foldable m =>
(a -> b -> b) -> b -> Deferred m a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: Deferred m a -> a
$cproduct :: forall (m :: * -> *) a. (Foldable m, Num a) => Deferred m a -> a
sum :: Deferred m a -> a
$csum :: forall (m :: * -> *) a. (Foldable m, Num a) => Deferred m a -> a
minimum :: Deferred m a -> a
$cminimum :: forall (m :: * -> *) a. (Foldable m, Ord a) => Deferred m a -> a
maximum :: Deferred m a -> a
$cmaximum :: forall (m :: * -> *) a. (Foldable m, Ord a) => Deferred m a -> a
elem :: a -> Deferred m a -> Bool
$celem :: forall (m :: * -> *) a.
(Foldable m, Eq a) =>
a -> Deferred m a -> Bool
length :: Deferred m a -> Int
$clength :: forall (m :: * -> *) a. Foldable m => Deferred m a -> Int
null :: Deferred m a -> Bool
$cnull :: forall (m :: * -> *) a. Foldable m => Deferred m a -> Bool
toList :: Deferred m a -> [a]
$ctoList :: forall (m :: * -> *) a. Foldable m => Deferred m a -> [a]
foldl1 :: (a -> a -> a) -> Deferred m a -> a
$cfoldl1 :: forall (m :: * -> *) a.
Foldable m =>
(a -> a -> a) -> Deferred m a -> a
foldr1 :: (a -> a -> a) -> Deferred m a -> a
$cfoldr1 :: forall (m :: * -> *) a.
Foldable m =>
(a -> a -> a) -> Deferred m a -> a
foldl' :: (b -> a -> b) -> b -> Deferred m a -> b
$cfoldl' :: forall (m :: * -> *) b a.
Foldable m =>
(b -> a -> b) -> b -> Deferred m a -> b
foldl :: (b -> a -> b) -> b -> Deferred m a -> b
$cfoldl :: forall (m :: * -> *) b a.
Foldable m =>
(b -> a -> b) -> b -> Deferred m a -> b
foldr' :: (a -> b -> b) -> b -> Deferred m a -> b
$cfoldr' :: forall (m :: * -> *) a b.
Foldable m =>
(a -> b -> b) -> b -> Deferred m a -> b
foldr :: (a -> b -> b) -> b -> Deferred m a -> b
$cfoldr :: forall (m :: * -> *) a b.
Foldable m =>
(a -> b -> b) -> b -> Deferred m a -> b
foldMap' :: (a -> m) -> Deferred m a -> m
$cfoldMap' :: forall (m :: * -> *) m a.
(Foldable m, Monoid m) =>
(a -> m) -> Deferred m a -> m
foldMap :: (a -> m) -> Deferred m a -> m
$cfoldMap :: forall (m :: * -> *) m a.
(Foldable m, Monoid m) =>
(a -> m) -> Deferred m a -> m
fold :: Deferred m m -> m
$cfold :: forall (m :: * -> *) m. (Foldable m, Monoid m) => Deferred m m -> m
Foldable, Functor (Deferred m)
Foldable (Deferred m)
Functor (Deferred m)
-> Foldable (Deferred m)
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> Deferred m a -> f (Deferred m b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    Deferred m (f a) -> f (Deferred m a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> Deferred m a -> m (Deferred m b))
-> (forall (m :: * -> *) a.
    Monad m =>
    Deferred m (m a) -> m (Deferred m a))
-> Traversable (Deferred m)
(a -> f b) -> Deferred m a -> f (Deferred m b)
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *). Traversable m => Functor (Deferred m)
forall (m :: * -> *). Traversable m => Foldable (Deferred m)
forall (m :: * -> *) (m :: * -> *) a.
(Traversable m, Monad m) =>
Deferred m (m a) -> m (Deferred m a)
forall (m :: * -> *) (f :: * -> *) a.
(Traversable m, Applicative f) =>
Deferred m (f a) -> f (Deferred m a)
forall (m :: * -> *) (m :: * -> *) a b.
(Traversable m, Monad m) =>
(a -> m b) -> Deferred m a -> m (Deferred m b)
forall (m :: * -> *) (f :: * -> *) a b.
(Traversable m, Applicative f) =>
(a -> f b) -> Deferred m a -> f (Deferred m b)
forall (m :: * -> *) a.
Monad m =>
Deferred m (m a) -> m (Deferred m a)
forall (f :: * -> *) a.
Applicative f =>
Deferred m (f a) -> f (Deferred m a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Deferred m a -> m (Deferred m b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Deferred m a -> f (Deferred m b)
sequence :: Deferred m (m a) -> m (Deferred m a)
$csequence :: forall (m :: * -> *) (m :: * -> *) a.
(Traversable m, Monad m) =>
Deferred m (m a) -> m (Deferred m a)
mapM :: (a -> m b) -> Deferred m a -> m (Deferred m b)
$cmapM :: forall (m :: * -> *) (m :: * -> *) a b.
(Traversable m, Monad m) =>
(a -> m b) -> Deferred m a -> m (Deferred m b)
sequenceA :: Deferred m (f a) -> f (Deferred m a)
$csequenceA :: forall (m :: * -> *) (f :: * -> *) a.
(Traversable m, Applicative f) =>
Deferred m (f a) -> f (Deferred m a)
traverse :: (a -> f b) -> Deferred m a -> f (Deferred m b)
$ctraverse :: forall (m :: * -> *) (f :: * -> *) a b.
(Traversable m, Applicative f) =>
(a -> f b) -> Deferred m a -> f (Deferred m b)
$cp2Traversable :: forall (m :: * -> *). Traversable m => Foldable (Deferred m)
$cp1Traversable :: forall (m :: * -> *). Traversable m => Functor (Deferred m)
Traversable)

-- ** Utils

-- | Apply second if @Deferred@, otherwise (@Computed@) - apply first.
-- Analog of @either@ for @Deferred = Computed|Deferred@.
deferred :: (v -> b) -> (m v -> b) -> Deferred m v -> b
deferred :: (v -> b) -> (m v -> b) -> Deferred m v -> b
deferred v -> b
f1 m v -> b
f2 =
  \case
    Computed v
v -> v -> b
f1 v
v
    Deferred m v
action -> m v -> b
f2 m v
action
{-# inline deferred #-}


-- * Thunk references & lock handling

-- | Thunk resource reference (@ref-tf: Ref m@), and as such also also hold
-- a @Bool@ lock flag.
type ThunkRef m = Ref m Bool

-- | Reference (@ref-tf: Ref m v@) to a value that the thunk holds.
type ThunkValueRef m v = Ref m (Deferred m v)

-- | @ref-tf@ lock instruction for @Ref m@ (@ThunkRef@).
lockVal :: Bool -> (Bool, Bool)
lockVal :: Bool -> (Bool, Bool)
lockVal = (Bool
True, )

-- | @ref-tf@ unlock instruction for @Ref m@ (@ThunkRef@).
unlockVal :: Bool -> (Bool, Bool)
unlockVal :: Bool -> (Bool, Bool)
unlockVal = (Bool
False, )

-- | Takes @ref-tf: Ref m@ reference, returns Bool result of the operation.
lock
  :: ( MonadBasicThunk m
    , MonadCatch m
    )
  => ThunkRef m
  -> m Bool
lock :: ThunkRef m -> m Bool
lock ThunkRef m
r = ThunkRef m -> (Bool -> (Bool, Bool)) -> m Bool
forall (m :: * -> *) a b.
MonadAtomicRef m =>
Ref m a -> (a -> (a, b)) -> m b
atomicModifyRef ThunkRef m
r Bool -> (Bool, Bool)
lockVal

-- | Takes @ref-tf: Ref m@ reference, returns Bool result of the operation.
unlock
  :: ( MonadBasicThunk m
    , MonadCatch m
    )
  => ThunkRef m
  -> m Bool
unlock :: ThunkRef m -> m Bool
unlock ThunkRef m
r = ThunkRef m -> (Bool -> (Bool, Bool)) -> m Bool
forall (m :: * -> *) a b.
MonadAtomicRef m =>
Ref m a -> (a -> (a, b)) -> m b
atomicModifyRef ThunkRef m
r Bool -> (Bool, Bool)
unlockVal


-- * Data type for thunks: @NThunkF@

-- | The type of very basic thunks
data NThunkF m v =
  Thunk (ThunkId m) (ThunkRef m) (ThunkValueRef m v)

instance (Eq v, Eq (ThunkId m)) => Eq (NThunkF m v) where
  Thunk ThunkId m
x ThunkRef m
_ ThunkValueRef m v
_ == :: NThunkF m v -> NThunkF m v -> Bool
== Thunk ThunkId m
y ThunkRef m
_ ThunkValueRef m v
_ = ThunkId m
x ThunkId m -> ThunkId m -> Bool
forall a. Eq a => a -> a -> Bool
== ThunkId m
y

instance Show (NThunkF m v) where
  show :: NThunkF m v -> String
show Thunk{} = Text -> String
forall a. ToString a => a -> String
toString Text
thunkStubText

type MonadBasicThunk m = (MonadThunkId m, MonadAtomicRef m)


-- ** @instance MonadThunk NThunkF@

instance (MonadBasicThunk m, MonadCatch m)
  => MonadThunk (NThunkF m v) m v where

  thunkId :: NThunkF m v -> ThunkId m
  thunkId :: NThunkF m v -> ThunkId m
thunkId (Thunk ThunkId m
n ThunkRef m
_ ThunkValueRef m v
_) = ThunkId m
n

  thunk :: m v -> m (NThunkF m v)
  thunk :: m v -> m (NThunkF m v)
thunk m v
action =
    do
      ThunkId m
freshThunkId <- m (ThunkId m)
forall (m :: * -> *). MonadThunkId m => m (ThunkId m)
freshId
      (ThunkRef m -> ThunkValueRef m v -> NThunkF m v)
-> m (ThunkRef m) -> m (ThunkValueRef m v) -> m (NThunkF m v)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (ThunkId m -> ThunkRef m -> ThunkValueRef m v -> NThunkF m v
forall (m :: * -> *) v.
ThunkId m -> ThunkRef m -> ThunkValueRef m v -> NThunkF m v
Thunk ThunkId m
freshThunkId)
        (Bool -> m (ThunkRef m)
forall (m :: * -> *) a. MonadRef m => a -> m (Ref m a)
newRef   Bool
False          )
        (Deferred m v -> m (ThunkValueRef m v)
forall (m :: * -> *) a. MonadRef m => a -> m (Ref m a)
newRef (Deferred m v -> m (ThunkValueRef m v))
-> Deferred m v -> m (ThunkValueRef m v)
forall a b. (a -> b) -> a -> b
$ m v -> Deferred m v
forall (m :: * -> *) v. m v -> Deferred m v
Deferred m v
action)

  query :: m v -> NThunkF m v -> m v
  query :: m v -> NThunkF m v -> m v
query m v
vStub (Thunk ThunkId m
_ ThunkRef m
_ ThunkValueRef m v
lTValRef) =
    (v -> m v) -> (m v -> m v) -> Deferred m v -> m v
forall v b (m :: * -> *).
(v -> b) -> (m v -> b) -> Deferred m v -> b
deferred v -> m v
forall (f :: * -> *) a. Applicative f => a -> f a
pure (m v -> m v -> m v
forall a b. a -> b -> a
const m v
vStub) (Deferred m v -> m v) -> m (Deferred m v) -> m v
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ThunkValueRef m v -> m (Deferred m v)
forall (m :: * -> *) a. MonadRef m => Ref m a -> m a
readRef ThunkValueRef m v
lTValRef

  force :: NThunkF m v -> m v
  force :: NThunkF m v -> m v
force = NThunkF m v -> m v
forall v (m :: * -> *).
(MonadBasicThunk m, MonadCatch m) =>
NThunkF m v -> m v
forceMain

  forceEff :: NThunkF m v -> m v
  forceEff :: NThunkF m v -> m v
forceEff = NThunkF m v -> m v
forall v (m :: * -> *).
(MonadBasicThunk m, MonadCatch m) =>
NThunkF m v -> m v
forceMain

  further :: NThunkF m v -> m (NThunkF m v)
  further :: NThunkF m v -> m (NThunkF m v)
further t :: NThunkF m v
t@(Thunk ThunkId m
_ ThunkRef m
_ ThunkValueRef m v
ref) =
    m (NThunkF m v) -> Deferred m v -> m (NThunkF m v)
forall a b. a -> b -> a
const (NThunkF m v -> m (NThunkF m v)
forall (f :: * -> *) a. Applicative f => a -> f a
pure NThunkF m v
t) (Deferred m v -> m (NThunkF m v))
-> m (Deferred m v) -> m (NThunkF m v)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ThunkValueRef m v
-> (Deferred m v -> (Deferred m v, Deferred m v))
-> m (Deferred m v)
forall (m :: * -> *) a b.
MonadAtomicRef m =>
Ref m a -> (a -> (a, b)) -> m b
atomicModifyRef ThunkValueRef m v
ref Deferred m v -> (Deferred m v, Deferred m v)
forall a. a -> (a, a)
dup


-- *** United body of `force*`

-- | Always returns computed @m v@.
--
-- Checks if resource is computed,
-- if not - with locking evaluates the resource.
forceMain
  :: forall v m
   . ( MonadBasicThunk m
    , MonadCatch m
    )
  => NThunkF m v
  -> m v
forceMain :: NThunkF m v -> m v
forceMain (Thunk ThunkId m
tIdV ThunkRef m
tRefV ThunkValueRef m v
tValRefV) =
  (v -> m v) -> (m v -> m v) -> Deferred m v -> m v
forall v b (m :: * -> *).
(v -> b) -> (m v -> b) -> Deferred m v -> b
deferred v -> m v
forall (f :: * -> *) a. Applicative f => a -> f a
pure m v -> m v
computeW (Deferred m v -> m v) -> m (Deferred m v) -> m v
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ThunkValueRef m v -> m (Deferred m v)
forall (m :: * -> *) a. MonadRef m => Ref m a -> m a
readRef ThunkValueRef m v
tValRefV
 where
  computeW :: m v -> m v
  computeW :: m v -> m v
computeW m v
vDefferred =
    do
      Bool
locked <- ThunkRef m -> m Bool
forall (m :: * -> *).
(MonadBasicThunk m, MonadCatch m) =>
ThunkRef m -> m Bool
lock ThunkRef m
tRefV
      m v -> m v -> Bool -> m v
forall a. a -> a -> Bool -> a
bool
        m v
forall a. m a
lockFailedV
        (do
          v
v <- m v
vDefferred m v -> (SomeException -> m v) -> m v
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
`catch` SomeException -> m v
forall b. SomeException -> m b
bindFailedW
          ThunkValueRef m v -> Deferred m v -> m ()
forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> m ()
writeRef ThunkValueRef m v
tValRefV (Deferred m v -> m ()) -> Deferred m v -> m ()
forall a b. (a -> b) -> a -> b
$ v -> Deferred m v
forall (m :: * -> *) v. v -> Deferred m v
Computed v
v  -- Proclaim value computed
          m Bool
unlockRef
          pure v
v
        )
        (Bool -> m v) -> Bool -> m v
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not Bool
locked
   where
    lockFailedV :: m a
    lockFailedV :: m a
lockFailedV = ThunkLoop -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (ThunkLoop -> m a) -> ThunkLoop -> m a
forall a b. (a -> b) -> a -> b
$ Text -> ThunkLoop
ThunkLoop (Text -> ThunkLoop) -> Text -> ThunkLoop
forall a b. (a -> b) -> a -> b
$ ThunkId m -> Text
forall b a. (Show a, IsString b) => a -> b
show ThunkId m
tIdV

    bindFailedW :: SomeException -> m b
    bindFailedW :: SomeException -> m b
bindFailedW (SomeException
e :: SomeException) =
      do
        m Bool
unlockRef
        SomeException -> m b
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM SomeException
e

    unlockRef :: m Bool
    unlockRef :: m Bool
unlockRef = ThunkRef m -> m Bool
forall (m :: * -> *).
(MonadBasicThunk m, MonadCatch m) =>
ThunkRef m -> m Bool
unlock ThunkRef m
tRefV
{-# inline forceMain #-} -- it is big function, but internal, and look at its use.



-- ** Kleisli functor HOFs: @instance MonadThunkF NThunkF@

instance (MonadBasicThunk m, MonadCatch m)
  => MonadThunkF (NThunkF m v) m v where

  queryF
    :: (v -> m r)
    -> m r
    -> NThunkF m v
    -> m r
  queryF :: (v -> m r) -> m r -> NThunkF m v -> m r
queryF v -> m r
k m r
n (Thunk ThunkId m
_ ThunkRef m
thunkRef ThunkValueRef m v
thunkValRef) =
    do
      Bool
locked <- ThunkRef m -> m Bool
forall (m :: * -> *).
(MonadBasicThunk m, MonadCatch m) =>
ThunkRef m -> m Bool
lock ThunkRef m
thunkRef
      m r -> m r -> Bool -> m r
forall a. a -> a -> Bool -> a
bool
        m r
n
        m r
go
        (Bool -> Bool
not Bool
locked)
    where
      go :: m r
go =
        do
          Deferred m v
eres <- ThunkValueRef m v -> m (Deferred m v)
forall (m :: * -> *) a. MonadRef m => Ref m a -> m a
readRef ThunkValueRef m v
thunkValRef
          r
res  <-
            (v -> m r) -> (m v -> m r) -> Deferred m v -> m r
forall v b (m :: * -> *).
(v -> b) -> (m v -> b) -> Deferred m v -> b
deferred
              v -> m r
k
              (m r -> m v -> m r
forall a b. a -> b -> a
const m r
n)
              Deferred m v
eres
          m Bool
unlockRef
          pure r
res

      unlockRef :: m Bool
unlockRef = ThunkRef m -> m Bool
forall (m :: * -> *).
(MonadBasicThunk m, MonadCatch m) =>
ThunkRef m -> m Bool
unlock ThunkRef m
thunkRef

  forceF
    :: (v -> m a)
    -> NThunkF m v
    -> m a
  forceF :: (v -> m a) -> NThunkF m v -> m a
forceF v -> m a
k = v -> m a
k (v -> m a) -> (NThunkF m v -> m v) -> NThunkF m v -> m a
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< NThunkF m v -> m v
forall t (m :: * -> *) a. MonadThunk t m a => t -> m a
force

  forceEffF
    :: (v -> m r)
    -> NThunkF m v
    -> m r
  forceEffF :: (v -> m r) -> NThunkF m v -> m r
forceEffF v -> m r
k = v -> m r
k (v -> m r) -> (NThunkF m v -> m v) -> NThunkF m v -> m r
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< NThunkF m v -> m v
forall t (m :: * -> *) a. MonadThunk t m a => t -> m a
forceEff

  furtherF
    :: (m v -> m v)
    -> NThunkF m v
    -> m (NThunkF m v)
  furtherF :: (m v -> m v) -> NThunkF m v -> m (NThunkF m v)
furtherF m v -> m v
k t :: NThunkF m v
t@(Thunk ThunkId m
_ ThunkRef m
_ ThunkValueRef m v
ref) =
    do
      Deferred m v
_modifiedIt <- ThunkValueRef m v
-> (Deferred m v -> (Deferred m v, Deferred m v))
-> m (Deferred m v)
forall (m :: * -> *) a b.
MonadAtomicRef m =>
Ref m a -> (a -> (a, b)) -> m b
atomicModifyRef ThunkValueRef m v
ref ((Deferred m v -> (Deferred m v, Deferred m v))
 -> m (Deferred m v))
-> (Deferred m v -> (Deferred m v, Deferred m v))
-> m (Deferred m v)
forall a b. (a -> b) -> a -> b
$
        \Deferred m v
x ->
          (v -> (Deferred m v, Deferred m v))
-> (m v -> (Deferred m v, Deferred m v))
-> Deferred m v
-> (Deferred m v, Deferred m v)
forall v b (m :: * -> *).
(v -> b) -> (m v -> b) -> Deferred m v -> b
deferred
            ((Deferred m v, Deferred m v) -> v -> (Deferred m v, Deferred m v)
forall a b. a -> b -> a
const (Deferred m v
x, Deferred m v
x))
            (\ m v
d -> (m v -> Deferred m v
forall (m :: * -> *) v. m v -> Deferred m v
Deferred (m v -> m v
k m v
d), Deferred m v
x))
            Deferred m v
x
      pure NThunkF m v
t