module Lava.Netlist
( netlist
, netlistIO
, netlistST
)
where
import Lava.Ref
import Lava.Signal
import Lava.Generic
import Lava.Sequent
import Lava.MyST
( ST
)
netlist :: Functor f => (S a -> a) -> f Symbol -> f a
netlist :: (S a -> a) -> f Symbol -> f a
netlist phi :: S a -> a
phi symbols :: f Symbol
symbols = (Symbol -> a) -> f Symbol -> f a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Symbol -> a
cata f Symbol
symbols
where
cata :: Symbol -> a
cata (Symbol sym :: Ref (S Symbol)
sym) = Ref (S Symbol) -> a
cata' Ref (S Symbol)
sym
cata' :: Ref (S Symbol) -> a
cata' = (Ref (S Symbol) -> a) -> Ref (S Symbol) -> a
forall a b. (Ref a -> b) -> Ref a -> b
memoRef (S a -> a
phi (S a -> a) -> (Ref (S Symbol) -> S a) -> Ref (S Symbol) -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Symbol -> a) -> S Symbol -> S a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Symbol -> a
cata (S Symbol -> S a)
-> (Ref (S Symbol) -> S Symbol) -> Ref (S Symbol) -> S a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ref (S Symbol) -> S Symbol
forall a. Ref a -> a
deref)
netlistIO :: Sequent f => IO v -> (v -> S v -> IO ()) -> f Symbol -> IO (f v)
netlistIO :: IO v -> (v -> S v -> IO ()) -> f Symbol -> IO (f v)
netlistIO new :: IO v
new define :: v -> S v -> IO ()
define symbols :: f Symbol
symbols =
do TableIO (S Symbol) v
tab <- IO (TableIO (S Symbol) v)
forall a b. IO (TableIO a b)
tableIO
let gather :: Symbol -> IO v
gather (Symbol sym :: Ref (S Symbol)
sym) =
do Maybe v
visited <- TableIO (S Symbol) v -> Ref (S Symbol) -> IO (Maybe v)
forall a b. TableIO a b -> Ref a -> IO (Maybe b)
findIO TableIO (S Symbol) v
tab Ref (S Symbol)
sym
case Maybe v
visited of
Just v :: v
v -> do v -> IO v
forall (m :: * -> *) a. Monad m => a -> m a
return v
v
Nothing -> do v
v <- IO v
new
TableIO (S Symbol) v -> Ref (S Symbol) -> v -> IO ()
forall a b. TableIO a b -> Ref a -> b -> IO ()
extendIO TableIO (S Symbol) v
tab Ref (S Symbol)
sym v
v
S v
s <- (Symbol -> IO v) -> S Symbol -> IO (S v)
forall (m :: * -> *) (s :: * -> *) a b.
(Monad m, Sequent s) =>
(a -> m b) -> s a -> m (s b)
mmap Symbol -> IO v
gather (Ref (S Symbol) -> S Symbol
forall a. Ref a -> a
deref Ref (S Symbol)
sym)
v -> S v -> IO ()
define v
v S v
s
v -> IO v
forall (m :: * -> *) a. Monad m => a -> m a
return v
v
in (Symbol -> IO v) -> f Symbol -> IO (f v)
forall (m :: * -> *) (s :: * -> *) a b.
(Monad m, Sequent s) =>
(a -> m b) -> s a -> m (s b)
mmap Symbol -> IO v
gather f Symbol
symbols
netlistST :: Sequent f => ST s v -> (v -> S v -> ST s ()) -> f Symbol -> ST s (f v)
netlistST :: ST s v -> (v -> S v -> ST s ()) -> f Symbol -> ST s (f v)
netlistST new :: ST s v
new define :: v -> S v -> ST s ()
define symbols :: f Symbol
symbols =
do TableST s (S Symbol) v
tab <- ST s (TableST s (S Symbol) v)
forall s a b. ST s (TableST s a b)
tableST
let gather :: Symbol -> ST s v
gather (Symbol sym :: Ref (S Symbol)
sym) =
do Maybe v
visited <- TableST s (S Symbol) v -> Ref (S Symbol) -> ST s (Maybe v)
forall s a b. TableST s a b -> Ref a -> ST s (Maybe b)
findST TableST s (S Symbol) v
tab Ref (S Symbol)
sym
case Maybe v
visited of
Just v :: v
v -> do v -> ST s v
forall (m :: * -> *) a. Monad m => a -> m a
return v
v
Nothing -> do v
v <- ST s v
new
TableST s (S Symbol) v -> Ref (S Symbol) -> v -> ST s ()
forall s a b. TableST s a b -> Ref a -> b -> ST s ()
extendST TableST s (S Symbol) v
tab Ref (S Symbol)
sym v
v
S v
s <- (Symbol -> ST s v) -> S Symbol -> ST s (S v)
forall (m :: * -> *) (s :: * -> *) a b.
(Monad m, Sequent s) =>
(a -> m b) -> s a -> m (s b)
mmap Symbol -> ST s v
gather (Ref (S Symbol) -> S Symbol
forall a. Ref a -> a
deref Ref (S Symbol)
sym)
v -> S v -> ST s ()
define v
v S v
s
v -> ST s v
forall (m :: * -> *) a. Monad m => a -> m a
return v
v
in (Symbol -> ST s v) -> f Symbol -> ST s (f v)
forall (m :: * -> *) (s :: * -> *) a b.
(Monad m, Sequent s) =>
(a -> m b) -> s a -> m (s b)
mmap Symbol -> ST s v
gather f Symbol
symbols