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