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 qualified Data.Accessor.Monad.Trans.State as MonadState
  11
  12 -- VHDL Imports
  13 import qualified Language.VHDL.AST as AST
  14
  15 -- GHC API
  16 import qualified 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 CoreSyn.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   MonadState.modify tsEntities (Map.insert bndr entity)
  45   arch <- createTestbenchArch mCycles stimuli' top entity
  46   MonadState.modify 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 "testbench"
  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   let (oId, oDec, oProc) = case oIface of
  74         Just (id, ty) -> ( id
  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   let 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.:<==:
  88                       AST.ConWforms []
  89                                     (AST.Wform [AST.WformElem (AST.PrimLit "'0'") (Just $ AST.PrimLit "0 ns"), 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))
  96               (mIns :
  97                 ( (AST.CSPSm clkProc) : (fmap AST.CSPSm oProc) ++ finalAssigns ) )
  98   return (arch, top : used)
  99
 100 createStimuliAssigns ::
 101   Maybe Int -- ^ Number of cycles to simulate
 102   -> [CoreSyn.CoreExpr] -- ^ Input stimuli
 103   -> AST.VHDLId -- ^ Input signal
 104   -> TranslatorSession ( [AST.ConcSm]
 105                        , [AST.SigDec]
 106                        , Int
 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, [])
 109
 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   case (concat stimuli_sms) of
 121     []        -> return ([inassign], [], inputlen, concat useds)
 122     stims     -> return (stims ++ [inassign], sig_decs, inputlen, concat useds)
 123
 124 createStimulans ::
 125   CoreSyn.CoreExpr -- ^ The stimulans
 126   -> Int -- ^ The cycle for this stimulans
 127   -> TranslatorSession ( [AST.ConcSm]
 128                        , Var.Var
 129                        , [CoreSyn.CoreBndr]) -- ^ (The statement, the variable it assigns to (assumed to be available!), Any entities used by this stimulans)
 130
 131 createStimulans expr cycl = do
 132   -- There must be a let at top level
 133   expr <- normalizeExpr ("test input #" ++ show cycl) expr
 134   -- Split the normalized expression. It can't have a function type, so match
 135   -- an empty list of argument binders
 136   let ([], binds, res) = splitNormalized expr
 137   (stimulansbindss, useds) <- unzipM $ Monad.mapM mkConcSm binds
 138   sig_dec_maybes <- mapM (mkSigDec . fst) (filter ((/=res).fst) binds)
 139   let sig_decs = map (AST.BDISD) (Maybe.catMaybes sig_dec_maybes)
 140   let block_label = mkVHDLExtId ("testcycle_" ++ (show cycl))
 141   let block = AST.BlockSm block_label [] (AST.PMapAspect []) sig_decs (concat stimulansbindss)
 142   case (sig_decs,(concat stimulansbindss)) of
 143     ([],[])   ->  return ([], res, concat useds)
 144     otherwise ->  return ([AST.CSBSm block], res, concat useds)
 145
 146 -- | generates a clock process with a period of 10ns
 147 createClkProc :: AST.ProcSm
 148 createClkProc = AST.ProcSm (AST.unsafeVHDLBasicId "clkproc") [] sms
 149  where sms = -- wait for 5 ns -- (half a cycle)
 150              [AST.WaitFor $ AST.PrimLit "5 ns",
 151               -- clk <= not clk;
 152               AST.NSimple clockId `AST.SigAssign`
 153                  AST.Wform [AST.WformElem (AST.Not (AST.PrimName $ AST.NSimple clockId)) Nothing]]
 154
 155 -- | generate the output process
 156 createOutputProc :: [AST.VHDLId] -- ^ output signal
 157               -> AST.ProcSm
 158 createOutputProc outs =
 159   AST.ProcSm (AST.unsafeVHDLBasicId "writeoutput")
 160          [clockId]
 161          [AST.IfSm clkPred (writeOuts outs) [] Nothing]
 162  where clkPred = AST.PrimName (AST.NAttribute $ AST.AttribName (AST.NSimple clockId)
 163                                                    (AST.NSimple eventId)
 164                                                    Nothing          ) `AST.And`
 165                  (AST.PrimName (AST.NSimple clockId) AST.:=: AST.PrimLit "'1'")
 166        writeOuts :: [AST.VHDLId] -> [AST.SeqSm]
 167        writeOuts []  = []
 168        writeOuts [i] = [writeOut i (AST.PrimLit "LF")]
 169        writeOuts (i:is) = writeOut i (AST.PrimLit "HT") : writeOuts is
 170        writeOut outSig suffix =
 171          genExprPCall2 writeId
 172                         (AST.PrimName $ AST.NSimple outputId)
 173                         ((genExprFCall showId (AST.PrimName $ AST.NSimple outSig)) AST.:&: suffix)