From: Matthijs Kooijman <m.kooijman@student.utwente.nl>
Date: Thu, 5 Mar 2009 12:09:01 +0000 (+0100)
Subject: Remove getDesignFiles from the VHDLState monad.
X-Git-Url: https://git.stderr.nl/gitweb?a=commitdiff_plain;ds=sidebyside;h=bf0b6fedf46d525cc7e4d389b4fb7dd539174939;p=matthijs%2Fmaster-project%2Fc%CE%BBash.git

Remove getDesignFiles from the VHDLState monad.

This also does some related cleanup.
---

diff --git a/Translator.hs b/Translator.hs
index 383c477..5e36b38 100644
--- a/Translator.hs
+++ b/Translator.hs
@@ -94,7 +94,8 @@ moduleToVHDL core list = do
       modFuncs nameFlatFunction
       modFuncs VHDL.createEntity
       modFuncs VHDL.createArchitecture
-      VHDL.getDesignFiles
+      funcs <- getFuncs
+      return $ VHDL.getDesignFiles (map snd funcs)
 
 -- | 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
diff --git a/VHDL.hs b/VHDL.hs
index 338aa1d..d9dce9e 100644
--- a/VHDL.hs
+++ b/VHDL.hs
@@ -25,16 +25,14 @@ import FlattenTypes
 import TranslatorTypes
 import Pretty
 
-getDesignFiles :: VHDLState [AST.DesignFile]
-getDesignFiles = do
-  -- Extract the library units generated from all the functions in the
-  -- session.
-  funcs <- getFuncs
-  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 $ map (AST.DesignFile context) units
+getDesignFiles :: [FuncData] -> [AST.DesignFile]
+getDesignFiles funcs =
+  map (AST.DesignFile context) units
+  where
+    units = filter (not.null) $ map getLibraryUnits funcs
+    context = [
+      AST.Library $ mkVHDLId "IEEE",
+      AST.Use $ (AST.NSimple $ mkVHDLId "IEEE.std_logic_1164") AST.:.: AST.All]
   
 -- | Create an entity for a given function
 createEntity ::
@@ -306,20 +304,19 @@ getEntityId fdata =
       Just (AST.EntityDec id _) -> Just id
 
 getLibraryUnits ::
-  (HsFunction, FuncData)      -- | A function from the session
-  -> Maybe [AST.LibraryUnit]  -- | The entity, architecture and optional package for the function
+  FuncData                    -- | A function from the session
+  -> [AST.LibraryUnit]  -- | The entity, architecture and optional package for the function
 
-getLibraryUnits (hsfunc, fdata) =
+getLibraryUnits fdata =
   case funcEntity fdata of 
-    Nothing -> Nothing
+    Nothing -> []
     Just ent -> 
       case ent_decl ent of
-      Nothing -> Nothing
+      Nothing -> []
       Just decl ->
         case funcArch fdata of
-          Nothing -> Nothing
+          Nothing -> []
           Just arch ->
-            Just $
               [AST.LUEntity decl, AST.LUArch arch]
               ++ (Maybe.maybeToList (fmap AST.LUPackageDec $ ent_pkg_decl ent))