cλash/CLasH/VHDL/Testbench.hs

   1 --
   2 -- Functions to create a VHDL testbench from a list of test input.
   3 --
   4 module CLasH.VHDL.Testbench where
   5
   6 -- Standard modules
   7 import qualified Control.Monad as Monad
   8 import qualified Maybe
   9 import qualified Data.Map as Map
  10 import Data.Accessor
  11 import qualified Data.Accessor.MonadState as MonadState
  12
  13 -- ForSyDe
  14 import qualified Language.VHDL.AST as AST
  15
  16 -- GHC API
  17 import CoreSyn
  18 import qualified Var
  19 import qualified TysWiredIn
  20
  21 -- Local imports
  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
  30 import CLasH.Utils
  31
  32 createTestbench ::
  33   Maybe Int -- ^ Number of cycles to simulate
  34   -> CoreSyn.CoreExpr -- ^ Input stimuli
  35   -> CoreSyn.CoreBndr -- ^ Top Entity
  36   -> TranslatorSession CoreBndr -- ^ The id of the generated archictecture
  37 createTestbench mCycles stimuli top = do
  38   let stimuli' = reduceCoreListToHsList stimuli
  39   -- Create a binder for the testbench. We use the unit type (), since the
  40   -- testbench has no outputs and no inputs.
  41   bndr <- mkInternalVar "testbench" TysWiredIn.unitTy
  42   let entity = createTestbenchEntity bndr
  43   modA tsEntities (Map.insert bndr entity)
  44   arch <- createTestbenchArch mCycles stimuli' top entity
  45   modA tsArchitectures (Map.insert bndr arch)
  46   return bndr
  47
  48 createTestbenchEntity ::
  49   CoreSyn.CoreBndr
  50   -> Entity
  51 createTestbenchEntity bndr = entity
  52   where
  53     vhdl_id = mkVHDLBasicId $ varToString bndr
  54     -- Create an AST entity declaration with no ports
  55     ent_decl = AST.EntityDec vhdl_id []
  56     -- Create a signature with no input and no output ports
  57     entity = Entity vhdl_id [] undefined ent_decl
  58
  59 createTestbenchArch ::
  60   Maybe Int -- ^ Number of cycles to simulate
  61   -> [CoreSyn.CoreExpr] -- ^ Imput stimuli
  62   -> CoreSyn.CoreBndr -- ^ Top Entity
  63   -> Entity -- ^ The signature to create an architecture for
  64   -> TranslatorSession (Architecture, [CoreSyn.CoreBndr])
  65   -- ^ The architecture and any other entities used.
  66 createTestbenchArch mCycles stimuli top testent= do
  67   signature <- getEntity top
  68   let entId   = ent_id signature
  69       iIface  = ent_args signature
  70       oIface  = ent_res signature
  71       iIds    = map fst iIface
  72       oId     = fst oIface
  73   let iDecs   = map (\(vId, tm) -> AST.SigDec vId tm Nothing) iIface
  74   let finalIDecs = iDecs ++
  75                     [AST.SigDec clockId std_logicTM (Just $ AST.PrimLit "'0'"),
  76                      AST.SigDec resetId std_logicTM (Just $ AST.PrimLit "'0'")]
  77   let oDecs   = AST.SigDec (fst oIface) (snd oIface) Nothing
  78   let portmaps = mkAssocElems (map idToVHDLExpr iIds) (AST.NSimple oId) signature
  79   let mIns    = mkComponentInst "totest" entId portmaps
  80   (stimuliAssigns, stimuliDecs, cycles, used) <- createStimuliAssigns mCycles stimuli (head iIds)
  81   let finalAssigns = (AST.CSSASm (AST.NSimple resetId AST.:<==:
  82                       AST.ConWforms []
  83                                     (AST.Wform [AST.WformElem (AST.PrimLit "'1'") (Just $ AST.PrimLit "3 ns")])
  84                                     Nothing)) : stimuliAssigns
  85   let clkProc     = createClkProc
  86   let outputProc  = createOutputProc [oId]
  87   let arch = AST.ArchBody
  88               (AST.unsafeVHDLBasicId "test")
  89               (AST.NSimple $ ent_id testent)
  90               (map AST.BDISD (finalIDecs ++ stimuliDecs ++ [oDecs]))
  91               (mIns :
  92                 ( (AST.CSPSm clkProc) : (AST.CSPSm outputProc) : finalAssigns ) )
  93   return (arch, top : used)
  94
  95 createStimuliAssigns ::
  96   Maybe Int -- ^ Number of cycles to simulate
  97   -> [CoreSyn.CoreExpr] -- ^ Input stimuli
  98   -> AST.VHDLId -- ^ Input signal
  99   -> TranslatorSession ( [AST.ConcSm] -- ^ Resulting statemetns
 100                        , [AST.SigDec] -- ^ Needed signals
 101                        , Int -- ^ The number of cycles to simulate
 102                        , [CoreSyn.CoreBndr]) -- ^ Any entities used
 103 createStimuliAssigns mCycles [] _ = return ([], [], Maybe.maybe 0 id mCycles, [])
 104
 105 createStimuliAssigns mCycles stimuli signal = do
 106   let genWformElem time stim = (AST.WformElem stim (Just $ AST.PrimLit (show time ++ " ns")))
 107   let inputlen = length stimuli
 108   assigns <- Monad.zipWithM createStimulans stimuli [0..inputlen]
 109   let (stimuli_sms, resvars, useds) = unzip3 assigns
 110   sig_dec_maybes <- mapM mkSigDec resvars
 111   let sig_decs = Maybe.catMaybes sig_dec_maybes
 112   outps <- mapM (\x -> MonadState.lift tsType (varToVHDLExpr x)) resvars
 113   let wformelems = zipWith genWformElem [0,10..] outps
 114   let inassign = AST.CSSASm $ AST.NSimple signal AST.:<==: AST.ConWforms [] (AST.Wform wformelems) Nothing
 115   return (stimuli_sms ++ [inassign], sig_decs, inputlen, concat useds)
 116
 117 createStimulans ::
 118   CoreSyn.CoreExpr -- ^ The stimulans
 119   -> Int -- ^ The cycle for this stimulans
 120   -> TranslatorSession ( AST.ConcSm -- ^ The statement
 121                        , Var.Var -- ^ the variable it assigns to (assumed to be available!)
 122                        , [CoreSyn.CoreBndr]) -- ^ Any entities used by this stimulans
 123
 124 createStimulans expr cycl = do
 125   -- There must be a let at top level
 126   (CoreSyn.Let (CoreSyn.Rec binds) (Var res)) <- normalizeExpr ("test input #" ++ show cycl) expr
 127   (stimulansbindss, useds) <- unzipM $ Monad.mapM mkConcSm binds
 128   sig_dec_maybes <- mapM (mkSigDec . fst) (filter ((/=res).fst) binds)
 129   let sig_decs = map (AST.BDISD) (Maybe.catMaybes $ sig_dec_maybes)
 130   let block_label = mkVHDLExtId ("testcycle_" ++ (show cycl))
 131   let block = AST.BlockSm block_label [] (AST.PMapAspect []) sig_decs (concat stimulansbindss)
 132   return (AST.CSBSm block, res, concat useds)
 133
 134 -- | generates a clock process with a period of 10ns
 135 createClkProc :: AST.ProcSm
 136 createClkProc = AST.ProcSm (AST.unsafeVHDLBasicId "clkproc") [] sms
 137  where sms = -- wait for 5 ns -- (half a cycle)
 138              [AST.WaitFor $ AST.PrimLit "5 ns",
 139               -- clk <= not clk;
 140               AST.NSimple clockId `AST.SigAssign`
 141                  AST.Wform [AST.WformElem (AST.Not (AST.PrimName $ AST.NSimple clockId)) Nothing]]
 142
 143 -- | generate the output process
 144 createOutputProc :: [AST.VHDLId] -- ^ output signal
 145               -> AST.ProcSm
 146 createOutputProc outs =
 147   AST.ProcSm (AST.unsafeVHDLBasicId "writeoutput")
 148          [clockId]
 149          [AST.IfSm clkPred (writeOuts outs) [] Nothing]
 150  where clkPred = AST.PrimName (AST.NAttribute $ AST.AttribName (AST.NSimple clockId)
 151                                                    (AST.NSimple $ eventId)
 152                                                    Nothing          ) `AST.And`
 153                  (AST.PrimName (AST.NSimple clockId) AST.:=: AST.PrimLit "'1'")
 154        writeOuts :: [AST.VHDLId] -> [AST.SeqSm]
 155        writeOuts []  = []
 156        writeOuts [i] = [writeOut i (AST.PrimLit "LF")]
 157        writeOuts (i:is) = writeOut i (AST.PrimLit "HT") : writeOuts is
 158        writeOut outSig suffix =
 159          genExprPCall2 writeId
 160                         (AST.PrimName $ AST.NSimple outputId)
 161                         ((genExprFCall showId (AST.PrimName $ AST.NSimple outSig)) AST.:&: suffix)