Fixed warnings in stgSyn/StgSyn

[ghc-hetmet.git] / compiler / stgSyn / StgSyn.lhs

diff --git a/compiler/stgSyn/StgSyn.lhs b/compiler/stgSyn/StgSyn.lhs
index 2749081..893358b 100644 (file)
--- a/compiler/stgSyn/StgSyn.lhs
+++ b/compiler/stgSyn/StgSyn.lhs
@@ -52,7 +52,6 @@ import Var            ( isId )
 import Id              ( Id, idName, idType, idCafInfo )
 import IdInfo          ( mayHaveCafRefs )
 import Packages                ( isDllName )
-import PackageConfig   ( PackageId )
 import Literal         ( Literal, literalType )
 import ForeignCall     ( ForeignCall )
 import DataCon         ( DataCon, dataConName )
@@ -63,11 +62,11 @@ import Outputable
 import Util             ( count )
 import Type             ( Type )
 import TyCon            ( TyCon )
-import UniqSet         ( isEmptyUniqSet, uniqSetToList, UniqSet )
+import UniqSet
 import Unique          ( Unique )
 import Bitmap
 import StaticFlags     ( opt_SccProfilingOn )
-import Module          ( Module, pprModule )
+import Module
 \end{code}
 
 %************************************************************************
@@ -103,14 +102,14 @@ data GenStgArg occ
 \end{code}
 
 \begin{code}
+isStgTypeArg :: StgArg -> Bool
 isStgTypeArg (StgTypeArg _) = True
-isStgTypeArg other         = False
+isStgTypeArg _              = False
 
 isDllArg :: PackageId -> StgArg -> Bool
        -- Does this argument refer to something in a different DLL?
-isDllArg this_pkg (StgTypeArg v)  = False
-isDllArg this_pkg (StgVarArg v)   = isDllName this_pkg (idName v)
-isDllArg this_pkg (StgLitArg lit) = False
+isDllArg this_pkg (StgVarArg v)  = isDllName this_pkg (idName v)
+isDllArg _        _              = False
 
 isDllConApp :: PackageId -> DataCon -> [StgArg] -> Bool
        -- Does this constructor application refer to 
@@ -123,7 +122,7 @@ stgArgType :: StgArg -> Type
        -- Very half baked becase we have lost the type arguments
 stgArgType (StgVarArg v)   = idType v
 stgArgType (StgLitArg lit) = literalType lit
-stgArgType (StgTypeArg lit) = panic "stgArgType called on stgTypeArg"
+stgArgType (StgTypeArg _)  = panic "stgArgType called on stgTypeArg"
 \end{code}
 
 %************************************************************************
@@ -168,6 +167,8 @@ constructors, primitives, and literals.
 \begin{code}
   | StgLit     Literal
   
+       -- StgConApp is vital for returning unboxed tuples
+       -- which can't be let-bound first
   | StgConApp  DataCon
                [GenStgArg occ] -- Saturated
 
@@ -428,11 +429,13 @@ stgBindHasCafRefs :: GenStgBinding bndr Id -> Bool
 stgBindHasCafRefs (StgNonRec _ rhs) = rhsHasCafRefs rhs
 stgBindHasCafRefs (StgRec binds)    = any rhsHasCafRefs (map snd binds)
 
+rhsHasCafRefs :: GenStgRhs bndr Id -> Bool
 rhsHasCafRefs (StgRhsClosure _ _ _ upd srt _ _) 
   = isUpdatable upd || nonEmptySRT srt
 rhsHasCafRefs (StgRhsCon _ _ args)
   = any stgArgHasCafRefs args
 
+stgArgHasCafRefs :: GenStgArg Id -> Bool
 stgArgHasCafRefs (StgVarArg id) = mayHaveCafRefs (idCafInfo id)
 stgArgHasCafRefs _ = False
 \end{code}
@@ -446,6 +449,7 @@ data StgBinderInfo
                        -- slow entry code for the thing
                        -- Thunks never get this value
 
