[project @ 2001-05-22 13:43:14 by simonpj]

[ghc-hetmet.git] / ghc / compiler / simplStg / StgStats.lhs

diff --git a/ghc/compiler/simplStg/StgStats.lhs b/ghc/compiler/simplStg/StgStats.lhs
index a513b50..824c112 100644 (file)
--- 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}
 
 %************************************************************************
@@ -118,10 +117,10 @@ statBinding :: Bool -- True <=> top-level; False <=> nested
            -> StgBinding
            -> StatEnv
 
-statBinding top (StgNonRec b rhs)
+statBinding top (StgNonRec _srt b rhs)
   = statRhs top (b, rhs)
 
-statBinding top (StgRec pairs)
+statBinding top (StgRec _srt pairs)
   = combineSEs (map (statRhs top) pairs)
 
 statRhs :: Bool -> (Id, StgRhs) -> StatEnv
@@ -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 (StgOpApp _ _ _) = 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}