Loosen the rules for instance declarations (Part 2)

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

diff --git a/ghc/compiler/simplStg/StgStats.lhs b/ghc/compiler/simplStg/StgStats.lhs
index 7be7b10..a918739 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-1996
+% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
 %
 \section[StgStats]{Gathers statistical information about programs}
 
@@ -21,16 +21,14 @@ The program gather statistics about
 \end{enumerate}
 
 \begin{code}
-#include "HsVersions.h"
-
 module StgStats ( showStgStats ) where
 
-IMP_Ubiq(){-uitous-}
+#include "HsVersions.h"
 
 import StgSyn
 
 import FiniteMap       ( emptyFM, plusFM_C, unitFM, fmToList, FiniteMap )
-import Id (SYN_IE(Id))
+import Id (Id)
 \end{code}
 
 \begin{code}
@@ -40,8 +38,7 @@ data CounterType
   | ConstructorApps
   | PrimitiveApps
   | LetNoEscapes
-  | AlgCases
-  | PrimCases
+  | StgCases
   | FreeVariables
   | ConstructorBinds Bool{-True<=>top-level-}
   | ReEntrantBinds   Bool{-ditto-}
@@ -90,8 +87,7 @@ showStgStats prog
     s ConstructorApps        = "ConstructorApps            "
     s PrimitiveApps          = "PrimitiveApps              "
     s LetNoEscapes           = "LetNoEscapes               "
-    s AlgCases               = "AlgCases                   "
-    s PrimCases                      = "PrimCases                  "
+    s StgCases               = "StgCases                   "
     s FreeVariables          = "FreeVariables              "
     s (ConstructorBinds True) = "ConstructorBinds_Top       "
     s (ReEntrantBinds True)   = "ReEntrantBinds_Top         "
@@ -130,7 +126,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 fv u _srt args body)
   = statExpr body                      `combineSE`
     countN FreeVariables (length fv)   `combineSE`
     countOne (
@@ -150,19 +146,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`
@@ -173,24 +161,12 @@ 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 alt_type alts)
   = statExpr expr      `combineSE`
+    stat_alts alts     `combineSE`
+    countOne StgCases
+  where
     stat_alts alts
-    where
-      stat_alts (StgAlgAlts ty alts def)
        = combineSEs (map statExpr [ e | (_,_,_,e) <- alts ])
-                                       `combineSE`
-         stat_deflt def                `combineSE`
-         countOne AlgCases
-
-      stat_alts (StgPrimAlts ty alts def)
-       = combineSEs (map statExpr [ e | (_,e) <- alts ])
-                                       `combineSE`
-         stat_deflt def                `combineSE`
-         countOne PrimCases
-
-      stat_deflt StgNoDefault = emptySE
-
-      stat_deflt (StgBindDefault b u expr) = statExpr expr
 \end{code}