import qualified Control.Monad as Monad
import qualified Maybe
import qualified Data.Map as Map
-import Data.Accessor
-import qualified Data.Accessor.MonadState as MonadState
+import qualified Data.Accessor.Monad.Trans.State as MonadState
--- ForSyDe
+-- VHDL Imports
import qualified Language.VHDL.AST as AST
-- GHC API
-import CoreSyn
+import qualified CoreSyn
+import qualified HscTypes
import qualified Var
import qualified TysWiredIn
createTestbench ::
Maybe Int -- ^ Number of cycles to simulate
+ -> [HscTypes.CoreModule] -- ^ Compiled modules
-> CoreSyn.CoreExpr -- ^ Input stimuli
-> CoreSyn.CoreBndr -- ^ Top Entity
- -> TranslatorSession CoreBndr -- ^ The id of the generated archictecture
-createTestbench mCycles stimuli top = do
- let stimuli' = reduceCoreListToHsList stimuli
+ -> TranslatorSession CoreSyn.CoreBndr -- ^ The id of the generated archictecture
+createTestbench mCycles cores stimuli top = do
+ stimuli' <- reduceCoreListToHsList cores stimuli
-- Create a binder for the testbench. We use the unit type (), since the
-- testbench has no outputs and no inputs.
bndr <- mkInternalVar "testbench" TysWiredIn.unitTy
let entity = createTestbenchEntity bndr
- modA tsEntities (Map.insert bndr entity)
- arch <- createTestbenchArch mCycles stimuli' top
- modA tsArchitectures (Map.insert bndr arch)
+ MonadState.modify tsEntities (Map.insert bndr entity)
+ arch <- createTestbenchArch mCycles stimuli' top entity
+ MonadState.modify tsArchitectures (Map.insert bndr arch)
return bndr
createTestbenchEntity ::
-> Entity
createTestbenchEntity bndr = entity
where
- vhdl_id = mkVHDLBasicId $ varToString bndr
+ vhdl_id = mkVHDLBasicId "testbench"
-- Create an AST entity declaration with no ports
ent_decl = AST.EntityDec vhdl_id []
-- Create a signature with no input and no output ports
Maybe Int -- ^ Number of cycles to simulate
-> [CoreSyn.CoreExpr] -- ^ Imput stimuli
-> CoreSyn.CoreBndr -- ^ Top Entity
+ -> Entity -- ^ The signature to create an architecture for
-> TranslatorSession (Architecture, [CoreSyn.CoreBndr])
-- ^ The architecture and any other entities used.
-createTestbenchArch mCycles stimuli top = do
+createTestbenchArch mCycles stimuli top testent= do
signature <- getEntity top
let entId = ent_id signature
iIface = ent_args signature
oIface = ent_res signature
iIds = map fst iIface
- oId = fst oIface
+ let (oId, oDec, oProc) = case oIface of
+ Just (id, ty) -> ( id
+ , [AST.SigDec id ty Nothing]
+ , [createOutputProc [id]])
+ -- No output port? Just use undefined for the output id, since it won't be
+ -- used by mkAssocElems when there is no output port.
+ Nothing -> (undefined, [], [])
let iDecs = map (\(vId, tm) -> AST.SigDec vId tm Nothing) iIface
let finalIDecs = iDecs ++
[AST.SigDec clockId std_logicTM (Just $ AST.PrimLit "'0'"),
AST.SigDec resetId std_logicTM (Just $ AST.PrimLit "'0'")]
- let oDecs = AST.SigDec (fst oIface) (snd oIface) Nothing
let portmaps = mkAssocElems (map idToVHDLExpr iIds) (AST.NSimple oId) signature
let mIns = mkComponentInst "totest" entId portmaps
(stimuliAssigns, stimuliDecs, cycles, used) <- createStimuliAssigns mCycles stimuli (head iIds)
let finalAssigns = (AST.CSSASm (AST.NSimple resetId AST.:<==:
AST.ConWforms []
- (AST.Wform [AST.WformElem (AST.PrimLit "'1'") (Just $ AST.PrimLit "3 ns")])
+ (AST.Wform [AST.WformElem (AST.PrimLit "'0'") (Just $ AST.PrimLit "0 ns"), AST.WformElem (AST.PrimLit "'1'") (Just $ AST.PrimLit "3 ns")])
Nothing)) : stimuliAssigns
let clkProc = createClkProc
- let outputProc = createOutputProc [oId]
let arch = AST.ArchBody
(AST.unsafeVHDLBasicId "test")
- (AST.NSimple $ AST.unsafeIdAppend entId "_tb")
- (map AST.BDISD (finalIDecs ++ stimuliDecs ++ [oDecs]))
+ (AST.NSimple $ ent_id testent)
+ (map AST.BDISD (finalIDecs ++ stimuliDecs ++ oDec))
(mIns :
- ( (AST.CSPSm clkProc) : (AST.CSPSm outputProc) : finalAssigns ) )
+ ( (AST.CSPSm clkProc) : (fmap AST.CSPSm oProc) ++ finalAssigns ) )
return (arch, top : used)
createStimuliAssigns ::
Maybe Int -- ^ Number of cycles to simulate
-> [CoreSyn.CoreExpr] -- ^ Input stimuli
-> AST.VHDLId -- ^ Input signal
- -> TranslatorSession ( [AST.ConcSm] -- ^ Resulting statemetns
- , [AST.SigDec] -- ^ Needed signals
- , Int -- ^ The number of cycles to simulate
- , [CoreSyn.CoreBndr]) -- ^ Any entities used
+ -> TranslatorSession ( [AST.ConcSm]
+ , [AST.SigDec]
+ , Int
+ , [CoreSyn.CoreBndr]) -- ^ (Resulting statements, Needed signals, The number of cycles to simulate, Any entities used)
createStimuliAssigns mCycles [] _ = return ([], [], Maybe.maybe 0 id mCycles, [])
createStimuliAssigns mCycles stimuli signal = do
outps <- mapM (\x -> MonadState.lift tsType (varToVHDLExpr x)) resvars
let wformelems = zipWith genWformElem [0,10..] outps
let inassign = AST.CSSASm $ AST.NSimple signal AST.:<==: AST.ConWforms [] (AST.Wform wformelems) Nothing
- return (stimuli_sms ++ [inassign], sig_decs, inputlen, concat useds)
+ case (concat stimuli_sms) of
+ [] -> return ([inassign], [], inputlen, concat useds)
+ stims -> return (stims ++ [inassign], sig_decs, inputlen, concat useds)
createStimulans ::
CoreSyn.CoreExpr -- ^ The stimulans
-> Int -- ^ The cycle for this stimulans
- -> TranslatorSession ( AST.ConcSm -- ^ The statement
- , Var.Var -- ^ the variable it assigns to (assumed to be available!)
- , [CoreSyn.CoreBndr]) -- ^ Any entities used by this stimulans
+ -> TranslatorSession ( [AST.ConcSm]
+ , Var.Var
+ , [CoreSyn.CoreBndr]) -- ^ (The statement, the variable it assigns to (assumed to be available!), Any entities used by this stimulans)
createStimulans expr cycl = do
-- There must be a let at top level
- (CoreSyn.Let (CoreSyn.Rec binds) (Var res)) <- normalizeExpr ("test input #" ++ show cycl) expr
+ expr <- normalizeExpr ("test input #" ++ show cycl) expr
+ -- Split the normalized expression. It can't have a function type, so match
+ -- an empty list of argument binders
+ let ([], binds, res) = splitNormalized expr
(stimulansbindss, useds) <- unzipM $ Monad.mapM mkConcSm binds
sig_dec_maybes <- mapM (mkSigDec . fst) (filter ((/=res).fst) binds)
- let sig_decs = map (AST.BDISD) (Maybe.catMaybes $ sig_dec_maybes)
+ let sig_decs = map (AST.BDISD) (Maybe.catMaybes sig_dec_maybes)
let block_label = mkVHDLExtId ("testcycle_" ++ (show cycl))
- let block = AST.BlockSm block_label [] (AST.PMapAspect []) sig_decs (concat stimulansbindss)
- return (AST.CSBSm block, res, concat useds)
+ let block = AST.BlockSm block_label [] (AST.PMapAspect []) sig_decs (concat stimulansbindss)
+ case (sig_decs,(concat stimulansbindss)) of
+ ([],[]) -> return ([], res, concat useds)
+ otherwise -> return ([AST.CSBSm block], res, concat useds)
-- | generates a clock process with a period of 10ns
createClkProc :: AST.ProcSm
[clockId]
[AST.IfSm clkPred (writeOuts outs) [] Nothing]
where clkPred = AST.PrimName (AST.NAttribute $ AST.AttribName (AST.NSimple clockId)
- (AST.NSimple $ eventId)
+ (AST.NSimple eventId)
Nothing ) `AST.And`
(AST.PrimName (AST.NSimple clockId) AST.:=: AST.PrimLit "'1'")
writeOuts :: [AST.VHDLId] -> [AST.SeqSm]
projects / matthijs / master-project / cλash.git / blobdiff