X-Git-Url: https://git.stderr.nl/gitweb?a=blobdiff_plain;f=VHDL.hs;h=6f3705e421d6f0d55b16faef97054ac3f3462367;hb=53b8d7183c05b1c1248875bf3a9394a0a7af5518;hp=338aa1df889005824ca15bb3407c7517a11882c0;hpb=24f59578d64d787aa7663094a428b80be7a207a6;p=matthijs%2Fmaster-project%2Fc%CE%BBash.git diff --git a/VHDL.hs b/VHDL.hs index 338aa1d..6f3705e 100644 --- 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))