Commit e37c0541 authored by Ian Lynagh's avatar Ian Lynagh

Fix warnings in StgStats

parent fc1aac6c
......@@ -21,20 +21,6 @@ The program gather statistics about
\end{enumerate}
\begin{code}
{-# OPTIONS -fno-warn-tabs #-}
-- The above warning supression flag is a temporary kludge.
-- While working on this module you are encouraged to remove it and
-- detab the module (please do the detabbing in a separate patch). See
-- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
-- for details
{-# 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"
......@@ -42,6 +28,7 @@ module StgStats ( showStgStats ) where
import StgSyn
import Id (Id)
import Panic
import Data.Map (Map)
import qualified Data.Map as Map
......@@ -62,13 +49,13 @@ data CounterType
| UpdatableBinds Bool{-ditto-}
deriving (Eq, Ord)
type Count = Int
type StatEnv = Map CounterType Count
type Count = Int
type StatEnv = Map CounterType Count
\end{code}
\begin{code}
emptySE :: StatEnv
emptySE = Map.empty
emptySE :: StatEnv
emptySE = Map.empty
combineSE :: StatEnv -> StatEnv -> StatEnv
combineSE = Map.unionWith (+)
......@@ -84,9 +71,9 @@ countN = Map.singleton
\end{code}
%************************************************************************
%* *
%* *
\subsection{Top-level list of bindings (a ``program'')}
%* *
%* *
%************************************************************************
\begin{code}
......@@ -98,13 +85,13 @@ showStgStats prog
where
showc (x,n) = (showString (s x) . shows n) "\n"
s Literals = "Literals "
s Applications = "Applications "
s ConstructorApps = "ConstructorApps "
s PrimitiveApps = "PrimitiveApps "
s LetNoEscapes = "LetNoEscapes "
s StgCases = "StgCases "
s FreeVariables = "FreeVariables "
s Literals = "Literals "
s Applications = "Applications "
s ConstructorApps = "ConstructorApps "
s PrimitiveApps = "PrimitiveApps "
s LetNoEscapes = "LetNoEscapes "
s StgCases = "StgCases "
s FreeVariables = "FreeVariables "
s (ConstructorBinds True) = "ConstructorBinds_Top "
s (ReEntrantBinds True) = "ReEntrantBinds_Top "
s (SingleEntryBinds True) = "SingleEntryBinds_Top "
......@@ -121,15 +108,15 @@ gatherStgStats binds
\end{code}
%************************************************************************
%* *
%* *
\subsection{Bindings}
%* *
%* *
%************************************************************************
\begin{code}
statBinding :: Bool -- True <=> top-level; False <=> nested
-> StgBinding
-> StatEnv
-> StgBinding
-> StatEnv
statBinding top (StgNonRec b rhs)
= statRhs top (b, rhs)
......@@ -143,47 +130,49 @@ statRhs top (_, StgRhsCon _ _ _)
= countOne (ConstructorBinds top)
statRhs top (_, StgRhsClosure _ _ fv u _ _ body)
= statExpr body `combineSE`
countN FreeVariables (length fv) `combineSE`
= statExpr body `combineSE`
countN FreeVariables (length fv) `combineSE`
countOne (
case u of
ReEntrant -> ReEntrantBinds top
Updatable -> UpdatableBinds top
SingleEntry -> SingleEntryBinds top
ReEntrant -> ReEntrantBinds top
Updatable -> UpdatableBinds top
SingleEntry -> SingleEntryBinds top
)
\end{code}
%************************************************************************
%* *
%* *
\subsection{Expressions}
%* *
%* *
%************************************************************************
\begin{code}
statExpr :: StgExpr -> StatEnv
statExpr (StgApp _ _) = countOne Applications
statExpr (StgLit _) = countOne Literals
statExpr (StgApp _ _) = countOne Applications
statExpr (StgLit _) = countOne Literals
statExpr (StgConApp _ _) = countOne ConstructorApps
statExpr (StgOpApp _ _ _) = countOne PrimitiveApps
statExpr (StgSCC _ _ _ e) = statExpr e
statExpr (StgTick _ _ e) = statExpr e
statExpr (StgLetNoEscape _ _ binds body)
= statBinding False{-not top-level-} binds `combineSE`
statExpr body `combineSE`
= statBinding False{-not top-level-} binds `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 _ _ _ _ _ alts)
= statExpr expr `combineSE`
stat_alts alts `combineSE`
= statExpr expr `combineSE`
stat_alts alts `combineSE`
countOne StgCases
where
stat_alts alts
= combineSEs (map statExpr [ e | (_,_,_,e) <- alts ])
= combineSEs (map statExpr [ e | (_,_,_,e) <- alts ])
statExpr (StgLam {}) = panic "statExpr StgLam"
\end{code}
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment