Keep (and show) a count of applied transformations.

diff --git a/cλash/CLasH/Normalize/NormalizeTools.hs b/cλash/CLasH/Normalize/NormalizeTools.hs
index e01b7b79c69080d57a5ceeb07e9980427c266014..803fd958cec82637d8177194da570e89ecf40f2b 100644 (file)
--- a/cλash/CLasH/Normalize/NormalizeTools.hs
+++ b/cλash/CLasH/Normalize/NormalizeTools.hs
@@ -45,10 +45,11 @@ applyboth first (name, second) context expr = do
   if Monoid.getAny $
         -- trace ("Trying to apply transform " ++ name ++ " to:\n" ++ showSDoc (nest 4 $ ppr expr') ++ "\nType: \n" ++ (showSDoc $ nest 4 $ ppr $ CoreUtils.exprType expr') ++ "\n")
         changed 
-    then 
+    then do
      -- trace ("Applying transform " ++ name ++ " to:\n" ++ showSDoc (nest 4 $ ppr expr') ++ "\nType: \n" ++ (showSDoc $ nest 4 $ ppr $ CoreUtils.exprType expr') ++ "\n"
      --        ++ "Context: " ++ show context ++ "\n"
      --        ++ "Result of applying " ++ name ++ ":\n" ++ showSDoc (nest 4 $ ppr expr'') ++ "\n" ++ "Type: \n" ++ (showSDoc $ nest 4 $ ppr $ CoreUtils.exprType expr'') ++ "\n" ) $
+      Trans.lift $ MonadState.modify tsTransformCounter (+1)
       applyboth first (name, second) context expr'' 
     else 
       -- trace ("No changes") $

diff --git a/cλash/CLasH/Translator.hs b/cλash/CLasH/Translator.hs
index 79bd8d2e74ab9d7a97ace0d21849810f145add6d..a9bb9fa4cfed041f1ba5b69d6b82fe4b75857689 100644 (file)
--- a/cλash/CLasH/Translator.hs
+++ b/cλash/CLasH/Translator.hs
@@ -94,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
@@ -102,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)
@@ -127,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

diff --git a/cλash/CLasH/Translator/TranslatorTypes.hs b/cλash/CLasH/Translator/TranslatorTypes.hs
index d8402567e14f16e27fdf547a7ab3d1a91a430286..eabb00423c5c0734aab838be9a353db290e32e55 100644 (file)
--- a/cλash/CLasH/Translator/TranslatorTypes.hs
+++ b/cλash/CLasH/Translator/TranslatorTypes.hs
@@ -93,6 +93,7 @@ data TranslatorState = TranslatorState {
   , tsEntities_ :: Map.Map CoreSyn.CoreBndr Entity
   , tsArchitectures_ :: Map.Map CoreSyn.CoreBndr (Architecture, [CoreSyn.CoreBndr])
   , tsInitStates_ :: Map.Map CoreSyn.CoreBndr CoreSyn.CoreBndr
+  , tsTransformCounter_ :: Int -- ^ How many transformations were applied?
 }
 
 -- Derive accessors