X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FstgSyn%2FStgSyn.lhs;h=3bce28148a38f4153d647b4a3fe5734070b0d243;hp=6c38ecd3ab8f69efaa39d9e94f05fad55f6e58f5;hb=16b9e80dc14db24509f051f294b5b51943285090;hpb=60989a6fc0067600c90217bd673b60bf6448c076 diff --git a/compiler/stgSyn/StgSyn.lhs b/compiler/stgSyn/StgSyn.lhs index 6c38ecd..3bce281 100644 --- a/compiler/stgSyn/StgSyn.lhs +++ b/compiler/stgSyn/StgSyn.lhs @@ -44,18 +44,18 @@ module StgSyn ( #endif ) where +#include "HsVersions.h" + import CostCentre ( CostCentreStack, CostCentre ) import VarSet ( IdSet, isEmptyVarSet ) -import Var ( isId ) -import Id ( Id, idName, idType, idCafInfo ) +import Id +import DataCon import IdInfo ( mayHaveCafRefs ) -import Packages ( isDllName ) import Literal ( Literal, literalType ) import ForeignCall ( ForeignCall ) -import DataCon ( DataCon, dataConName ) import CoreSyn ( AltCon ) import PprCore ( {- instances -} ) -import PrimOp ( PrimOp ) +import PrimOp ( PrimOp, PrimCall ) import Outputable import Type ( Type ) import TyCon ( TyCon ) @@ -65,6 +65,11 @@ import Bitmap import StaticFlags ( opt_SccProfilingOn ) import Module import FastString + +#if mingw32_TARGET_OS +import Packages ( isDllName ) + +#endif \end{code} %************************************************************************ @@ -104,17 +109,20 @@ isStgTypeArg :: StgArg -> Bool isStgTypeArg (StgTypeArg _) = True isStgTypeArg _ = False -isDllArg :: PackageId -> StgArg -> Bool - -- Does this argument refer to something in a different DLL? -isDllArg this_pkg (StgVarArg v) = isDllName this_pkg (idName v) -isDllArg _ _ = False - isDllConApp :: PackageId -> DataCon -> [StgArg] -> Bool - -- Does this constructor application refer to - -- anything in a different DLL? - -- If so, we can't allocate it statically +-- Does this constructor application refer to +-- anything in a different *Windows* DLL? +-- If so, we can't allocate it statically +#if mingw32_TARGET_OS isDllConApp this_pkg con args - = isDllName this_pkg (dataConName con) || any (isDllArg this_pkg) args + = isDllName this_pkg (dataConName con) || any is_dll_arg args + where + is_dll_arg ::StgArg -> Bool + is_dll_arg (StgVarArg v) = isDllName this_pkg (idName v) + is_dll_arg _ = False +#else +isDllConApp _ _ _ = False +#endif stgArgType :: StgArg -> Type -- Very half baked becase we have lost the type arguments @@ -556,6 +564,8 @@ in StgOpApp and COpStmt. \begin{code} data StgOp = StgPrimOp PrimOp + | StgPrimCallOp PrimCall + | StgFCallOp ForeignCall Unique -- The Unique is occasionally needed by the C pretty-printer -- (which lacks a unique supply), notably when generating a @@ -764,6 +774,7 @@ pprStgAlt (con, params, _use_mask, expr) pprStgOp :: StgOp -> SDoc pprStgOp (StgPrimOp op) = ppr op +pprStgOp (StgPrimCallOp op)= ppr op pprStgOp (StgFCallOp op _) = ppr op instance Outputable AltType where