Add support for translating designs defined over multiple modules

[matthijs/master-project/cλash.git] / cλash / CLasH / Translator.hs

diff --git a/cλash/CLasH/Translator.hs b/cλash/CLasH/Translator.hs
index 20dab4f7c77de618a2faebc2e97dc392ea17d02a..f60d225f8bed1ac4f80804bf0dfc5b66178ffa35 100644 (file)
--- a/cλash/CLasH/Translator.hs
+++ b/cλash/CLasH/Translator.hs
@@ -28,9 +28,11 @@ import qualified Language.VHDL.Ppr as Ppr
 import CLasH.Normalize
 import CLasH.Translator.TranslatorTypes
 import CLasH.Translator.Annotations
+import CLasH.Utils
 import CLasH.Utils.Core.CoreTools
 import CLasH.Utils.GhcTools
 import CLasH.VHDL
+import CLasH.VHDL.Testbench
 
 -- | Turn Haskell to VHDL, Usings Strings to indicate the Top Entity, Initial
 --   State and Test Inputs.
@@ -40,74 +42,72 @@ makeVHDLStrings ::
   -> String     -- ^ The TopEntity
   -> String     -- ^ The InitState
   -> String     -- ^ The TestInput
-  -> Bool       -- ^ Is it stateful? (in case InitState is empty)
   -> IO ()
-makeVHDLStrings libdir filenames topentity initstate testinput stateful = do
-  makeVHDL libdir filenames findTopEntity findInitState findTestInput stateful
+makeVHDLStrings libdir filenames topentity initstate testinput = do
+  makeVHDL libdir filenames finder
     where
-      findTopEntity = findBind (hasVarName topentity)
-      findInitState = findBind (hasVarName initstate)
-      findTestInput = findExpr (hasVarName testinput)
+      finder = findSpec (hasVarName topentity)
+                        (hasVarName initstate)
+                        (hasVarName testinput)
 
 -- | Turn Haskell to VHDL, Using the Annotations for Top Entity, Initial State
 --   and Test Inputs found in the Files. 
 makeVHDLAnnotations :: 
   FilePath      -- ^ The GHC Library Dir
   -> [FilePath] -- ^ The FileNames
-  -> Bool       -- ^ Is it stateful? (in case InitState is not specified)
   -> IO ()
-makeVHDLAnnotations libdir filenames stateful = do
-  makeVHDL libdir filenames findTopEntity findInitState findTestInput stateful
+makeVHDLAnnotations libdir filenames = do
+  makeVHDL libdir filenames finder
     where
-      findTopEntity = findBind (hasCLasHAnnotation isTopEntity)
-      findInitState = findBind (hasCLasHAnnotation isInitState)
-      findTestInput = findExpr (hasCLasHAnnotation isTestInput)
+      finder = findSpec (hasCLasHAnnotation isTopEntity)
+                        (hasCLasHAnnotation isInitState)
+                        (hasCLasHAnnotation isTestInput)
 
 -- | Turn Haskell to VHDL, using the given finder functions to find the Top
 --   Entity, Initial State and Test Inputs in the Haskell Files.
 makeVHDL ::
   FilePath      -- ^ The GHC Library Dir
   -> [FilePath] -- ^ The Filenames
-  -> (HscTypes.CoreModule -> GHC.Ghc (Maybe CoreSyn.CoreBndr)) -- ^ The Top Entity Finder
-  -> (HscTypes.CoreModule -> GHC.Ghc (Maybe CoreSyn.CoreBndr)) -- ^ The Init State Finder
-  -> (HscTypes.CoreModule -> GHC.Ghc (Maybe CoreSyn.CoreExpr)) -- ^ The Test Input Finder
-  -> Bool       -- ^ Indicates if it is meant to be stateful
+  -> Finder
   -> IO ()
-makeVHDL libdir filenames topEntFinder initStateFinder testInputFinder stateful = do
+makeVHDL libdir filenames finder = do
   -- Load the modules
-  (cores, top, init, test, env) <- loadModules libdir filenames topEntFinder initStateFinder testInputFinder
+  (cores, env, specs) <- loadModules libdir filenames (Just finder)
   -- Translate to VHDL
-  vhdl <- moduleToVHDL env cores top init test stateful
-  -- Write VHDL to file
-  let top_entity = Maybe.fromJust $ head top
+  vhdl <- moduleToVHDL env cores specs
+  -- Write VHDL to file. Just use the first entity for the name
+  let top_entity = head $ Maybe.catMaybes $ map (\(t, _, _) -> t) specs
   let dir = "./vhdl/" ++ (show top_entity) ++ "/"
   prepareDir dir
   mapM (writeVHDL dir) vhdl
   return ()
 
--- | Translate the binds with the given names from the given core module to
---   VHDL. The Bool in the tuple makes the function stateful (True) or
---   stateless (False).
+-- | Translate the specified entities in the given modules to VHDL.
 moduleToVHDL ::
   HscTypes.HscEnv             -- ^ The GHC Environment
   -> [HscTypes.CoreModule]    -- ^ The Core Modules
-  -> [Maybe CoreSyn.CoreBndr] -- ^ The TopEntity
-  -> [Maybe CoreSyn.CoreBndr] -- ^ The InitState
-  -> [Maybe CoreSyn.CoreExpr] -- ^ The TestInput
-  -> Bool                     -- ^ Is it stateful (in case InitState is not specified)
+  -> [EntitySpec]             -- ^ The entities to generate
   -> IO [(AST.VHDLId, AST.DesignFile)]
-moduleToVHDL env cores topbinds' init test stateful = do
-  let topbinds = Maybe.catMaybes topbinds'
-  let initialState = Maybe.catMaybes init
-  let testInput = Maybe.catMaybes test
+moduleToVHDL env cores specs = do
   vhdl <- runTranslatorSession env $ do
     let all_bindings = concat (map (\x -> CoreSyn.flattenBinds (HscTypes.cm_binds x)) cores)
     -- Store the bindings we loaded
     tsBindings %= Map.fromList all_bindings 
-    --let testexprs = case testInput of [] -> [] ; [x] -> reduceCoreListToHsList x
-    createDesignFiles topbinds 
+    test_binds <- catMaybesM $ Monad.mapM mkTest specs
+    let topbinds = Maybe.catMaybes $ map (\(top, _, _) -> top) specs
+    case topbinds of
+      []  -> error $ "Could not find top entity requested"
+      tops -> createDesignFiles (tops ++ test_binds)
   mapM (putStr . render . Ppr.ppr . snd) vhdl
   return vhdl
+  where
+    mkTest :: EntitySpec -> TranslatorSession (Maybe CoreSyn.CoreBndr)
+    -- Create a testbench for any entry that has test input
+    mkTest (_, _, Nothing) = return Nothing
+    mkTest (Nothing, _, _) = return Nothing
+    mkTest (Just top, _, Just input) = do
+      bndr <- createTestbench Nothing cores input top
+      return $ Just bndr
 
 -- Run the given translator session. Generates a new UniqSupply for that
 -- session.