From bf0b6fedf46d525cc7e4d389b4fb7dd539174939 Mon Sep 17 00:00:00 2001 From: Matthijs Kooijman Date: Thu, 5 Mar 2009 13:09:01 +0100 Subject: [PATCH] Remove getDesignFiles from the VHDLState monad. This also does some related cleanup. --- Translator.hs | 3 ++- VHDL.hs | 31 ++++++++++++++----------------- 2 files changed, 16 insertions(+), 18 deletions(-) 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)) -- 2.30.2