X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FsimplStg%2FStgStats.lhs;h=fd5946a3fe7761bbb7be8eb306717fbe8c87080f;hb=ed5e2dd0d9756f02f3d6c1937d485929e8f0ca61;hp=a513b50fa3f17b94d5e0f93899b7c4854878fcca;hpb=6c381e873e222417d9a67aeec77b9555eca7b7a8;p=ghc-hetmet.git diff --git a/ghc/compiler/simplStg/StgStats.lhs b/ghc/compiler/simplStg/StgStats.lhs index a513b50..fd5946a 100644 --- a/ghc/compiler/simplStg/StgStats.lhs +++ b/ghc/compiler/simplStg/StgStats.lhs @@ -1,5 +1,5 @@ % -% (c) The GRASP/AQUA Project, Glasgow University, 1992-1994 +% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998 % \section[StgStats]{Gathers statistical information about programs} @@ -21,15 +21,14 @@ The program gather statistics about \end{enumerate} \begin{code} -#include "HsVersions.h" - module StgStats ( showStgStats ) where -import StgSyn +#include "HsVersions.h" -import FiniteMap +import StgSyn -import Util +import FiniteMap ( emptyFM, plusFM_C, unitFM, fmToList, FiniteMap ) +import Id (Id) \end{code} \begin{code} @@ -63,10 +62,10 @@ combineSEs :: [StatEnv] -> StatEnv combineSEs = foldr combineSE emptySE countOne :: CounterType -> StatEnv -countOne c = singletonFM c 1 +countOne c = unitFM c 1 countN :: CounterType -> Int -> StatEnv -countN = singletonFM +countN = unitFM \end{code} %************************************************************************ @@ -129,7 +128,7 @@ statRhs :: Bool -> (Id, StgRhs) -> StatEnv statRhs top (b, StgRhsCon cc con args) = countOne (ConstructorBinds top) -statRhs top (b, StgRhsClosure cc bi fv u args body) +statRhs top (b, StgRhsClosure cc bi srt fv u args body) = statExpr body `combineSE` countN FreeVariables (length fv) `combineSE` countOne ( @@ -149,19 +148,11 @@ statRhs top (b, StgRhsClosure cc bi fv u args body) \begin{code} statExpr :: StgExpr -> StatEnv -statExpr (StgApp _ [] lvs) - = countOne Literals -statExpr (StgApp _ _ lvs) - = countOne Applications - -statExpr (StgCon con as lvs) - = countOne ConstructorApps - -statExpr (StgPrim op as lvs) - = countOne PrimitiveApps - -statExpr (StgSCC ty l e) - = statExpr e +statExpr (StgApp _ _) = countOne Applications +statExpr (StgLit _) = countOne Literals +statExpr (StgConApp _ _) = countOne ConstructorApps +statExpr (StgPrimApp _ _ _) = countOne PrimitiveApps +statExpr (StgSCC l e) = statExpr e statExpr (StgLetNoEscape lvs_whole lvs_rhss binds body) = statBinding False{-not top-level-} binds `combineSE` @@ -172,7 +163,7 @@ statExpr (StgLet binds body) = statBinding False{-not top-level-} binds `combineSE` statExpr body -statExpr (StgCase expr lve lva uniq alts) +statExpr (StgCase expr lve lva bndr srt alts) = statExpr expr `combineSE` stat_alts alts where @@ -190,6 +181,6 @@ statExpr (StgCase expr lve lva uniq alts) stat_deflt StgNoDefault = emptySE - stat_deflt (StgBindDefault b u expr) = statExpr expr + stat_deflt (StgBindDefault expr) = statExpr expr \end{code}