module Lava.Stable where
import Lava.Signal
import Lava.Operators
import Lava.Generic
import Lava.Sequent
import Lava.Ref
import Lava.MyST
( STRef
, newSTRef
, readSTRef
, writeSTRef
, runST
, unsafeInterleaveST
)
import Data.List
( isPrefixOf
)
stable :: Generic a => a -> Signal Bool
stable :: a -> Signal Bool
stable inp :: a
inp =
(forall s. ST s (Signal Bool)) -> Signal Bool
forall a. (forall s. ST s a) -> a
runST
( do TableST s (S Symbol) ()
table <- ST s (TableST s (S Symbol) ())
forall s a b. ST s (TableST s a b)
tableST
STRef s [Signal Bool]
stableRef <- [Signal Bool] -> ST s (STRef s [Signal Bool])
forall a s. a -> ST s (STRef s a)
newSTRef []
let gather :: Symbol -> ST s ()
gather (Symbol sym :: Ref (S Symbol)
sym) =
do Maybe ()
ms <- TableST s (S Symbol) () -> Ref (S Symbol) -> ST s (Maybe ())
forall s a b. TableST s a b -> Ref a -> ST s (Maybe b)
findST TableST s (S Symbol) ()
table Ref (S Symbol)
sym
case Maybe ()
ms of
Just () -> do () -> ST s ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Nothing -> do TableST s (S Symbol) () -> Ref (S Symbol) -> () -> ST s ()
forall s a b. TableST s a b -> Ref a -> b -> ST s ()
extendST TableST s (S Symbol) ()
table Ref (S Symbol)
sym ()
(Symbol -> ST s ()) -> S Symbol -> ST s (S ())
forall (m :: * -> *) (s :: * -> *) a b.
(Monad m, Sequent s) =>
(a -> m b) -> s a -> m (s b)
mmap Symbol -> ST s ()
gather (Ref (S Symbol) -> S Symbol
forall a. Ref a -> a
deref Ref (S Symbol)
sym)
Symbol -> S Symbol -> ST s ()
forall a. Generic a => a -> S a -> ST s ()
define (Ref (S Symbol) -> Symbol
Symbol Ref (S Symbol)
sym) (Ref (S Symbol) -> S Symbol
forall a. Ref a -> a
deref Ref (S Symbol)
sym)
define :: a -> S a -> ST s ()
define out :: a
out (DelayBool _ inn :: a
inn) =
do Signal Bool -> ST s ()
addStable (a
out a -> a -> Signal Bool
forall a. Generic a => a -> a -> Signal Bool
<==> a
inn)
define out :: a
out (DelayInt _ inn :: a
inn) =
do Signal Bool -> ST s ()
addStable (a
out a -> a -> Signal Bool
forall a. Generic a => a -> a -> Signal Bool
<==> a
inn)
define _ _ =
do () -> ST s ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
addStable :: Signal Bool -> ST s ()
addStable x :: Signal Bool
x =
do [Signal Bool]
stables <- STRef s [Signal Bool] -> ST s [Signal Bool]
forall s a. STRef s a -> ST s a
readSTRef STRef s [Signal Bool]
stableRef
STRef s [Signal Bool] -> [Signal Bool] -> ST s ()
forall s a. STRef s a -> a -> ST s ()
writeSTRef STRef s [Signal Bool]
stableRef (Signal Bool
xSignal Bool -> [Signal Bool] -> [Signal Bool]
forall a. a -> [a] -> [a]
:[Signal Bool]
stables)
in (Symbol -> ST s ()) -> Struct Symbol -> ST s (Struct ())
forall (m :: * -> *) (s :: * -> *) a b.
(Monad m, Sequent s) =>
(a -> m b) -> s a -> m (s b)
mmap Symbol -> ST s ()
gather (a -> Struct Symbol
forall a. Generic a => a -> Struct Symbol
struct a
inp)
[Signal Bool]
stables <- STRef s [Signal Bool] -> ST s [Signal Bool]
forall s a. STRef s a -> ST s a
readSTRef STRef s [Signal Bool]
stableRef
Signal Bool -> ST s (Signal Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return ([Signal Bool] -> Signal Bool
andl [Signal Bool]
stables)
)