Commit 224b5e66 authored by simonpj@microsoft.com's avatar simonpj@microsoft.com

New statistics flags -ddump-core-stats

This dumps a (one-line) listing of the size of the Core program,
just after tidying
parent 67a30857
......@@ -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}
%************************************************************************
%* *
......
......@@ -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)
......
......@@ -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,
......
......@@ -74,7 +74,8 @@ module Type (
-- * Type free variables
tyVarsOfType, tyVarsOfTypes, tyVarsOfPred, tyVarsOfTheta,
expandTypeSynonyms,
expandTypeSynonyms,
typeSize,
-- * Type comparison
coreEqType, coreEqType2,
......@@ -855,6 +856,28 @@ tyVarsOfTheta = foldr (unionVarSet . tyVarsOfPred) emptyVarSet
\end{code}
%************************************************************************
%* *
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}
......
......@@ -435,6 +435,17 @@
</listitem>
</varlistentry>
<varlistentry>
<term>
<option>-ddump-core-stats</option>
<indexterm><primary><option>-ddump-core-stats</option></primary></indexterm>
</term>
<listitem>
<para>Print a one-line summary of the size of the Core program
at the end of the optimisation pipeline.</para>
</listitem>
</varlistentry>
<varlistentry>
<term>
<option>-dfaststring-stats</option>
......
......@@ -2243,6 +2243,13 @@ phase <replaceable>n</replaceable></entry>
<entry>dynamic</entry>
<entry>-</entry>
</row>
<row>
<entry><option>-ddump-core-stats</option></entry>
<entry>Print a one-line summary of the size of the Core program
at the end of the optimisation pipeline </entry>
<entry>dynamic</entry>
<entry>-</entry>
</row>
<row>
<entry><option>-ddump-cpranal</option></entry>
<entry>Dump output from CPR analysis</entry>
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment