--- /dev/null
+--
+-- Functions to create a VHDL testbench from a list of test input.
+--
+module CLasH.VHDL.Testbench where
+
+-- Standard modules
+import qualified Control.Monad as Monad
+import qualified Maybe
+import qualified Data.Map as Map
+import qualified Data.Accessor.Monad.Trans.State as MonadState
+
+-- VHDL Imports
+import qualified Language.VHDL.AST as AST
+
+-- GHC API
+import qualified CoreSyn
+import qualified HscTypes
+import qualified Var
+import qualified TysWiredIn
+
+-- Local imports
+import CLasH.Translator.TranslatorTypes
+import CLasH.VHDL.Constants
+import CLasH.VHDL.Generate
+import CLasH.VHDL.VHDLTools
+import CLasH.VHDL.VHDLTypes
+import CLasH.Normalize
+import CLasH.Utils.Core.BinderTools
+import CLasH.Utils.Core.CoreTools
+import CLasH.Utils
+
+createTestbench ::
+ Maybe Int -- ^ Number of cycles to simulate
+ -> [HscTypes.CoreModule] -- ^ Compiled modules
+ -> CoreSyn.CoreExpr -- ^ Input stimuli
+ -> CoreSyn.CoreBndr -- ^ Top Entity
+ -> 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
+ MonadState.modify tsEntities (Map.insert bndr entity)
+ arch <- createTestbenchArch mCycles stimuli' top entity
+ MonadState.modify tsArchitectures (Map.insert bndr arch)
+ return bndr
+
+createTestbenchEntity ::
+ CoreSyn.CoreBndr
+ -> Entity
+createTestbenchEntity bndr = entity
+ where
+ vhdl_id = mkVHDLBasicId "testbench"
+ -- Create an AST entity declaration with no ports
+ ent_decl = AST.EntityDec vhdl_id []
+ -- Create a signature with no input and no output ports
+ entity = Entity vhdl_id [] undefined ent_decl
+
+createTestbenchArch ::
+ Maybe Int -- ^ Number of cycles to simulate
+ -> [CoreSyn.CoreExpr] -- ^ Imput stimuli
+ -> CoreSyn.CoreBndr -- ^ Top Entity
+ -> Entity -- ^ The signature to create an architecture for
+ -> TranslatorSession (Architecture, [CoreSyn.CoreBndr])
+ -- ^ The architecture and any other entities used.
+createTestbenchArch mCycles stimuli top testent= do
+ signature <- getEntity top
+ let entId = ent_id signature
+ iIface = ent_args signature
+ oIface = ent_res signature
+ iIds = map fst iIface
+ let (oId, oDec, oProc) = case oIface of
+ Just (id, ty) -> ( id
+ , [AST.SigDec id ty Nothing]
+ , [createOutputProc [id]])
+ -- No output port? Just use undefined for the output id, since it won't be
+ -- used by mkAssocElems when there is no output port.
+ Nothing -> (undefined, [], [])
+ let iDecs = map (\(vId, tm) -> AST.SigDec vId tm Nothing) iIface
+ let finalIDecs = iDecs ++
+ [AST.SigDec clockId std_logicTM (Just $ AST.PrimLit "'0'"),
+ AST.SigDec resetId std_logicTM (Just $ AST.PrimLit "'0'")]
+ let portmaps = mkAssocElems (map idToVHDLExpr iIds) (AST.NSimple oId) signature
+ let mIns = mkComponentInst "totest" entId portmaps
+ (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 "'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
+ (AST.unsafeVHDLBasicId "test")
+ (AST.NSimple $ ent_id testent)
+ (map AST.BDISD (finalIDecs ++ stimuliDecs ++ oDec))
+ (mIns :
+ ( (AST.CSPSm clkProc) : (fmap AST.CSPSm oProc) ++ finalAssigns ) )
+ return (arch, top : used)
+
+createStimuliAssigns ::
+ Maybe Int -- ^ Number of cycles to simulate
+ -> [CoreSyn.CoreExpr] -- ^ Input stimuli
+ -> AST.VHDLId -- ^ Input signal
+ -> TranslatorSession ( [AST.ConcSm]
+ , [AST.SigDec]
+ , Int
+ , [CoreSyn.CoreBndr]) -- ^ (Resulting statements, Needed signals, The number of cycles to simulate, Any entities used)
+createStimuliAssigns mCycles [] _ = return ([], [], Maybe.maybe 0 id mCycles, [])
+
+createStimuliAssigns mCycles stimuli signal = do
+ let genWformElem time stim = (AST.WformElem stim (Just $ AST.PrimLit (show time ++ " ns")))
+ let inputlen = length stimuli
+ assigns <- Monad.zipWithM createStimulans stimuli [0..inputlen]
+ let (stimuli_sms, resvars, useds) = unzip3 assigns
+ sig_dec_maybes <- mapM mkSigDec resvars
+ let sig_decs = Maybe.catMaybes sig_dec_maybes
+ 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
+ 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]
+ , Var.Var
+ , [CoreSyn.CoreBndr]) -- ^ (The statement, the variable it assigns to (assumed to be available!), Any entities used by this stimulans)
+
+createStimulans expr cycl = do
+ -- There must be a let at top level
+ expr <- normalizeExpr ("test input #" ++ show cycl) expr
+ -- Split the normalized expression. It can't have a function type, so match
+ -- an empty list of argument binders
+ 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 block_label = mkVHDLExtId ("testcycle_" ++ (show cycl))
+ 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
+createClkProc = AST.ProcSm (AST.unsafeVHDLBasicId "clkproc") [] sms
+ where sms = -- wait for 5 ns -- (half a cycle)
+ [AST.WaitFor $ AST.PrimLit "5 ns",
+ -- clk <= not clk;
+ AST.NSimple clockId `AST.SigAssign`
+ AST.Wform [AST.WformElem (AST.Not (AST.PrimName $ AST.NSimple clockId)) Nothing]]
+
+-- | generate the output process
+createOutputProc :: [AST.VHDLId] -- ^ output signal
+ -> AST.ProcSm
+createOutputProc outs =
+ AST.ProcSm (AST.unsafeVHDLBasicId "writeoutput")
+ [clockId]
+ [AST.IfSm clkPred (writeOuts outs) [] Nothing]
+ where clkPred = AST.PrimName (AST.NAttribute $ AST.AttribName (AST.NSimple clockId)
+ (AST.NSimple eventId)
+ Nothing ) `AST.And`
+ (AST.PrimName (AST.NSimple clockId) AST.:=: AST.PrimLit "'1'")
+ writeOuts :: [AST.VHDLId] -> [AST.SeqSm]
+ writeOuts [] = []
+ writeOuts [i] = [writeOut i (AST.PrimLit "LF")]
+ writeOuts (i:is) = writeOut i (AST.PrimLit "HT") : writeOuts is
+ writeOut outSig suffix =
+ genExprPCall2 writeId
+ (AST.PrimName $ AST.NSimple outputId)
+ ((genExprFCall showId (AST.PrimName $ AST.NSimple outSig)) AST.:&: suffix)