Have reduceCoreListToHsList work with simplified modules

diff --git a/cλash/CLasH/Translator.hs b/cλash/CLasH/Translator.hs
index b61f5f942b8ba7b62eb0ea8200045b295899ef08..c120edc9badd448ee71837540c98d4e89adec115 100644 (file)
--- a/cλash/CLasH/Translator.hs
+++ b/cλash/CLasH/Translator.hs
@@ -103,7 +103,7 @@ moduleToVHDL env cores specs = do
     -- Create a testbench for any entry that has test input
     mkTest (_, _, Nothing) = return Nothing
     mkTest (top, _, Just input) = do
-      bndr <- createTestbench Nothing input top
+      bndr <- createTestbench Nothing cores input top
       return $ Just bndr
 
 -- Run the given translator session. Generates a new UniqSupply for that

diff --git a/cλash/CLasH/Utils/Core/CoreTools.hs b/cλash/CLasH/Utils/Core/CoreTools.hs
index 7377c9e36ce332e14c04f2a6cde234e47bf8eb95..e3021adc95e0807109748ad42acc6dacefe03bb6 100644 (file)
--- a/cλash/CLasH/Utils/Core/CoreTools.hs
+++ b/cλash/CLasH/Utils/Core/CoreTools.hs
@@ -36,6 +36,7 @@ import qualified CoreFVs
 import qualified Literal
 
 -- Local imports
+import CLasH.Translator.TranslatorTypes
 import CLasH.Utils.GhcTools
 import CLasH.Utils.HsTools
 import CLasH.Utils.Pretty
@@ -222,16 +223,36 @@ getLiterals app@(CoreSyn.App _ _) = literals
 
 getLiterals lit@(CoreSyn.Lit _) = [lit]
 
-reduceCoreListToHsList :: CoreSyn.CoreExpr -> [CoreSyn.CoreExpr]
-reduceCoreListToHsList app@(CoreSyn.App _ _) = out
+reduceCoreListToHsList :: 
+  [HscTypes.CoreModule] -- ^ The modules where parts of the list are hidden
+  -> CoreSyn.CoreExpr   -- ^ The refence to atleast one of the nodes
+  -> TranslatorSession [CoreSyn.CoreExpr]
+reduceCoreListToHsList cores app@(CoreSyn.App _ _) = do {
+  ; let { (fun, args) = CoreSyn.collectArgs app
+        ; len         = length args 
+        } ;
+  ; case len of
+      3 -> do {
+        ; let topelem = args!!1
+        ; case (args!!2) of
+            (varz@(CoreSyn.Var id)) -> do {
+              ; binds <- mapM (findExpr (isVarName id)) cores
+              ; otherelems <- reduceCoreListToHsList cores (head (Maybe.catMaybes binds))
+              ; return (topelem:otherelems)
+              }
+            (appz@(CoreSyn.App _ _)) -> do {
+              ; otherelems <- reduceCoreListToHsList cores appz
+              ; return (topelem:otherelems)
+              }
+            otherwise -> return [topelem]
+        }
+      otherwise -> return []
+  }
   where
-    (fun, args) = CoreSyn.collectArgs app
-    len = length args
-    out = case len of
-          3 -> ((args!!1) : (reduceCoreListToHsList (args!!2)))
-          otherwise -> []
+    isVarName :: Monad m => Var.Var -> Var.Var -> m Bool
+    isVarName lookfor bind = return $ (Var.varName lookfor) == (Var.varName bind)
 
-reduceCoreListToHsList _ = []
+reduceCoreListToHsList _ _ = return []
 
 -- | Is the given type a State type?
 isStateType :: Type.Type -> Bool

diff --git a/cλash/CLasH/VHDL/Testbench.hs b/cλash/CLasH/VHDL/Testbench.hs
index b7f281b7fec00c6f7599b427713cb444258cb69f..218ab524a926d62f6ce49faa78ce0adaad1c4cd8 100644 (file)
--- a/cλash/CLasH/VHDL/Testbench.hs
+++ b/cλash/CLasH/VHDL/Testbench.hs
@@ -14,6 +14,7 @@ import qualified Language.VHDL.AST as AST
 
 -- GHC API
 import CoreSyn
+import qualified HscTypes
 import qualified Var
 import qualified TysWiredIn
 
@@ -30,11 +31,12 @@ import CLasH.Utils
 
 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
+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