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