import qualified Control.Monad as Monad
import qualified Maybe
import qualified Data.Map as Map
-import Data.Accessor
-import qualified Data.Accessor.MonadState as MonadState
+import qualified Data.Accessor.Monad.Trans.State as MonadState
--- ForSyDe
+-- VHDL Imports
import qualified Language.VHDL.AST as AST
-- GHC API
-import CoreSyn
+import qualified CoreSyn
import qualified HscTypes
import qualified Var
import qualified TysWiredIn
-> [HscTypes.CoreModule] -- ^ Compiled modules
-> CoreSyn.CoreExpr -- ^ Input stimuli
-> CoreSyn.CoreBndr -- ^ Top Entity
- -> TranslatorSession CoreBndr -- ^ The id of the generated archictecture
+ -> TranslatorSession CoreSyn.CoreBndr -- ^ The id of the generated archictecture
createTestbench mCycles cores stimuli top = do
stimuli' <- reduceCoreListToHsList cores stimuli
-- Create a binder for the testbench. We use the unit type (), since the
-- testbench has no outputs and no inputs.
bndr <- mkInternalVar "testbench" TysWiredIn.unitTy
let entity = createTestbenchEntity bndr
- modA tsEntities (Map.insert bndr entity)
+ MonadState.modify tsEntities (Map.insert bndr entity)
arch <- createTestbenchArch mCycles stimuli' top entity
- modA tsArchitectures (Map.insert bndr arch)
+ MonadState.modify tsArchitectures (Map.insert bndr arch)
return bndr
createTestbenchEntity ::
(stimuliAssigns, stimuliDecs, cycles, used) <- createStimuliAssigns mCycles stimuli (head iIds)
let finalAssigns = (AST.CSSASm (AST.NSimple resetId AST.:<==:
AST.ConWforms []
- (AST.Wform [AST.WformElem (AST.PrimLit "'1'") (Just $ AST.PrimLit "3 ns")])
+ (AST.Wform [AST.WformElem (AST.PrimLit "'0'") (Just $ AST.PrimLit "0 ns"), AST.WformElem (AST.PrimLit "'1'") (Just $ AST.PrimLit "3 ns")])
Nothing)) : stimuliAssigns
let clkProc = createClkProc
let arch = AST.ArchBody
outps <- mapM (\x -> MonadState.lift tsType (varToVHDLExpr x)) resvars
let wformelems = zipWith genWformElem [0,10..] outps
let inassign = AST.CSSASm $ AST.NSimple signal AST.:<==: AST.ConWforms [] (AST.Wform wformelems) Nothing
- return (stimuli_sms ++ [inassign], sig_decs, inputlen, concat useds)
+ case (concat stimuli_sms) of
+ [] -> return ([inassign], [], inputlen, concat useds)
+ stims -> return (stims ++ [inassign], sig_decs, inputlen, concat useds)
createStimulans ::
CoreSyn.CoreExpr -- ^ The stimulans
-> Int -- ^ The cycle for this stimulans
- -> TranslatorSession ( AST.ConcSm
+ -> TranslatorSession ( [AST.ConcSm]
, Var.Var
, [CoreSyn.CoreBndr]) -- ^ (The statement, the variable it assigns to (assumed to be available!), Any entities used by this stimulans)
let ([], binds, res) = splitNormalized expr
(stimulansbindss, useds) <- unzipM $ Monad.mapM mkConcSm binds
sig_dec_maybes <- mapM (mkSigDec . fst) (filter ((/=res).fst) binds)
- let sig_decs = map (AST.BDISD) (Maybe.catMaybes $ sig_dec_maybes)
+ let sig_decs = map (AST.BDISD) (Maybe.catMaybes sig_dec_maybes)
let block_label = mkVHDLExtId ("testcycle_" ++ (show cycl))
- let block = AST.BlockSm block_label [] (AST.PMapAspect []) sig_decs (concat stimulansbindss)
- return (AST.CSBSm block, res, concat useds)
+ let block = AST.BlockSm block_label [] (AST.PMapAspect []) sig_decs (concat stimulansbindss)
+ case (sig_decs,(concat stimulansbindss)) of
+ ([],[]) -> return ([], res, concat useds)
+ otherwise -> return ([AST.CSBSm block], res, concat useds)
-- | generates a clock process with a period of 10ns
createClkProc :: AST.ProcSm
[clockId]
[AST.IfSm clkPred (writeOuts outs) [] Nothing]
where clkPred = AST.PrimName (AST.NAttribute $ AST.AttribName (AST.NSimple clockId)
- (AST.NSimple $ eventId)
+ (AST.NSimple eventId)
Nothing ) `AST.And`
(AST.PrimName (AST.NSimple clockId) AST.:=: AST.PrimLit "'1'")
writeOuts :: [AST.VHDLId] -> [AST.SeqSm]