module Lava.Loop
( hasLoopDB
, hasLoop
, hasCombLoop
) where
import Control.Monad.State
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Hardware.Internal
import Lava.Model
data Status
= NotVisited
| Visiting
| Done
type Visit = State (Map CellId Status)
cellStatus :: CellId -> Visit Status
cellStatus cid = do
statMap <- get
case Map.lookup cid statMap of
Nothing -> return NotVisited
Just stat -> return stat
setCellStatus :: CellId -> Status -> Visit ()
setCellStatus i stat = modify (Map.insert i stat)
setVisiting :: CellId -> Visit ()
setVisiting i = setCellStatus i Visiting
setDone :: CellId -> Visit ()
setDone i = setCellStatus i Done
isVisited :: CellId -> Visit Bool
isVisited i = do
st <- cellStatus i
return $ case st of
NotVisited -> False
_ -> True
anyM :: Monad m => (a -> m Bool) -> [a] -> m Bool
anyM f [] = return False
anyM f (a:as) = do
b <- f a
if b then return True
else anyM f as
hasLoopDB :: CellLibrary lib => Bool -> DesignDB lib -> Bool
hasLoopDB comb db =
fst $ runState (anyM loop (Map.toList $ cellDB db)) Map.empty
where
loop (cid,(ct,ins))
| comb && isFlop ct = setDone cid >> return False
loop (cid,(ct,ins)) = do
stat <- cellStatus cid
case stat of
Done -> return False
Visiting -> return True
_ -> do
setVisiting cid
l <- anyM loop [(c, cellDB db Map.! c) | CellSig c _ <- ins]
setDone cid
return l
hasLoop :: MonadLava lib m => m a -> Bool
hasLoop = hasLoopDB False . snd . runLava . toLava
hasCombLoop :: MonadLava lib m => m a -> Bool
hasCombLoop = hasLoopDB True . snd . runLava . toLava