+noBinderInfo, stgUnsatOcc, stgSatOcc :: StgBinderInfo
 noBinderInfo = NoStgBinderInfo
 stgUnsatOcc  = NoStgBinderInfo
 stgSatOcc    = SatCallsOnly
@@ -456,9 +460,10 @@ satCallsOnly NoStgBinderInfo = False
 
 combineStgBinderInfo :: StgBinderInfo -> StgBinderInfo -> StgBinderInfo
 combineStgBinderInfo SatCallsOnly SatCallsOnly = SatCallsOnly
-combineStgBinderInfo info1 info2              = NoStgBinderInfo
+combineStgBinderInfo _            _            = NoStgBinderInfo
 
 --------------
+pp_binder_info :: StgBinderInfo -> SDoc
 pp_binder_info NoStgBinderInfo = empty
 pp_binder_info SatCallsOnly    = ptext SLIT("sat-only")
 \end{code}
@@ -535,6 +540,7 @@ instance Outputable UpdateFlag where
     ppr u
       = char (case u of { ReEntrant -> 'r';  Updatable -> 'u';  SingleEntry -> 's' })
 
+isUpdatable :: UpdateFlag -> Bool
 isUpdatable ReEntrant   = False
 isUpdatable SingleEntry = False
 isUpdatable Updatable   = True
@@ -580,16 +586,15 @@ data SRT = NoSRT
          | SRT !Int{-offset-} !Int{-length-} !Bitmap{-bitmap-}
                -- generated by computeSRTs
 
-noSRT :: SRT
-noSRT = NoSRT
-
+nonEmptySRT :: SRT -> Bool
 nonEmptySRT NoSRT           = False
 nonEmptySRT (SRTEntries vs) = not (isEmptyVarSet vs)
 nonEmptySRT _               = True
 
-pprSRT (NoSRT) = ptext SLIT("_no_srt_")
+pprSRT :: SRT -> SDoc
+pprSRT (NoSRT)          = ptext SLIT("_no_srt_")
 pprSRT (SRTEntries ids) = text "SRT:" <> ppr ids
-pprSRT (SRT off length bitmap) = parens (ppr off <> comma <> text "*bitmap*")
+pprSRT (SRT off _ _)    = parens (ppr off <> comma <> text "*bitmap*")
 \end{code}
 
 %************************************************************************
@@ -754,10 +759,13 @@ pprStgExpr (StgCase expr lvs_whole lvs_rhss bndr srt alt_type alts)
           nest 2 (vcat (map pprStgAlt alts)),
           char '}']
 
-pprStgAlt (con, params, use_mask, expr)
+pprStgAlt :: (Outputable bndr, Outputable occ, Ord occ)
+          => GenStgAlt bndr occ -> SDoc
+pprStgAlt (con, params, _use_mask, expr)
   = hang (hsep [ppr con, interppSP params, ptext SLIT("->")])
         4 (ppr expr <> semi)
 
+pprStgOp :: StgOp -> SDoc
 pprStgOp (StgPrimOp  op)   = ppr op
 pprStgOp (StgFCallOp op _) = ppr op
 
@@ -769,6 +777,7 @@ instance Outputable AltType where
 \end{code}
 
 \begin{code}
+#ifdef DEBUG
 pprStgLVs :: Outputable occ => GenStgLiveVars occ -> SDoc
 pprStgLVs lvs
   = getPprStyle $ \ sty ->
@@ -776,6 +785,7 @@ pprStgLVs lvs
        empty
     else
        hcat [text "{-lvs:", interpp'SP (uniqSetToList lvs), text "-}"]
+#endif
 \end{code}
 
 \begin{code}
@@ -801,6 +811,7 @@ pprStgRhs (StgRhsCon cc con args)
   = hcat [ ppr cc,
           space, ppr con, ptext SLIT("! "), brackets (interppSP args)]
 
+pprMaybeSRT :: SRT -> SDoc
 pprMaybeSRT (NoSRT) = empty
 pprMaybeSRT srt     = ptext SLIT("srt:") <> pprSRT srt
 \end{code}