X-Git-Url: https://git.stderr.nl/gitweb?a=blobdiff_plain;f=c%CE%BBash%2FCLasH%2FTranslator.hs;h=a9bb9fa4cfed041f1ba5b69d6b82fe4b75857689;hb=0223b461a043e42d3fc5442904b73ce0bd537472;hp=04b7beb0900b14950dec9f5f0f00bc5454635666;hpb=f3951a1376fc7d7f8addbe9e9fed071320502100;p=matthijs%2Fmaster-project%2Fc%CE%BBash.git

diff --git "a/c\316\273ash/CLasH/Translator.hs" "b/c\316\273ash/CLasH/Translator.hs"
index 04b7beb..a9bb9fa 100644
--- "a/c\316\273ash/CLasH/Translator.hs"
+++ "b/c\316\273ash/CLasH/Translator.hs"
@@ -12,6 +12,8 @@ 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 qualified Data.Time.Clock as Clock
+import Debug.Trace
 
 -- GHC API
 import qualified CoreSyn
@@ -71,6 +73,7 @@ makeVHDL ::
   -> Finder
   -> IO ()
 makeVHDL libdir filenames finder = do
+  start <- Clock.getCurrentTime
   -- Load the modules
   (cores, env, specs) <- loadModules libdir filenames (Just finder)
   -- Translate to VHDL
@@ -80,7 +83,9 @@ makeVHDL libdir filenames finder = do
   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 ::
@@ -89,7 +94,7 @@ 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
@@ -97,10 +102,13 @@ moduleToVHDL env cores specs = do
     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)
@@ -122,7 +130,7 @@ runTranslatorSession env session = do
   -- 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