X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FstgSyn%2FStgSyn.lhs;h=dd026eb80c9e0c990b588992a3a0a574b5b8ad6a;hp=78f7447fbe431b6da6ce3bbbced526b5e604a3e5;hb=b2bd63f99d643f6b3eb30bb72bb9ae26d4183252;hpb=41e58b51a33d033b1e3eaffce3ce998a308f4b3c

diff --git a/compiler/stgSyn/StgSyn.lhs b/compiler/stgSyn/StgSyn.lhs
index 78f7447..dd026eb 100644
--- a/compiler/stgSyn/StgSyn.lhs
+++ b/compiler/stgSyn/StgSyn.lhs
@@ -48,16 +48,14 @@ module StgSyn (
 
 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 )
@@ -67,6 +65,12 @@ import Bitmap
 import StaticFlags	( opt_SccProfilingOn )
 import Module
 import FastString
+
+#if mingw32_TARGET_OS
+import Packages		( isDllName )
+import Type		( typePrimRep )
+import TyCon		( PrimRep(..) )
+#endif
 \end{code}
 
 %************************************************************************
@@ -106,17 +110,39 @@ 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) =  isAddrRep (typePrimRep (idType v))
+                             && isDllName this_pkg (idName v)
+    is_dll_arg _             = False
+
+isAddrRep :: PrimRep -> Bool
+-- True of machine adddresses; these are the things that don't
+-- work across DLLs.
+-- The key point here is that VoidRep comes out False, so that
+-- a top level nullary GADT construtor is False for isDllConApp
+--    data T a where
+--      T1 :: T Int
+-- gives
+--    T1 :: forall a. (a~Int) -> T a
+-- and hence the top-level binding
+--    $WT1 :: T Int
+--    $WT1 = T1 Int (Coercion (Refl Int))
+-- The coercion argument here gets VoidRep
+isAddrRep AddrRep = True
+isAddrRep PtrRep  = True
+isAddrRep _       = False
+
+#else
+isDllConApp _ _ _ = False
+#endif
 
 stgArgType :: StgArg -> Type
 	-- Very half baked becase we have lost the type arguments
@@ -558,6 +584,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
@@ -766,6 +794,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