{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE CPP #-}
module Data.Recursive.Propagator.P2
( P2
, newP2
, newTopP2
, setTop
, whenTop
, implies
, isTop
, PBool(..)
, PDualBool(..)
)
where
#ifdef DEJAFU
#define Ctxt MonadConc m =>
#define MaybeTop_ (MaybeTop m)
#define P2_ (P2 m)
#define PBool_ PBool m
#define PDualBool_ PDualBool m
#define IORef_ IORef m
#define MVar_ MVar m
#define M m
import Control.Concurrent.Classy
#else
#define Ctxt
#define MaybeTop_ MaybeTop
#define P2_ P2
#define PBool_ PBool
#define PDualBool_ PDualBool
#define IORef_ IORef
#define MVar_ MVar
#define M IO
import Control.Concurrent.MVar
import Data.IORef
#endif
data MaybeTop_
= StillBottom (M ())
| SurelyTop
newtype P2_ = P2 (MVar_ MaybeTop_)
newP2 :: Ctxt M P2_
newP2 :: IO P2
newP2 = MVar MaybeTop -> P2
P2 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. a -> IO (MVar a)
newMVar (IO () -> MaybeTop
StillBottom (forall (f :: * -> *) a. Applicative f => a -> f a
pure()))
newTopP2 :: Ctxt M P2_
newTopP2 :: IO P2
newTopP2 = MVar MaybeTop -> P2
P2 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. a -> IO (MVar a)
newMVar MaybeTop
SurelyTop
whenTop :: Ctxt P2_ -> M () -> M ()
whenTop :: P2 -> IO () -> IO ()
whenTop (P2 MVar MaybeTop
p1) IO ()
act = forall a. MVar a -> IO a
takeMVar MVar MaybeTop
p1 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
MaybeTop
SurelyTop -> forall a. MVar a -> a -> IO ()
putMVar MVar MaybeTop
p1 MaybeTop
SurelyTop forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO ()
act
StillBottom IO ()
act' -> forall a. MVar a -> a -> IO ()
putMVar MVar MaybeTop
p1 (IO () -> MaybeTop
StillBottom (IO ()
act forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO ()
act'))
setTop :: Ctxt P2_ -> M ()
setTop :: P2 -> IO ()
setTop (P2 MVar MaybeTop
p) = forall a. MVar a -> IO a
takeMVar MVar MaybeTop
p forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
MaybeTop
SurelyTop -> forall a. MVar a -> a -> IO ()
putMVar MVar MaybeTop
p MaybeTop
SurelyTop
StillBottom IO ()
act -> do
forall a. MVar a -> a -> IO ()
putMVar MVar MaybeTop
p MaybeTop
SurelyTop
IO ()
act
implies :: Ctxt P2_ -> P2_ -> M ()
implies :: P2 -> P2 -> IO ()
implies P2
p1 P2
p2 = P2 -> IO () -> IO ()
whenTop P2
p1 (P2 -> IO ()
setTop P2
p2)
isTop :: Ctxt P2_ -> M Bool
isTop :: P2 -> IO Bool
isTop (P2 MVar MaybeTop
p) = forall a. MVar a -> IO a
readMVar MVar MaybeTop
p forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
MaybeTop
SurelyTop -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
StillBottom IO ()
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
newtype PBool_ = PBool P2_
newtype PDualBool_ = PDualBool P2_