X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FsimplStg%2FStgStats.lhs;h=a91873971c1fe517947095a3a4cfe36b72793344;hb=28a464a75e14cece5db40f2765a29348273ff2d2;hp=bfe00f3fbbb83ca1b90e7ef1ea29dd3c8e29e7a5;hpb=10521d8418fd3a1cf32882718b5bd28992db36fd;p=ghc-hetmet.git

diff --git a/ghc/compiler/simplStg/StgStats.lhs b/ghc/compiler/simplStg/StgStats.lhs
index bfe00f3..a918739 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}
@@ -39,8 +38,7 @@ data CounterType
   | ConstructorApps
   | PrimitiveApps
   | LetNoEscapes
-  | AlgCases
-  | PrimCases
+  | StgCases
   | FreeVariables
   | ConstructorBinds Bool{-True<=>top-level-}
   | ReEntrantBinds   Bool{-ditto-}
@@ -63,10 +61,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}
 
 %************************************************************************
@@ -76,7 +74,7 @@ countN = singletonFM
 %************************************************************************
 
 \begin{code}
-showStgStats :: PlainStgProgram -> String
+showStgStats :: [StgBinding] -> String
 
 showStgStats prog
   = "STG Statistics:\n\n"
@@ -89,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         "
@@ -101,9 +98,9 @@ showStgStats prog
     s (SingleEntryBinds _)    = "SingleEntryBinds_Nested    "
     s (UpdatableBinds _)      = "UpdatableBinds_Nested      "
 
-gatherStgStats :: PlainStgProgram -> StatEnv
+gatherStgStats :: [StgBinding] -> StatEnv
 
-gatherStgStats binds 
+gatherStgStats binds
   = combineSEs (map (statBinding True{-top-level-}) binds)
 \end{code}
 
@@ -115,7 +112,7 @@ gatherStgStats binds
 
 \begin{code}
 statBinding :: Bool -- True <=> top-level; False <=> nested
-	    -> PlainStgBinding
+	    -> StgBinding
 	    -> StatEnv
 
 statBinding top (StgNonRec b rhs)
@@ -124,13 +121,13 @@ statBinding top (StgNonRec b rhs)
 statBinding top (StgRec pairs)
   = combineSEs (map (statRhs top) pairs)
 
-statRhs :: Bool -> (Id, PlainStgRhs) -> StatEnv
+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)
-  = statExpr body			`combineSE` 
+statRhs top (b, StgRhsClosure cc bi fv u _srt args body)
+  = statExpr body			`combineSE`
     countN FreeVariables (length fv)	`combineSE`
     countOne (
       case u of
@@ -146,50 +143,30 @@ statRhs top (b, StgRhsClosure cc bi fv u args body)
 %*									*
 %************************************************************************
 
-\begin{code}    
-statExpr :: PlainStgExpr -> StatEnv
-
-statExpr (StgApp _ [] lvs) 
-  = countOne Literals
-statExpr (StgApp _ _ lvs) 
-  = countOne Applications
-
-statExpr (StgConApp con as lvs)
-  = countOne ConstructorApps
-
-statExpr (StgPrimApp op as lvs)
-  = countOne PrimitiveApps
+\begin{code}
+statExpr :: StgExpr -> StatEnv
 
-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`
-    statExpr body				`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 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}