diff options
| -rw-r--r-- | compiler/simplStg/StgStats.lhs | 81 |
1 files changed, 35 insertions, 46 deletions
diff --git a/compiler/simplStg/StgStats.lhs b/compiler/simplStg/StgStats.lhs index d389431f18..5424495468 100644 --- a/compiler/simplStg/StgStats.lhs +++ b/compiler/simplStg/StgStats.lhs @@ -21,20 +21,6 @@ The program gather statistics about \end{enumerate} \begin{code} -{-# OPTIONS -fno-warn-tabs #-} --- The above warning supression flag is a temporary kludge. --- While working on this module you are encouraged to remove it and --- detab the module (please do the detabbing in a separate patch). See --- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces --- for details - -{-# OPTIONS -fno-warn-incomplete-patterns #-} --- The above warning supression flag is a temporary kludge. --- While working on this module you are encouraged to remove it and fix --- any warnings in the module. See --- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings --- for details - module StgStats ( showStgStats ) where #include "HsVersions.h" @@ -42,6 +28,7 @@ module StgStats ( showStgStats ) where import StgSyn import Id (Id) +import Panic import Data.Map (Map) import qualified Data.Map as Map @@ -62,13 +49,13 @@ data CounterType | UpdatableBinds Bool{-ditto-} deriving (Eq, Ord) -type Count = Int -type StatEnv = Map CounterType Count +type Count = Int +type StatEnv = Map CounterType Count \end{code} \begin{code} -emptySE :: StatEnv -emptySE = Map.empty +emptySE :: StatEnv +emptySE = Map.empty combineSE :: StatEnv -> StatEnv -> StatEnv combineSE = Map.unionWith (+) @@ -84,9 +71,9 @@ countN = Map.singleton \end{code} %************************************************************************ -%* * +%* * \subsection{Top-level list of bindings (a ``program'')} -%* * +%* * %************************************************************************ \begin{code} @@ -98,13 +85,13 @@ showStgStats prog where showc (x,n) = (showString (s x) . shows n) "\n" - s Literals = "Literals " - s Applications = "Applications " - s ConstructorApps = "ConstructorApps " - s PrimitiveApps = "PrimitiveApps " - s LetNoEscapes = "LetNoEscapes " - s StgCases = "StgCases " - s FreeVariables = "FreeVariables " + s Literals = "Literals " + s Applications = "Applications " + s ConstructorApps = "ConstructorApps " + s PrimitiveApps = "PrimitiveApps " + s LetNoEscapes = "LetNoEscapes " + s StgCases = "StgCases " + s FreeVariables = "FreeVariables " s (ConstructorBinds True) = "ConstructorBinds_Top " s (ReEntrantBinds True) = "ReEntrantBinds_Top " s (SingleEntryBinds True) = "SingleEntryBinds_Top " @@ -121,15 +108,15 @@ gatherStgStats binds \end{code} %************************************************************************ -%* * +%* * \subsection{Bindings} -%* * +%* * %************************************************************************ \begin{code} statBinding :: Bool -- True <=> top-level; False <=> nested - -> StgBinding - -> StatEnv + -> StgBinding + -> StatEnv statBinding top (StgNonRec b rhs) = statRhs top (b, rhs) @@ -143,47 +130,49 @@ statRhs top (_, StgRhsCon _ _ _) = countOne (ConstructorBinds top) statRhs top (_, StgRhsClosure _ _ fv u _ _ body) - = statExpr body `combineSE` - countN FreeVariables (length fv) `combineSE` + = statExpr body `combineSE` + countN FreeVariables (length fv) `combineSE` countOne ( case u of - ReEntrant -> ReEntrantBinds top - Updatable -> UpdatableBinds top - SingleEntry -> SingleEntryBinds top + ReEntrant -> ReEntrantBinds top + Updatable -> UpdatableBinds top + SingleEntry -> SingleEntryBinds top ) \end{code} %************************************************************************ -%* * +%* * \subsection{Expressions} -%* * +%* * %************************************************************************ \begin{code} statExpr :: StgExpr -> StatEnv -statExpr (StgApp _ _) = countOne Applications -statExpr (StgLit _) = countOne Literals +statExpr (StgApp _ _) = countOne Applications +statExpr (StgLit _) = countOne Literals statExpr (StgConApp _ _) = countOne ConstructorApps statExpr (StgOpApp _ _ _) = countOne PrimitiveApps statExpr (StgSCC _ _ _ e) = statExpr e statExpr (StgTick _ _ e) = statExpr e statExpr (StgLetNoEscape _ _ binds body) - = statBinding False{-not top-level-} binds `combineSE` - statExpr body `combineSE` + = statBinding False{-not top-level-} binds `combineSE` + statExpr body `combineSE` countOne LetNoEscapes statExpr (StgLet binds body) - = statBinding False{-not top-level-} binds `combineSE` + = statBinding False{-not top-level-} binds `combineSE` statExpr body statExpr (StgCase expr _ _ _ _ _ alts) - = statExpr expr `combineSE` - stat_alts alts `combineSE` + = statExpr expr `combineSE` + stat_alts alts `combineSE` countOne StgCases where stat_alts alts - = combineSEs (map statExpr [ e | (_,_,_,e) <- alts ]) + = combineSEs (map statExpr [ e | (_,_,_,e) <- alts ]) + +statExpr (StgLam {}) = panic "statExpr StgLam" \end{code} |