Whitespace only in nativeGen/RegAlloc/Linear/Main.hs

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

diff --git a/compiler/simplStg/StgStats.lhs b/compiler/simplStg/StgStats.lhs
index a918739..74a4fc3 100644 (file)
--- a/compiler/simplStg/StgStats.lhs
+++ b/compiler/simplStg/StgStats.lhs
@@ -21,14 +21,23 @@ The program gather statistics about
 \end{enumerate}
 
 \begin{code}
+{-# 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"
 
 import StgSyn
 
-import FiniteMap       ( emptyFM, plusFM_C, unitFM, fmToList, FiniteMap )
 import Id (Id)
+
+import Data.Map (Map)
+import qualified Data.Map as Map
 \end{code}
 
 \begin{code}
@@ -47,24 +56,24 @@ data CounterType
   deriving (Eq, Ord)
 
 type Count     = Int
-type StatEnv   = FiniteMap CounterType Count
+type StatEnv   = Map CounterType Count
 \end{code}
 
 \begin{code}
 emptySE        :: StatEnv
-emptySE        = emptyFM
+emptySE        = Map.empty
 
 combineSE :: StatEnv -> StatEnv -> StatEnv
-combineSE = plusFM_C (+)
+combineSE = Map.unionWith (+)
 
 combineSEs :: [StatEnv] -> StatEnv
 combineSEs = foldr combineSE emptySE
 
 countOne :: CounterType -> StatEnv
-countOne c = unitFM c 1
+countOne c = Map.singleton c 1
 
 countN :: CounterType -> Int -> StatEnv
-countN = unitFM
+countN = Map.singleton
 \end{code}
 
 %************************************************************************
@@ -78,7 +87,7 @@ showStgStats :: [StgBinding] -> String
 
 showStgStats prog
   = "STG Statistics:\n\n"
-    ++ concat (map showc (fmToList (gatherStgStats prog)))
+    ++ concat (map showc (Map.toList (gatherStgStats prog)))
   where
     showc (x,n) = (showString (s x) . shows n) "\n"
 
@@ -123,10 +132,10 @@ statBinding top (StgRec pairs)
 
 statRhs :: Bool -> (Id, StgRhs) -> StatEnv
 
-statRhs top (b, StgRhsCon cc con args)
+statRhs top (_, StgRhsCon _ _ _)
   = countOne (ConstructorBinds top)
 
-statRhs top (b, StgRhsClosure cc bi fv u _srt args body)
+statRhs top (_, StgRhsClosure _ _ fv u _ _ body)
   = statExpr body                      `combineSE`
     countN FreeVariables (length fv)   `combineSE`
     countOne (
@@ -150,9 +159,10 @@ statExpr (StgApp _ _)        = countOne Applications
 statExpr (StgLit _)      = countOne Literals
 statExpr (StgConApp _ _)  = countOne ConstructorApps
 statExpr (StgOpApp _ _ _) = countOne PrimitiveApps
-statExpr (StgSCC l e)    = statExpr e
+statExpr (StgSCC _ e)     = statExpr e
+statExpr (StgTick _ _ e)  = statExpr e
 
-statExpr (StgLetNoEscape lvs_whole lvs_rhss binds body)
+statExpr (StgLetNoEscape _ _ binds body)
   = statBinding False{-not top-level-} binds   `combineSE`
     statExpr body                              `combineSE`
     countOne LetNoEscapes
@@ -161,7 +171,7 @@ statExpr (StgLet binds body)
   = statBinding False{-not top-level-} binds   `combineSE`
     statExpr body
 
-statExpr (StgCase expr lve lva bndr srt alt_type alts)
+statExpr (StgCase expr _ _ _ _ _ alts)
   = statExpr expr      `combineSE`
     stat_alts alts     `combineSE`
     countOne StgCases