-main =
- do
- defaultErrorHandler defaultDynFlags $ do
- runGhc (Just libdir) $ do
- dflags <- getSessionDynFlags
- setSessionDynFlags dflags
- --target <- guessTarget "adder.hs" Nothing
- --liftIO (print (showSDoc (ppr (target))))
- --liftIO $ printTarget target
- --setTargets [target]
- --load LoadAllTargets
- --core <- GHC.compileToCoreSimplified "Adders.hs"
- core <- GHC.compileToCoreSimplified "Adders.hs"
- --liftIO $ printBinds (cm_binds core)
- let binds = Maybe.mapMaybe (findBind (cm_binds core)) ["sfull_adder"]
- liftIO $ putStr $ prettyShow binds
- -- Turn bind into VHDL
- let (vhdl, sess) = State.runState (mkVHDL binds) (VHDLSession core 0 Map.empty)
- liftIO $ putStr $ render $ ForSyDe.Backend.Ppr.ppr vhdl
- liftIO $ ForSyDe.Backend.VHDL.FileIO.writeDesignFile vhdl "../vhdl/vhdl/output.vhdl"
- liftIO $ putStr $ "\n\nFinal session:\n" ++ prettyShow sess ++ "\n\n"
- return ()
+main = do
+ makeVHDL "Alu.hs" "register_bank"
+
+makeVHDL :: String -> String -> IO ()
+makeVHDL filename name = do
+ -- Load the module
+ core <- loadModule filename
+ -- Translate to VHDL
+ vhdl <- moduleToVHDL core [name]
+ -- Write VHDL to file
+ writeVHDL vhdl "../vhdl/vhdl/output.vhdl"
+
+-- | Show the core structure of the given binds in the given file.
+listBind :: String -> String -> IO ()
+listBind filename name = do
+ core <- loadModule filename
+ let binds = findBinds core [name]
+ putStr "\n"
+ putStr $ prettyShow binds
+ putStr $ showSDoc $ ppr binds
+ putStr "\n\n"
+
+-- | Translate the binds with the given names from the given core module to
+-- VHDL
+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
+ putStr $ "\n\nFinal session:\n" ++ prettyShow sess ++ "\n\n"
+ return vhdl
+