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 analysis

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)
  )

----------------------------------------------------------------
-- the end.