X-Git-Url: https://git.stderr.nl/gitweb?a=blobdiff_plain;f=c%CE%BBash%2FCLasH%2FVHDL%2FTestbench.hs;h=89988f5372327b0eb675ecbff08d525ea62a4c73;hb=a97a53c406ca4da95059a95a4f3d6452eb87b018;hp=4f20f6cf9c90470aa92b1dafd1167b56fb2eba5d;hpb=66ef5bd26b2c02cb12e702c60668294fd80ea8c2;p=matthijs%2Fmaster-project%2Fc%CE%BBash.git

diff --git "a/c\316\273ash/CLasH/VHDL/Testbench.hs" "b/c\316\273ash/CLasH/VHDL/Testbench.hs"
index 4f20f6c..89988f5 100644
--- "a/c\316\273ash/CLasH/VHDL/Testbench.hs"
+++ "b/c\316\273ash/CLasH/VHDL/Testbench.hs"
@@ -1,3 +1,4 @@
+-- 
 -- Functions to create a VHDL testbench from a list of test input.
 --
 module CLasH.VHDL.Testbench where
@@ -6,8 +7,7 @@ module CLasH.VHDL.Testbench where
 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
 import qualified Language.VHDL.AST as AST
@@ -41,9 +41,9 @@ createTestbench mCycles cores stimuli top = do
   -- testbench has no outputs and no inputs.
   bndr <- mkInternalVar "testbench" TysWiredIn.unitTy
   let entity = createTestbenchEntity bndr
-  modA tsEntities (Map.insert bndr entity)
+  MonadState.modify tsEntities (Map.insert bndr entity)
   arch <- createTestbenchArch mCycles stimuli' top entity
-  modA tsArchitectures (Map.insert bndr arch)
+  MonadState.modify tsArchitectures (Map.insert bndr arch)
   return bndr
 
 createTestbenchEntity :: 
@@ -51,7 +51,7 @@ 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
@@ -81,12 +81,12 @@ createTestbenchArch mCycles stimuli top testent= do
   let finalIDecs = iDecs ++
                     [AST.SigDec clockId std_logicTM (Just $ AST.PrimLit "'0'"),
                      AST.SigDec resetId std_logicTM (Just $ AST.PrimLit "'0'")]
-  portmaps <- mkAssocElems (map idToVHDLExpr iIds) (AST.NSimple oId) signature
+  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 arch = AST.ArchBody
@@ -117,24 +117,31 @@ 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
+  -> 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 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