import Text.PrettyPrint.HughesPJ (render)
import Data.Accessor.Monad.Trans.State
import qualified Data.Map as Map
+import qualified Data.Time.Clock as Clock
+import Debug.Trace
-- GHC API
import qualified CoreSyn
-> Finder
-> IO ()
makeVHDL libdir filenames finder = do
+ start <- Clock.getCurrentTime
-- Load the modules
(cores, env, specs) <- loadModules libdir filenames (Just finder)
-- Translate to VHDL
let dir = "./vhdl/" ++ (show top_entity) ++ "/"
prepareDir dir
mapM_ (writeVHDL dir) vhdl
- return ()
+ end <- Clock.getCurrentTime
+ trace ("\nTotal compilation took " ++ show (Clock.diffUTCTime end start)) $
+ return ()
-- | Translate the specified entities in the given modules to VHDL.
moduleToVHDL ::
-> [EntitySpec] -- ^ The entities to generate
-> IO [(AST.VHDLId, AST.DesignFile)]
moduleToVHDL env cores specs = do
- vhdl <- runTranslatorSession env $ do
+ (vhdl, count) <- runTranslatorSession env $ do
let all_bindings = concatMap (\x -> CoreSyn.flattenBinds (HscTypes.cm_binds x)) cores
-- Store the bindings we loaded
tsBindings %= Map.fromList all_bindings
tsInitStates %= Map.fromList all_initstates
test_binds <- catMaybesM $ Monad.mapM mkTest specs
let topbinds = Maybe.catMaybes $ map (\(top, _, _) -> top) specs
- case topbinds of
+ vhdl <- case topbinds of
[] -> error "Could not find top entity requested"
tops -> createDesignFiles (tops ++ test_binds)
+ count <- get tsTransformCounter
+ return (vhdl, count)
mapM_ (putStr . render . Ppr.ppr . snd) vhdl
+ putStr $ "Total number of transformations applied: " ++ (show count) ++ "\n"
return vhdl
where
mkTest :: EntitySpec -> TranslatorSession (Maybe CoreSyn.CoreBndr)
-- a unique supply anywhere.
uniqSupply <- UniqSupply.mkSplitUniqSupply 'z'
let init_typestate = TypeState builtin_types [] Map.empty Map.empty env
- let init_state = TranslatorState uniqSupply init_typestate Map.empty Map.empty 0 Map.empty Map.empty Map.empty
+ let init_state = TranslatorState uniqSupply init_typestate Map.empty Map.empty 0 Map.empty Map.empty Map.empty 0
return $ State.evalState session init_state
-- | Prepares the directory for writing VHDL files. This means creating the