-- Translate to VHDL
vhdl <- moduleToVHDL core [name]
-- Write VHDL to file
- writeVHDL vhdl "../vhdl/vhdl/output.vhdl"
+ mapM (writeVHDL "../vhdl/vhdl/") vhdl
+ return ()
-- | Show the core structure of the given binds in the given file.
listBind :: String -> String -> IO ()
-- | Translate the binds with the given names from the given core module to
-- VHDL
-moduleToVHDL :: HscTypes.CoreModule -> [String] -> IO AST.DesignFile
+moduleToVHDL :: HscTypes.CoreModule -> [String] -> IO [AST.DesignFile]
moduleToVHDL core names = do
--liftIO $ putStr $ prettyShow (cm_binds core)
let binds = findBinds core names
--putStr $ prettyShow binds
-- Turn bind into VHDL
let (vhdl, sess) = State.runState (mkVHDL binds) (VHDLSession core 0 Map.empty)
- putStr $ render $ ForSyDe.Backend.Ppr.ppr vhdl
+ mapM (putStr . render . ForSyDe.Backend.Ppr.ppr) vhdl
putStr $ "\n\nFinal session:\n" ++ prettyShow sess ++ "\n\n"
return vhdl
modFuncs nameFlatFunction
modFuncs VHDL.createEntity
modFuncs VHDL.createArchitecture
- VHDL.getDesignFile
+ VHDL.getDesignFiles
--- | Write the given design file to the given file
-writeVHDL :: AST.DesignFile -> String -> IO ()
-writeVHDL = ForSyDe.Backend.VHDL.FileIO.writeDesignFile
+-- | 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
+-- will be used as a filename.
+writeVHDL :: String -> AST.DesignFile -> IO ()
+writeVHDL dir vhdl = do
+ let AST.DesignFile _ (u:us) = vhdl
+ let AST.LUEntity (AST.EntityDec id _) = u
+ let fname = dir ++ AST.fromVHDLId id ++ ".vhdl"
+ ForSyDe.Backend.VHDL.FileIO.writeDesignFile vhdl fname
-- | Loads the given file and turns it into a core module.
loadModule :: String -> IO HscTypes.CoreModule
import TranslatorTypes
import Pretty
-getDesignFile :: VHDLState AST.DesignFile
-getDesignFile = do
+getDesignFiles :: VHDLState [AST.DesignFile]
+getDesignFiles = do
-- Extract the library units generated from all the functions in the
-- session.
funcs <- getFuncs
- let units = concat $ map getLibraryUnits funcs
+ 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 $ AST.DesignFile
- context
- units
+ return $ map (\(ent, arch) -> AST.DesignFile context [ent, arch]) units
-- | Create an entity for a given function
createEntity ::
getLibraryUnits ::
(HsFunction, FuncData) -- | A function from the session
- -> [AST.LibraryUnit] -- | The library units it generates
+ -> Maybe (AST.LibraryUnit, AST.LibraryUnit) -- | The entity and architecture for the function
getLibraryUnits (hsfunc, fdata) =
case funcEntity fdata of
- Nothing -> []
- Just ent -> case ent_decl ent of
- Nothing -> []
- Just decl -> [AST.LUEntity decl]
- ++
- case funcArch fdata of
- Nothing -> []
- Just arch -> [AST.LUArch arch]
+ Nothing -> Nothing
+ Just ent ->
+ case ent_decl ent of
+ Nothing -> Nothing
+ Just decl ->
+ case funcArch fdata of
+ Nothing -> Nothing
+ Just arch ->
+ Just (AST.LUEntity decl, AST.LUArch arch)
-- | The VHDL Bit type
bit_ty :: AST.TypeMark