From 224b5e669cb545d6d49a1369c036dde516400081 Mon Sep 17 00:00:00 2001 From: "simonpj@microsoft.com" Date: Thu, 31 Mar 2011 10:15:22 +0000 Subject: [PATCH] New statistics flags -ddump-core-stats This dumps a (one-line) listing of the size of the Core program, just after tidying --- compiler/coreSyn/CoreUtils.lhs | 58 ++++++++++++++++++++++++++++++++++++++++ compiler/main/DynFlags.hs | 2 ++ compiler/main/TidyPgm.lhs | 10 +++++++ compiler/types/Type.lhs | 25 ++++++++++++++++- docs/users_guide/debugging.xml | 11 ++++++++ docs/users_guide/flags.xml | 7 +++++ 6 files changed, 112 insertions(+), 1 deletion(-) diff --git a/compiler/coreSyn/CoreUtils.lhs b/compiler/coreSyn/CoreUtils.lhs index 0eab695..70e1db7 100644 --- a/compiler/coreSyn/CoreUtils.lhs +++ b/compiler/coreSyn/CoreUtils.lhs @@ -32,6 +32,7 @@ module CoreUtils ( -- * Expression and bindings size coreBindsSize, exprSize, + CoreStats(..), coreBindsStats, -- * Hashing hashExpr, @@ -1120,6 +1121,7 @@ coreBindsSize bs = foldr ((+) . bindSize) 0 bs exprSize :: CoreExpr -> Int -- ^ A measure of the size of the expressions, strictly greater than 0 -- It also forces the expression pretty drastically as a side effect +-- Counts *leaves*, not internal nodes. Types and coercions are not counted. exprSize (Var v) = v `seq` 1 exprSize (Lit lit) = lit `seq` 1 exprSize (App f a) = exprSize f + exprSize a @@ -1154,6 +1156,62 @@ altSize :: CoreAlt -> Int altSize (c,bs,e) = c `seq` varsSize bs + exprSize e \end{code} +\begin{code} +data CoreStats = CS { cs_tm, cs_ty, cs_co :: Int } + +plusCS :: CoreStats -> CoreStats -> CoreStats +plusCS (CS { cs_tm = p1, cs_ty = q1, cs_co = r1 }) + (CS { cs_tm = p2, cs_ty = q2, cs_co = r2 }) + = CS { cs_tm = p1+p2, cs_ty = q1+q2, cs_co = r1+r2 } + +zeroCS, oneTM :: CoreStats +zeroCS = CS { cs_tm = 0, cs_ty = 0, cs_co = 0 } +oneTM = zeroCS { cs_tm = 1 } + +sumCS :: (a -> CoreStats) -> [a] -> CoreStats +sumCS f = foldr (plusCS . f) zeroCS + +coreBindsStats :: [CoreBind] -> CoreStats +coreBindsStats = sumCS bindStats + +bindStats :: CoreBind -> CoreStats +bindStats (NonRec v r) = bindingStats v r +bindStats (Rec prs) = sumCS (\(v,r) -> bindingStats v r) prs + +bindingStats :: Var -> CoreExpr -> CoreStats +bindingStats v r = bndrStats v `plusCS` exprStats r + +bndrStats :: Var -> CoreStats +bndrStats v = oneTM `plusCS` tyStats (varType v) + +exprStats :: CoreExpr -> CoreStats +exprStats (Var {}) = oneTM +exprStats (Lit {}) = oneTM +exprStats (App f (Type t))= tyCoStats (exprType f) t +exprStats (App f a) = exprStats f `plusCS` exprStats a +exprStats (Lam b e) = bndrStats b `plusCS` exprStats e +exprStats (Let b e) = bindStats b `plusCS` exprStats e +exprStats (Case e b _ as) = exprStats e `plusCS` bndrStats b `plusCS` sumCS altStats as +exprStats (Cast e co) = coStats co `plusCS` exprStats e +exprStats (Note _ e) = exprStats e +exprStats (Type ty) = zeroCS { cs_ty = typeSize ty } + -- Ugh (might be a co) + +altStats :: CoreAlt -> CoreStats +altStats (_, bs, r) = sumCS bndrStats bs `plusCS` exprStats r + +tyCoStats :: Type -> Type -> CoreStats +tyCoStats fun_ty arg + = case splitForAllTy_maybe fun_ty of + Just (tv,_) | isCoVar tv -> coStats arg + _ -> tyStats arg + +tyStats :: Type -> CoreStats +tyStats ty = zeroCS { cs_ty = typeSize ty } + +coStats :: Coercion -> CoreStats +coStats co = zeroCS { cs_co = typeSize co } +\end{code} %************************************************************************ %* * diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index fe65839..706ded8 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -128,6 +128,7 @@ data DynFlag | Opt_D_dump_asm_stats | Opt_D_dump_asm_expanded | Opt_D_dump_llvm + | Opt_D_dump_core_stats | Opt_D_dump_cpranal | Opt_D_dump_deriv | Opt_D_dump_ds @@ -1218,6 +1219,7 @@ dynamic_flags = [ , Flag "ddump-raw-cmm" (setDumpFlag Opt_D_dump_raw_cmm) , Flag "ddump-cmmz" (setDumpFlag Opt_D_dump_cmmz) , Flag "ddump-cmmz-pretty" (setDumpFlag Opt_D_dump_cmmz_pretty) + , Flag "ddump-core-stats" (setDumpFlag Opt_D_dump_core_stats) , Flag "ddump-cps-cmm" (setDumpFlag Opt_D_dump_cps_cmm) , Flag "ddump-cvt-cmm" (setDumpFlag Opt_D_dump_cvt_cmm) , Flag "ddump-asm" (setDumpFlag Opt_D_dump_asm) diff --git a/compiler/main/TidyPgm.lhs b/compiler/main/TidyPgm.lhs index 98fbeb3..b78c0db 100644 --- 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, diff --git a/compiler/types/Type.lhs b/compiler/types/Type.lhs index 8ff78fb..5f348ef 100644 --- a/compiler/types/Type.lhs +++ b/compiler/types/Type.lhs @@ -74,7 +74,8 @@ module Type ( -- * Type free variables tyVarsOfType, tyVarsOfTypes, tyVarsOfPred, tyVarsOfTheta, - expandTypeSynonyms, + expandTypeSynonyms, + typeSize, -- * Type comparison coreEqType, coreEqType2, @@ -857,6 +858,28 @@ tyVarsOfTheta = foldr (unionVarSet . tyVarsOfPred) emptyVarSet %************************************************************************ %* * + Size +%* * +%************************************************************************ + +\begin{code} +typeSize :: Type -> Int +typeSize (TyVarTy _) = 1 +typeSize (AppTy t1 t2) = typeSize t1 + typeSize t2 +typeSize (FunTy t1 t2) = typeSize t1 + typeSize t2 +typeSize (PredTy p) = predSize p +typeSize (ForAllTy _ t) = 1 + typeSize t +typeSize (TyConApp _ ts) = 1 + sum (map typeSize ts) + +predSize :: PredType -> Int +predSize (IParam _ t) = 1 + typeSize t +predSize (ClassP _ ts) = 1 + sum (map typeSize ts) +predSize (EqPred t1 t2) = typeSize t1 + typeSize t2 +\end{code} + + +%************************************************************************ +%* * \subsection{Type families} %* * %************************************************************************ diff --git a/docs/users_guide/debugging.xml b/docs/users_guide/debugging.xml index 4db79af..6fc1413 100644 --- a/docs/users_guide/debugging.xml +++ b/docs/users_guide/debugging.xml @@ -437,6 +437,17 @@ + + + + + Print a one-line summary of the size of the Core program + at the end of the optimisation pipeline. + + + + + diff --git a/docs/users_guide/flags.xml b/docs/users_guide/flags.xml index 1a5e67e..f5f949a 100644 --- a/docs/users_guide/flags.xml +++ b/docs/users_guide/flags.xml @@ -2244,6 +2244,13 @@ phase n - + + Print a one-line summary of the size of the Core program + at the end of the optimisation pipeline + dynamic + - + + Dump output from CPR analysis dynamic -- 1.7.10.4