X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FstgSyn%2FStgSyn.lhs;h=9c1c5466c2a48bd789e4e6dddbe1c5dc3592edd1;hb=b783b8644d142d12c832e261ba60bc81c19c3a12;hp=40fbef753a756e2c6dd718a4bb06f643c3fde0f5;hpb=bf64f2050e84ea4afffe8af993a271a1e8dd5cab;p=ghc-hetmet.git

diff --git a/ghc/compiler/stgSyn/StgSyn.lhs b/ghc/compiler/stgSyn/StgSyn.lhs
index 40fbef7..9c1c546 100644
--- 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 Packages		( isDllName )
+import Literal		( Literal, literalType )
 import ForeignCall	( ForeignCall )
 import DataCon		( DataCon, dataConName )
 import CoreSyn		( AltCon )
@@ -65,7 +65,7 @@ import TyCon            ( TyCon )
 import UniqSet		( isEmptyUniqSet, uniqSetToList, UniqSet )
 import Unique		( Unique )
 import Bitmap
-import CmdLineOpts	( opt_SccProfilingOn )
+import CmdLineOpts	( DynFlags, opt_SccProfilingOn )
 \end{code}
 
 %************************************************************************
@@ -104,17 +104,18 @@ data GenStgArg occ
 isStgTypeArg (StgTypeArg _) = True
 isStgTypeArg other	    = False
 
-isDllArg :: StgArg -> Bool
+isDllArg :: DynFlags -> StgArg -> Bool
 	-- Does this argument refer to something in a different DLL?
-isDllArg (StgTypeArg v)  = False
-isDllArg (StgVarArg v)   = isDllName (idName v)
-isDllArg (StgLitArg lit) = False
+isDllArg dflags (StgTypeArg v)  = False
+isDllArg dflags (StgVarArg v)   = isDllName dflags (idName v)
+isDllArg dflags (StgLitArg lit) = False
 
-isDllConApp :: DataCon -> [StgArg] -> Bool
+isDllConApp :: DynFlags -> DataCon -> [StgArg] -> Bool
 	-- Does this constructor application refer to 
 	-- anything in a different DLL?
 	-- If so, we can't allocate it statically
-isDllConApp con args = isDllName (dataConName con) || any isDllArg args
+isDllConApp dflags con args
+   = isDllName dflags (dataConName con) || any (isDllArg dflags) args
 
 stgArgType :: StgArg -> Type
 	-- Very half baked becase we have lost the type arguments
@@ -396,6 +397,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)