New statistics flags -ddump-core-stats

[ghc-hetmet.git] / compiler / main / TidyPgm.lhs

diff --git a/compiler/main/TidyPgm.lhs b/compiler/main/TidyPgm.lhs
index 4ab553d..b78c0db 100644 (file)
--- a/compiler/main/TidyPgm.lhs
+++ b/compiler/main/TidyPgm.lhs
@@ -46,6 +46,7 @@ import FastBool hiding ( fastOr )
 import Util
 import FastString
 
+import Control.Monad   ( when )
 import Data.List       ( sortBy )
 import Data.IORef      ( IORef, readIORef, writeIORef )
 \end{code}
@@ -353,6 +354,15 @@ tidyProgram hsc_env  (ModGuts { mg_module = mod, mg_exports = exports,
                     (ptext (sLit "rules"))
                     (pprRulesForUser tidy_rules)
 
+          -- Print one-line size info
+        ; let cs = coreBindsStats tidy_binds
+        ; when (dopt Opt_D_dump_core_stats dflags)
+              (printDump (ptext (sLit "Tidy size (terms,types,coercions)") 
+                           <+> ppr (moduleName mod) <> colon 
+                           <+> int (cs_tm cs) 
+                           <+> int (cs_ty cs) 
+                           <+> int (cs_co cs) ))
+
         ; let dir_imp_mods = moduleEnvKeys dir_imps
 
        ; return (CgGuts { cg_module   = mod, 
@@ -712,7 +722,7 @@ addExternal expose_all id = (new_needed_ids, show_unfold)
                      CoreUnfolding { uf_tmpl = unf_rhs, uf_src = src, uf_guidance = guide } 
                                            | show_unfolding src guide
                                            -> Just (unf_ext_ids src unf_rhs)
-                     DFunUnfolding _ _ ops -> Just (exprsFvsInOrder ops)
+                      DFunUnfolding _ _ ops -> Just (exprsFvsInOrder (dfunArgExprs ops))
                      _                     -> Nothing
                   where
                     unf_ext_ids (InlineWrapper v) _ = (unitVarSet v, [v])