X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FstgSyn%2FStgSyn.lhs;h=9c1c5466c2a48bd789e4e6dddbe1c5dc3592edd1;hb=ef5b4b146aa172d8ac10f39b5eb3d7a0f948d8f1;hp=b9f36716e9a0a27b65d8f590e3d0c4b068c42905;hpb=3f5e4368fd4e87e116ce34be4cf9dd0f9f96726d;p=ghc-hetmet.git diff --git a/ghc/compiler/stgSyn/StgSyn.lhs b/ghc/compiler/stgSyn/StgSyn.lhs index b9f3671..9c1c546 100644 --- a/ghc/compiler/stgSyn/StgSyn.lhs +++ b/ghc/compiler/stgSyn/StgSyn.lhs @@ -30,12 +30,12 @@ module StgSyn ( StgOp(..), -- SRTs - SRT(..), noSRT, nonEmptySRT, + SRT(..), -- utils - stgBindHasCafRefs, stgArgHasCafRefs, stgRhsArity, getArgPrimRep, - isLitLitArg, isDllConApp, isStgTypeArg, - stgArgType, stgBinders, + stgBindHasCafRefs, stgArgHasCafRefs, stgRhsArity, + isDllConApp, isStgTypeArg, + stgArgType, pprStgBinding, pprStgBindings, pprStgBindingsWithSRTs @@ -49,13 +49,14 @@ 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, isLitLitLit, literalPrimRep ) +import Packages ( isDllName ) +import Literal ( Literal, literalType ) import ForeignCall ( ForeignCall ) import DataCon ( DataCon, dataConName ) import CoreSyn ( AltCon ) +import PprCore ( {- instances -} ) import PrimOp ( PrimOp ) import Outputable import Util ( count ) @@ -64,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} %************************************************************************ @@ -84,10 +85,6 @@ There is one SRT for each group of bindings. data GenStgBinding bndr occ = StgNonRec bndr (GenStgRhs bndr occ) | StgRec [(bndr, GenStgRhs bndr occ)] - -stgBinders :: GenStgBinding bndr occ -> [bndr] -stgBinders (StgNonRec b _) = [b] -stgBinders (StgRec bs) = map fst bs \end{code} %************************************************************************ @@ -104,26 +101,21 @@ data GenStgArg occ \end{code} \begin{code} -getArgPrimRep (StgVarArg local) = idPrimRep local -getArgPrimRep (StgLitArg lit) = literalPrimRep lit - -isLitLitArg (StgLitArg lit) = isLitLitLit lit -isLitLitArg _ = False - 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) = isLitLitLit lit +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