ClashSimulator.hs

import qualified CLaSH.Prelude as C

import Control.Monad.Trans.State.Lazy
import Control.Monad.Reader
import Control.Monad.Fix

import Prelude
import System.IO.Unsafe
import Control.Monad.IO.Class


-- Simulator IO

-- evaluates in pure world
signalEvalPure :: (MonadFix m) =>  (b -> m a) -> b ->  ([a] -> [b]) -> m [b]
signalEvalPure mf def f = mfix ff
      where
        ff bx = fmap f $ traverse mf $ def : bx


signalEvalUnsafe
  :: MonadFix m 
     => ((IO c -> IO c) -> m [a] -> m [a]) -- map transformer
     -> (b -> m a)                         -- action 
     -> b                                  -- inital input
     -> ([a] -> [b])                       -- core to simulate
     -> m [b]                              -- return value
signalEvalUnsafe mapT mf def f = (mfix ff) 
    where
      ff xs = f <$> v (def:xs) 
      v (b:bs) = do
              r <- (mf b)
              rx <- ms (v bs) 
              return $ r:rx
      ms = mapT unsafeInterleaveIO

signalEvalState :: s                       -- init user state
                   -> (b -> StateT s IO a) -- action takes previous output as argument 
                   -> b                    -- first output
                   -> ([a] -> [b])         -- circutry to simulate
                   -> IO ([b], s)          -- history of outputs and final state
signalEvalState s0 mf def f = runStateT (signalEvalUnsafe mapStateT mf def f ) s0 


--- Example usage:
data MyState = MyState {line :: Integer } 

mySimulator :: Integer -> StateT MyState IO Integer
mySimulator n = do
    MyState ln <- get
    put $ MyState $ ln + 1  
    liftIO $ putStrLn $ "output at clock num: "++ show ln ++ " is\n" ++ show n
    liftIO $ putStrLn $ "enter next input: "
    v <- liftIO $ read <$> getLine
    return v

myIntegratorCircuit = C.simulate $ C.mealy f 0 where
         f s i = (r,r) where r = s + i

main = signalEvalState (MyState 0) mySimulator 0 myIntegratorCircuit >>= (print . length . fst)