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
  -- Checks lazily if the predicate holds for any element.



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