From 6fabab8e6243062ab74860ca90bb4b08f564ceff Mon Sep 17 00:00:00 2001
From: Matthijs Kooijman <m.kooijman@student.utwente.nl>
Date: Fri, 13 Feb 2009 12:37:19 +0100
Subject: [PATCH] Extract entities from the session and return them in the
 design file.

---
 Translator.hs      |  6 +++++-
 TranslatorTypes.hs |  6 ++++++
 VHDL.hs            | 10 ++++++++++
 3 files changed, 21 insertions(+), 1 deletion(-)

diff --git a/Translator.hs b/Translator.hs
index 30a71c5..b7d3e0e 100644
--- a/Translator.hs
+++ b/Translator.hs
@@ -70,9 +70,13 @@ main =
       mapM processBind binds
       modFuncs nameFlatFunction
       modFuncs VHDL.createEntity
+      -- Extract the library units generated from all the functions in the
+      -- session.
+      funcs <- getFuncs
+      let units = concat $ map VHDL.getLibraryUnits funcs
       return $ AST.DesignFile 
         []
-        []
+        units
 
 findBind :: [CoreBind] -> String -> Maybe CoreBind
 findBind binds lookfor =
diff --git a/TranslatorTypes.hs b/TranslatorTypes.hs
index 75967c2..9978440 100644
--- a/TranslatorTypes.hs
+++ b/TranslatorTypes.hs
@@ -43,6 +43,12 @@ getFunc hsfunc = do
   fs <- State.gets funcs -- Get the funcs element from the session
   return $ Map.lookup hsfunc fs
 
+-- | Gets all functions from the current session
+getFuncs :: VHDLState [(HsFunction, FuncData)]
+getFuncs = do
+  fs <- State.gets funcs -- Get the funcs element from the session
+  return $ Map.toList fs
+
 -- | Sets the FlatFunction for the given HsFunction in the given setting.
 setFlatFunc :: HsFunction -> FlatFunction -> VHDLState ()
 setFlatFunc hsfunc flatfunc = do
diff --git a/VHDL.hs b/VHDL.hs
index 0387327..efa1409 100644
--- a/VHDL.hs
+++ b/VHDL.hs
@@ -71,6 +71,16 @@ mkEntityId hsfunc =
   -- TODO: This doesn't work for functions with multiple signatures!
   mkVHDLId $ hsFuncName hsfunc
 
+getLibraryUnits ::
+  (HsFunction, FuncData)      -- | A function from the session
+  -> [AST.LibraryUnit]        -- | The library units it generates
+
+getLibraryUnits (hsfunc, fdata) =
+  case entity fdata of 
+    Nothing -> []
+    Just ent -> case ent_decl ent of
+      Nothing -> []
+      Just decl -> [AST.LUEntity decl]
 
 -- | The VHDL Bit type
 bit_ty :: AST.TypeMark
-- 
2.30.2