cλash/CLasH/VHDL/Testbench.hs

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