+++ /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)
projects / matthijs / master-project / cλash.git / blobdiff