From 82e90697d7c570456f7bb0df8e4dc832ca242f74 Mon Sep 17 00:00:00 2001
From: Matthijs Kooijman <m.kooijman@student.utwente.nl>
Date: Thu, 19 Feb 2009 16:15:16 +0100
Subject: [PATCH] Write each VHDL entity to a seperate file.

---
 Translator.hs | 21 ++++++++++++++-------
 VHDL.hs       | 29 ++++++++++++++---------------
 2 files changed, 28 insertions(+), 22 deletions(-)

diff --git a/Translator.hs b/Translator.hs
index e375e45..d11d29e 100644
--- a/Translator.hs
+++ b/Translator.hs
@@ -51,7 +51,8 @@ makeVHDL filename name = do
   -- Translate to VHDL
   vhdl <- moduleToVHDL core [name]
   -- Write VHDL to file
-  writeVHDL vhdl "../vhdl/vhdl/output.vhdl"
+  mapM (writeVHDL "../vhdl/vhdl/") vhdl
+  return ()
 
 -- | Show the core structure of the given binds in the given file.
 listBind :: String -> String -> IO ()
@@ -65,14 +66,14 @@ listBind filename name = do
 
 -- | Translate the binds with the given names from the given core module to
 --   VHDL
-moduleToVHDL :: HscTypes.CoreModule -> [String] -> IO AST.DesignFile
+moduleToVHDL :: HscTypes.CoreModule -> [String] -> IO [AST.DesignFile]
 moduleToVHDL core names = do
   --liftIO $ putStr $ prettyShow (cm_binds core)
   let binds = findBinds core names
   --putStr $ prettyShow binds
   -- Turn bind into VHDL
   let (vhdl, sess) = State.runState (mkVHDL binds) (VHDLSession core 0 Map.empty)
-  putStr $ render $ ForSyDe.Backend.Ppr.ppr vhdl
+  mapM (putStr . render . ForSyDe.Backend.Ppr.ppr) vhdl
   putStr $ "\n\nFinal session:\n" ++ prettyShow sess ++ "\n\n"
   return vhdl
 
@@ -86,11 +87,17 @@ moduleToVHDL core names = do
       modFuncs nameFlatFunction
       modFuncs VHDL.createEntity
       modFuncs VHDL.createArchitecture
-      VHDL.getDesignFile
+      VHDL.getDesignFiles
 
--- | Write the given design file to the given file
-writeVHDL :: AST.DesignFile -> String -> IO ()
-writeVHDL = ForSyDe.Backend.VHDL.FileIO.writeDesignFile
+-- | Write the given design file to a file inside the given dir
+--   The first library unit in the designfile must be an entity, whose name
+--   will be used as a filename.
+writeVHDL :: String -> AST.DesignFile -> IO ()
+writeVHDL dir vhdl = do
+  let AST.DesignFile _ (u:us) = vhdl
+  let AST.LUEntity (AST.EntityDec id _) = u
+  let fname = dir ++ AST.fromVHDLId id ++ ".vhdl"
+  ForSyDe.Backend.VHDL.FileIO.writeDesignFile vhdl fname
 
 -- | Loads the given file and turns it into a core module.
 loadModule :: String -> IO HscTypes.CoreModule
diff --git a/VHDL.hs b/VHDL.hs
index 37bcd74..d2e9389 100644
--- a/VHDL.hs
+++ b/VHDL.hs
@@ -21,18 +21,16 @@ import FlattenTypes
 import TranslatorTypes
 import Pretty
 
-getDesignFile :: VHDLState AST.DesignFile
-getDesignFile = do
+getDesignFiles :: VHDLState [AST.DesignFile]
+getDesignFiles = do
   -- Extract the library units generated from all the functions in the
   -- session.
   funcs <- getFuncs
-  let units = concat $ map getLibraryUnits funcs
+  let units = Maybe.mapMaybe getLibraryUnits funcs
   let context = [
         AST.Library $ mkVHDLId "IEEE",
         AST.Use $ (AST.NSimple $ mkVHDLId "IEEE.std_logic_1164") AST.:.: AST.All]
-  return $ AST.DesignFile 
-    context
-    units
+  return $ map (\(ent, arch) -> AST.DesignFile context [ent, arch]) units
   
 -- | Create an entity for a given function
 createEntity ::
@@ -277,18 +275,19 @@ getEntityId fdata =
 
 getLibraryUnits ::
   (HsFunction, FuncData)      -- | A function from the session
-  -> [AST.LibraryUnit]        -- | The library units it generates
+  -> Maybe (AST.LibraryUnit, AST.LibraryUnit) -- | The entity and architecture for the function
 
 getLibraryUnits (hsfunc, fdata) =
   case funcEntity fdata of 
-    Nothing -> []
-    Just ent -> case ent_decl ent of
-      Nothing -> []
-      Just decl -> [AST.LUEntity decl]
-  ++
-  case funcArch fdata of
-    Nothing -> []
-    Just arch -> [AST.LUArch arch]
+    Nothing -> Nothing
+    Just ent -> 
+      case ent_decl ent of
+      Nothing -> Nothing
+      Just decl ->
+        case funcArch fdata of
+          Nothing -> Nothing
+          Just arch ->
+            Just (AST.LUEntity decl, AST.LUArch arch)
 
 -- | The VHDL Bit type
 bit_ty :: AST.TypeMark
-- 
2.30.2