projects
/
matthijs
/
master-project
/
cλash.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Log the time needed for compilation.
[matthijs/master-project/cλash.git]
/
cλash
/
CLasH
/
Translator.hs
diff --git
a/cλash/CLasH/Translator.hs
b/cλash/CLasH/Translator.hs
index 16158d24df07fbbf441688a313cf3863cf47a9a5..79bd8d2e74ab9d7a97ace0d21849810f145add6d 100644
(file)
--- a/
cλash/CLasH/Translator.hs
+++ b/
cλash/CLasH/Translator.hs
@@
-1,5
+1,5
@@
module CLasH.Translator
module CLasH.Translator
- (
-- makeVHDLStrings
+ (
makeVHDLAnnotations
) where
makeVHDLAnnotations
) where
@@
-12,25
+12,23
@@
import qualified Control.Monad.Trans.State as State
import Text.PrettyPrint.HughesPJ (render)
import Data.Accessor.Monad.Trans.State
import qualified Data.Map as Map
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
import Debug.Trace
-- GHC API
import qualified CoreSyn
-import qualified GHC
import qualified HscTypes
import qualified UniqSupply
-- VHDL Imports
import qualified Language.VHDL.AST as AST
import qualified HscTypes
import qualified UniqSupply
-- VHDL Imports
import qualified Language.VHDL.AST as AST
-import qualified Language.VHDL.FileIO
+import qualified Language.VHDL.FileIO
as FileIO
import qualified Language.VHDL.Ppr as Ppr
-- Local Imports
import qualified Language.VHDL.Ppr as Ppr
-- Local Imports
-import CLasH.Normalize
import CLasH.Translator.TranslatorTypes
import CLasH.Translator.Annotations
import CLasH.Utils
import CLasH.Translator.TranslatorTypes
import CLasH.Translator.Annotations
import CLasH.Utils
-import CLasH.Utils.Core.CoreTools
import CLasH.Utils.GhcTools
import CLasH.VHDL
import CLasH.VHDL.VHDLTools
import CLasH.Utils.GhcTools
import CLasH.VHDL
import CLasH.VHDL.VHDLTools
@@
-59,7
+57,7
@@
makeVHDLAnnotations ::
FilePath -- ^ The GHC Library Dir
-> [FilePath] -- ^ The FileNames
-> IO ()
FilePath -- ^ The GHC Library Dir
-> [FilePath] -- ^ The FileNames
-> IO ()
-makeVHDLAnnotations libdir filenames =
do
+makeVHDLAnnotations libdir filenames =
makeVHDL libdir filenames finder
where
finder = findSpec (hasCLasHAnnotation isTopEntity)
makeVHDL libdir filenames finder
where
finder = findSpec (hasCLasHAnnotation isTopEntity)
@@
-75,6
+73,7
@@
makeVHDL ::
-> Finder
-> IO ()
makeVHDL libdir filenames finder = do
-> Finder
-> IO ()
makeVHDL libdir filenames finder = do
+ start <- Clock.getCurrentTime
-- Load the modules
(cores, env, specs) <- loadModules libdir filenames (Just finder)
-- Translate to VHDL
-- Load the modules
(cores, env, specs) <- loadModules libdir filenames (Just finder)
-- Translate to VHDL
@@
-83,8
+82,10
@@
makeVHDL libdir filenames finder = do
let top_entity = head $ Maybe.catMaybes $ map (\(t, _, _) -> t) specs
let dir = "./vhdl/" ++ (show top_entity) ++ "/"
prepareDir dir
let top_entity = head $ Maybe.catMaybes $ map (\(t, _, _) -> t) specs
let dir = "./vhdl/" ++ (show top_entity) ++ "/"
prepareDir dir
- mapM (writeVHDL dir) vhdl
- return ()
+ mapM_ (writeVHDL dir) vhdl
+ end <- Clock.getCurrentTime
+ trace ("\nTotal compilation took " ++ show (Clock.diffUTCTime end start)) $
+ return ()
-- | Translate the specified entities in the given modules to VHDL.
moduleToVHDL ::
-- | Translate the specified entities in the given modules to VHDL.
moduleToVHDL ::
@@
-94,18
+95,17
@@
moduleToVHDL ::
-> IO [(AST.VHDLId, AST.DesignFile)]
moduleToVHDL env cores specs = do
vhdl <- runTranslatorSession env $ do
-> IO [(AST.VHDLId, AST.DesignFile)]
moduleToVHDL env cores specs = do
vhdl <- runTranslatorSession env $ do
- let all_bindings = concat
(map (\x -> CoreSyn.flattenBinds (HscTypes.cm_binds x)) cores)
+ let all_bindings = concat
Map (\x -> CoreSyn.flattenBinds (HscTypes.cm_binds x)) cores
-- Store the bindings we loaded
tsBindings %= Map.fromList all_bindings
-- Store the bindings we loaded
tsBindings %= Map.fromList all_bindings
- let all_initstates = concat
(map (\x -> case x of (_, Nothing, _) -> []; (_, Just inits, _) -> inits) specs)
+ let all_initstates = concat
Map (\x -> case x of (_, Nothing, _) -> []; (_, Just inits, _) -> inits) specs
tsInitStates %= Map.fromList all_initstates
test_binds <- catMaybesM $ Monad.mapM mkTest specs
tsInitStates %= Map.fromList all_initstates
test_binds <- catMaybesM $ Monad.mapM mkTest specs
- mapM_ printAnns specs
let topbinds = Maybe.catMaybes $ map (\(top, _, _) -> top) specs
case topbinds of
let topbinds = Maybe.catMaybes $ map (\(top, _, _) -> top) specs
case topbinds of
- [] -> error
$
"Could not find top entity requested"
+ [] -> error "Could not find top entity requested"
tops -> createDesignFiles (tops ++ test_binds)
tops -> createDesignFiles (tops ++ test_binds)
- mapM (putStr . render . Ppr.ppr . snd) vhdl
+ mapM
_
(putStr . render . Ppr.ppr . snd) vhdl
return vhdl
where
mkTest :: EntitySpec -> TranslatorSession (Maybe CoreSyn.CoreBndr)
return vhdl
where
mkTest :: EntitySpec -> TranslatorSession (Maybe CoreSyn.CoreBndr)
@@
-115,9
+115,6
@@
moduleToVHDL env cores specs = do
mkTest (Just top, _, Just input) = do
bndr <- createTestbench Nothing cores input top
return $ Just bndr
mkTest (Just top, _, Just input) = do
bndr <- createTestbench Nothing cores input top
return $ Just bndr
- printAnns :: EntitySpec -> TranslatorSession ()
- printAnns (_, Nothing, _) = trace ("no anns found:\n\n") $ return ()
- printAnns (_, (Just anns), _) = trace ("anns:\n\n" ++ show anns ++ "\n") $ return ()
-- Run the given translator session. Generates a new UniqSupply for that
-- session.
-- Run the given translator session. Generates a new UniqSupply for that
-- session.
@@
-154,6
+151,6
@@
writeVHDL dir (name, vhdl) = do
-- Find the filename
let fname = dir ++ (AST.fromVHDLId name) ++ ".vhdl"
-- Write the file
-- Find the filename
let fname = dir ++ (AST.fromVHDLId name) ++ ".vhdl"
-- Write the file
-
Language.VHDL.
FileIO.writeDesignFile vhdl fname
+ FileIO.writeDesignFile vhdl fname
-- vim: set ts=8 sw=2 sts=2 expandtab:
-- vim: set ts=8 sw=2 sts=2 expandtab: