[project @ 2003-12-30 16:29:17 by simonpj]

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

diff --git a/ghc/compiler/stgSyn/StgSyn.lhs b/ghc/compiler/stgSyn/StgSyn.lhs
index 40fbef7..a6f1868 100644 (file)
--- a/ghc/compiler/stgSyn/StgSyn.lhs
+++ b/ghc/compiler/stgSyn/StgSyn.lhs
@@ -33,7 +33,7 @@ module StgSyn (
        SRT(..),
 
        -- utils
-       stgArgHasCafRefs,
+       stgBindHasCafRefs, stgArgHasCafRefs, stgRhsArity,
        isDllConApp, isStgTypeArg,
        stgArgType,
 
@@ -49,10 +49,10 @@ module StgSyn (
 import CostCentre      ( CostCentreStack, CostCentre )
 import VarSet          ( IdSet, isEmptyVarSet )
 import Var             ( isId )
-import Id              ( Id, idName, idPrimRep, idType, idCafInfo )
+import Id              ( Id, idName, idType, idCafInfo )
 import IdInfo          ( mayHaveCafRefs )
 import Name            ( isDllName )
-import Literal         ( Literal, literalType, literalPrimRep )
+import Literal         ( Literal, literalType )
 import ForeignCall     ( ForeignCall )
 import DataCon         ( DataCon, dataConName )
 import CoreSyn         ( AltCon )
@@ -396,6 +396,19 @@ The second flavour of right-hand-side is for constructors (simple but important)
 \end{code}
 
 \begin{code}
+stgRhsArity :: StgRhs -> Int
+stgRhsArity (StgRhsClosure _ _ _ _ _ bndrs _) = count isId bndrs
+  -- The arity never includes type parameters, so
+  -- when keeping type arguments and binders in the Stg syntax 
+  -- (opt_RuntimeTypes) we have to fliter out the type binders.
+stgRhsArity (StgRhsCon _ _ _) = 0
+\end{code}
+
+\begin{code}
+stgBindHasCafRefs :: GenStgBinding bndr Id -> Bool
+stgBindHasCafRefs (StgNonRec _ rhs) = rhsHasCafRefs rhs
+stgBindHasCafRefs (StgRec binds)    = any rhsHasCafRefs (map snd binds)
+
 rhsHasCafRefs (StgRhsClosure _ _ _ upd srt _ _) 
   = isUpdatable upd || nonEmptySRT srt
 rhsHasCafRefs (StgRhsCon _ _ args)