Add a getFuncMap accessor for VHDLState.

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

diff --git a/VHDL.hs b/VHDL.hs
index 338aa1df889005824ca15bb3407c7517a11882c0..6f3705e421d6f0d55b16faef97054ac3f3462367 100644 (file)
--- a/VHDL.hs
+++ b/VHDL.hs
@@ -25,28 +25,25 @@ 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 ::
   HsFunction        -- | The function signature
   -> FuncData       -- | The function data collected so far
-  -> VHDLState ()
+  -> Maybe Entity   -- | The resulting entity
 
 createEntity hsfunc fdata = 
-  let func = flatFunc fdata in
-  case func of
+  case flatFunc fdata of
     -- Skip (builtin) functions without a FlatFunction
-    Nothing -> do return ()
+    Nothing -> Nothing
     -- Create an entity for all other functions
     Just flatfunc ->
       let 
@@ -62,9 +59,8 @@ createEntity hsfunc fdata =
           then Nothing
           else Just $ AST.PackageDec pkg_id (map AST.PDITD $ ty_decls ++ ty_decls')
         AST.EntityDec entity_id _ = ent_decl' 
-        entity' = Entity entity_id args' res' (Just ent_decl') pkg_decl
-      in do
-        setEntity hsfunc entity'
+      in 
+        Just $ Entity entity_id args' res' (Just ent_decl') pkg_decl
   where
     mkMap :: 
       [(SignalId, SignalInfo)] 
@@ -306,20 +302,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))