module HsVerilog.Simulation where
import qualified Data.Text as T
import Control.Monad.Trans.State
import Control.Monad.Trans.Reader
import Control.Monad.IO.Class
import Control.Monad
import qualified Data.Map as M
import HsVerilog.Type
val' :: Exp -> Reader Circuit Integer
val' (If a b c) = do
v <- val' a
if v /= 0 then val' b else val' c
val' (Mux a b c) = val' $ If a b c
val' (Not a) = do
v <- val' a
return $ if v == 0 then 1 else 0
val' (Or a b) = do
a' <- val' a
b' <- val' b
case (a',b') of
(0,0) -> return 0
(0,_) -> return 1
(_,0) -> return 1
(_,_) -> return 1
val' (BitOr a b) = do
a' <- val' a
b' <- val' b
case (a',b') of
(0,0) -> return 0
(0,_) -> return 1
(_,0) -> return 1
(_,_) -> return 1
val' (And a b) = do
a' <- val' a
b' <- val' b
case (a',b') of
(0,0) -> return 0
(0,_) -> return 0
(_,0) -> return 0
(_,_) -> return 1
val' (BitAnd a b) = do
a' <- val' a
b' <- val' b
case (a',b') of
(0,0) -> return 0
(0,_) -> return 0
(_,0) -> return 0
(_,_) -> return 1
val' (Add a b) = do
a' <- val' a
b' <- val' b
return $ a' + b'
val' (Sub a b) = do
a' <- val' a
b' <- val' b
return $ a' b'
val' (Mul a b) = do
a' <- val' a
b' <- val' b
return $ a' * b'
val' (Div a b) = do
a' <- val' a
b' <- val' b
return $ a' `div` b'
val' (Eq a b) = do
a' <- val' a
b' <- val' b
return $ if a' == b' then 1 else 0
val' (S a) = do
cir <- ask
return $ sval $ (sym cir (sname a))
val' (C a) = return $ a
val' (NonBlockAssign _ _) = error "do not eval this"
val' (BlockAssign _ _) = error "do not eval this"
sym' :: Circuit -> M.Map T.Text Signal
sym' cir = M.fromList $ map (\sig -> (sname sig,sig)) $ concat $ map (\f -> f cir) [cinput,(map alsig).creg,(map assig).cassign]
sym :: Circuit -> T.Text -> Signal
sym cir name = sym' cir M.! name
val :: Circuit -> Exp -> Integer
val cir exp' = flip runReader cir $ val' exp'
readReg :: Monad m => T.Text -> StateT Circuit m Integer
readReg name = do
cir <- get
let m = M.fromList $ map (\sig -> (sname sig,sig)) $ concat $ map (\f -> f cir) [(map alsig).creg]
return $ sval $ m M.! name
readInput :: Monad m => T.Text -> StateT Circuit m Integer
readInput name = do
cir <- get
let m = M.fromList $ map (\sig -> (sname sig,sig)) $ concat $ map (\f -> f cir) [cinput]
return $ sval $ m M.! name
readOutput :: Monad m => T.Text -> StateT Circuit m Integer
readOutput name = do
cir <- get
let m = M.fromList $ map (\sig -> (sname sig,sig)) $ concat $ map (\f -> f cir) [coutput]
return $ sval $ m M.! name
readAssign :: Monad m => T.Text -> StateT Circuit m Integer
readAssign name = do
cir <- get
let m = M.fromList $ map (\sig -> (sname sig,sig)) $ concat $ map (\f -> f cir) [(map assig).cassign]
return $ sval $ m M.! name
(<==) :: Monad m => T.Text -> Integer -> StateT Circuit m ()
(<==) name v = do
cir <- get
let inps = map (update v) $ cinput cir
put $ cir {cinput=inps}
where
update v' sig@(Signal name' _range _) | name' == name = sig{sval=v'}
| otherwise = sig
simM :: Monad m => Circuit -> StateT Circuit m a -> m Circuit
simM circuit act = do
(_,cir) <- flip runStateT circuit act
return cir
print' :: MonadIO m => StateT Circuit m ()
print' = do
cir <- get
liftIO $ print cir
updateReg :: Monad m => StateT Circuit m ()
updateReg = do
cir <- get
regs <- forM (creg cir) $ \r -> do
return $ r {alsig = (alsig r) {sval = val cir (alexp r)}}
put $ cir { creg = regs }