1 -- Functions to create a VHDL testbench from a list of test input.
3 module CLasH.VHDL.Testbench where
6 import qualified Control.Monad as Monad
8 import qualified Data.Map as Map
10 import qualified Data.Accessor.MonadState as MonadState
13 import qualified Language.VHDL.AST as AST
17 import qualified HscTypes
19 import qualified TysWiredIn
22 import CLasH.Translator.TranslatorTypes
23 import CLasH.VHDL.Constants
24 import CLasH.VHDL.Generate
25 import CLasH.VHDL.VHDLTools
26 import CLasH.VHDL.VHDLTypes
27 import CLasH.Normalize
28 import CLasH.Utils.Core.BinderTools
29 import CLasH.Utils.Core.CoreTools
33 Maybe Int -- ^ Number of cycles to simulate
34 -> [HscTypes.CoreModule] -- ^ Compiled modules
35 -> CoreSyn.CoreExpr -- ^ Input stimuli
36 -> CoreSyn.CoreBndr -- ^ Top Entity
37 -> TranslatorSession CoreBndr -- ^ The id of the generated archictecture
38 createTestbench mCycles cores stimuli top = do
39 stimuli' <- reduceCoreListToHsList cores stimuli
40 -- Create a binder for the testbench. We use the unit type (), since the
41 -- testbench has no outputs and no inputs.
42 bndr <- mkInternalVar "testbench" TysWiredIn.unitTy
43 let entity = createTestbenchEntity bndr
44 modA tsEntities (Map.insert bndr entity)
45 arch <- createTestbenchArch mCycles stimuli' top entity
46 modA tsArchitectures (Map.insert bndr arch)
49 createTestbenchEntity ::
52 createTestbenchEntity bndr = entity
54 vhdl_id = mkVHDLBasicId $ varToString bndr
55 -- Create an AST entity declaration with no ports
56 ent_decl = AST.EntityDec vhdl_id []
57 -- Create a signature with no input and no output ports
58 entity = Entity vhdl_id [] undefined ent_decl
60 createTestbenchArch ::
61 Maybe Int -- ^ Number of cycles to simulate
62 -> [CoreSyn.CoreExpr] -- ^ Imput stimuli
63 -> CoreSyn.CoreBndr -- ^ Top Entity
64 -> Entity -- ^ The signature to create an architecture for
65 -> TranslatorSession (Architecture, [CoreSyn.CoreBndr])
66 -- ^ The architecture and any other entities used.
67 createTestbenchArch mCycles stimuli top testent= do
68 signature <- getEntity top
69 let entId = ent_id signature
70 iIface = ent_args signature
71 oIface = ent_res signature
73 let (oId, oDec, oProc) = case oIface of
75 , [AST.SigDec id ty Nothing]
76 , [createOutputProc [id]])
77 -- No output port? Just use undefined for the output id, since it won't be
78 -- used by mkAssocElems when there is no output port.
79 Nothing -> (undefined, [], [])
80 let iDecs = map (\(vId, tm) -> AST.SigDec vId tm Nothing) iIface
81 let finalIDecs = iDecs ++
82 [AST.SigDec clockId std_logicTM (Just $ AST.PrimLit "'0'"),
83 AST.SigDec resetId std_logicTM (Just $ AST.PrimLit "'0'")]
84 portmaps <- mkAssocElems (map idToVHDLExpr iIds) (AST.NSimple oId) signature
85 let mIns = mkComponentInst "totest" entId portmaps
86 (stimuliAssigns, stimuliDecs, cycles, used) <- createStimuliAssigns mCycles stimuli (head iIds)
87 let finalAssigns = (AST.CSSASm (AST.NSimple resetId AST.:<==:
89 (AST.Wform [AST.WformElem (AST.PrimLit "'1'") (Just $ AST.PrimLit "3 ns")])
90 Nothing)) : stimuliAssigns
91 let clkProc = createClkProc
92 let arch = AST.ArchBody
93 (AST.unsafeVHDLBasicId "test")
94 (AST.NSimple $ ent_id testent)
95 (map AST.BDISD (finalIDecs ++ stimuliDecs ++ oDec))
97 ( (AST.CSPSm clkProc) : (fmap AST.CSPSm oProc) ++ finalAssigns ) )
98 return (arch, top : used)
100 createStimuliAssigns ::
101 Maybe Int -- ^ Number of cycles to simulate
102 -> [CoreSyn.CoreExpr] -- ^ Input stimuli
103 -> AST.VHDLId -- ^ Input signal
104 -> TranslatorSession ( [AST.ConcSm]
107 , [CoreSyn.CoreBndr]) -- ^ (Resulting statements, Needed signals, The number of cycles to simulate, Any entities used)
108 createStimuliAssigns mCycles [] _ = return ([], [], Maybe.maybe 0 id mCycles, [])
110 createStimuliAssigns mCycles stimuli signal = do
111 let genWformElem time stim = (AST.WformElem stim (Just $ AST.PrimLit (show time ++ " ns")))
112 let inputlen = length stimuli
113 assigns <- Monad.zipWithM createStimulans stimuli [0..inputlen]
114 let (stimuli_sms, resvars, useds) = unzip3 assigns
115 sig_dec_maybes <- mapM mkSigDec resvars
116 let sig_decs = Maybe.catMaybes sig_dec_maybes
117 outps <- mapM (\x -> MonadState.lift tsType (varToVHDLExpr x)) resvars
118 let wformelems = zipWith genWformElem [0,10..] outps
119 let inassign = AST.CSSASm $ AST.NSimple signal AST.:<==: AST.ConWforms [] (AST.Wform wformelems) Nothing
120 return (stimuli_sms ++ [inassign], sig_decs, inputlen, concat useds)
123 CoreSyn.CoreExpr -- ^ The stimulans
124 -> Int -- ^ The cycle for this stimulans
125 -> TranslatorSession ( AST.ConcSm
127 , [CoreSyn.CoreBndr]) -- ^ (The statement, the variable it assigns to (assumed to be available!), Any entities used by this stimulans)
129 createStimulans expr cycl = do
130 -- There must be a let at top level
131 (CoreSyn.Let (CoreSyn.Rec binds) (Var res)) <- normalizeExpr ("test input #" ++ show cycl) expr
132 (stimulansbindss, useds) <- unzipM $ Monad.mapM mkConcSm binds
133 sig_dec_maybes <- mapM (mkSigDec . fst) (filter ((/=res).fst) binds)
134 let sig_decs = map (AST.BDISD) (Maybe.catMaybes $ sig_dec_maybes)
135 let block_label = mkVHDLExtId ("testcycle_" ++ (show cycl))
136 let block = AST.BlockSm block_label [] (AST.PMapAspect []) sig_decs (concat stimulansbindss)
137 return (AST.CSBSm block, res, concat useds)
139 -- | generates a clock process with a period of 10ns
140 createClkProc :: AST.ProcSm
141 createClkProc = AST.ProcSm (AST.unsafeVHDLBasicId "clkproc") [] sms
142 where sms = -- wait for 5 ns -- (half a cycle)
143 [AST.WaitFor $ AST.PrimLit "5 ns",
145 AST.NSimple clockId `AST.SigAssign`
146 AST.Wform [AST.WformElem (AST.Not (AST.PrimName $ AST.NSimple clockId)) Nothing]]
148 -- | generate the output process
149 createOutputProc :: [AST.VHDLId] -- ^ output signal
151 createOutputProc outs =
152 AST.ProcSm (AST.unsafeVHDLBasicId "writeoutput")
154 [AST.IfSm clkPred (writeOuts outs) [] Nothing]
155 where clkPred = AST.PrimName (AST.NAttribute $ AST.AttribName (AST.NSimple clockId)
156 (AST.NSimple $ eventId)
158 (AST.PrimName (AST.NSimple clockId) AST.:=: AST.PrimLit "'1'")
159 writeOuts :: [AST.VHDLId] -> [AST.SeqSm]
161 writeOuts [i] = [writeOut i (AST.PrimLit "LF")]
162 writeOuts (i:is) = writeOut i (AST.PrimLit "HT") : writeOuts is
163 writeOut outSig suffix =
164 genExprPCall2 writeId
165 (AST.PrimName $ AST.NSimple outputId)
166 ((genExprFCall showId (AST.PrimName $ AST.NSimple outSig)) AST.:&: suffix)