Remove a little more CPP

7 files changed, 37 insertions, 44 deletions

diff --git a/compiler/codeGen/CgCon.lhs b/compiler/codeGen/CgCon.lhs
index b50ba8d779..26489e5945 100644
--- a/compiler/codeGen/CgCon.lhs
+++ b/compiler/codeGen/CgCon.lhs
@@ -69,11 +69,9 @@ cgTopRhsCon :: Id               -- Name of thing bound to this RHS
             -> FCode (Id, CgIdInfo)
 cgTopRhsCon id con args
   = do { dflags <- getDynFlags
-        ; when (platformOS (targetPlatform dflags) == OSMinGW32) $ do {
+        ; when (platformOS (targetPlatform dflags) == OSMinGW32) $
               -- Windows DLLs have a problem with static cross-DLL refs.
-            ; this_pkg <- getThisPackage
-            ; ASSERT( not (isDllConApp this_pkg con args) ) return ()
-            }
+              ASSERT( not (isDllConApp dflags con args) ) return ()
         ; ASSERT( args `lengthIs` dataConRepArity con ) return ()
 
         -- LAY IT OUT
diff --git a/compiler/codeGen/StgCmmCon.hs b/compiler/codeGen/StgCmmCon.hs
index 28c99b98a7..a357db4d05 100644
--- a/compiler/codeGen/StgCmmCon.hs
+++ b/compiler/codeGen/StgCmmCon.hs
@@ -59,11 +59,9 @@ cgTopRhsCon :: Id               -- Name of thing bound to this RHS
 cgTopRhsCon id con args
   = do {
           dflags <- getDynFlags
-        ; when (platformOS (targetPlatform dflags) == OSMinGW32) $ do {
+        ; when (platformOS (targetPlatform dflags) == OSMinGW32) $
               -- Windows DLLs have a problem with static cross-DLL refs.
-                this_pkg <- getThisPackage
-              ; ASSERT( not (isDllConApp this_pkg con args) ) return ()
-              }
+              ASSERT( not (isDllConApp dflags con args) ) return ()
         ; ASSERT( args `lengthIs` dataConRepArity con ) return ()
 
         -- LAY IT OUT
diff --git a/compiler/main/HscMain.lhs b/compiler/main/HscMain.lhs
index 8529bffa7a..48cca7bc1f 100644
--- a/compiler/main/HscMain.lhs
+++ b/compiler/main/HscMain.lhs
@@ -1219,7 +1219,7 @@ myCoreToStg :: DynFlags -> Module -> CoreProgram
 myCoreToStg dflags this_mod prepd_binds
  = do 
       stg_binds <- {-# SCC "Core2Stg" #-}
-	     coreToStg (thisPackage dflags) prepd_binds
+	     coreToStg dflags prepd_binds
 
       (stg_binds2, cost_centre_info) <- {-# SCC "Stg2Stg" #-}
 	     stg2stg dflags this_mod stg_binds
diff --git a/compiler/profiling/SCCfinal.lhs b/compiler/profiling/SCCfinal.lhs
index 8c3b62574d..f09b291db7 100644
--- a/compiler/profiling/SCCfinal.lhs
+++ b/compiler/profiling/SCCfinal.lhs
@@ -45,13 +45,12 @@ import DynFlags
 \begin{code}
 stgMassageForProfiling
         :: DynFlags
-        -> PackageId
         -> Module                       -- module name
         -> UniqSupply                   -- unique supply
         -> [StgBinding]                 -- input
         -> (CollectedCCs, [StgBinding])
 
-stgMassageForProfiling dflags this_pkg mod_name us stg_binds
+stgMassageForProfiling dflags mod_name us stg_binds
   = let
         ((local_ccs, extern_ccs, cc_stacks),
          stg_binds2)
@@ -100,7 +99,7 @@ stgMassageForProfiling dflags this_pkg mod_name us stg_binds
     do_top_rhs :: Id -> StgRhs -> MassageM StgRhs
 
     do_top_rhs _ (StgRhsClosure _ _ _ _ _ [] (StgSCC cc (StgConApp con args)))
-      | not (isSccCountCostCentre cc) && not (isDllConApp this_pkg con args)
+      | not (isSccCountCostCentre cc) && not (isDllConApp dflags con args)
         -- Trivial _scc_ around nothing but static data
         -- Eliminate _scc_ ... and turn into StgRhsCon
 
diff --git a/compiler/simplStg/SimplStg.lhs b/compiler/simplStg/SimplStg.lhs
index 4c240e2135..c1faf8047b 100644
--- a/compiler/simplStg/SimplStg.lhs
+++ b/compiler/simplStg/SimplStg.lhs
@@ -72,8 +72,7 @@ stg2stg dflags module_name binds
 	     {-# SCC "ProfMassage" #-}
 	     let
 		 (collected_CCs, binds3)
-		   = stgMassageForProfiling dflags this_pkg module_name us1 binds
-		 this_pkg = thisPackage dflags
+		   = stgMassageForProfiling dflags module_name us1 binds
 	     in
 	     end_pass us2 "ProfMassage" collected_CCs binds3
 
diff --git a/compiler/stgSyn/CoreToStg.lhs b/compiler/stgSyn/CoreToStg.lhs
index 1705f0e60e..e837b8a1eb 100644
--- a/compiler/stgSyn/CoreToStg.lhs
+++ b/compiler/stgSyn/CoreToStg.lhs
@@ -30,11 +30,11 @@ import Name             ( getOccName, isExternalName, nameOccName )
 import OccName          ( occNameString, occNameFS )
 import BasicTypes       ( Arity )
 import Literal
-import Module
 import Outputable
 import MonadUtils
 import FastString
 import Util
+import DynFlags
 import ForeignCall
 import PrimOp           ( PrimCall(..) )
 \end{code}
@@ -140,10 +140,10 @@ for x, solely to put in the SRTs lower down.
 %************************************************************************
 
 \begin{code}
-coreToStg :: PackageId -> CoreProgram -> IO [StgBinding]
-coreToStg this_pkg pgm
+coreToStg :: DynFlags -> CoreProgram -> IO [StgBinding]
+coreToStg dflags pgm
   = return pgm'
-  where (_, _, pgm') = coreTopBindsToStg this_pkg emptyVarEnv pgm
+  where (_, _, pgm') = coreTopBindsToStg dflags emptyVarEnv pgm
 
 coreExprToStg :: CoreExpr -> StgExpr
 coreExprToStg expr
@@ -151,36 +151,36 @@ coreExprToStg expr
 
 
 coreTopBindsToStg
-    :: PackageId
+    :: DynFlags
     -> IdEnv HowBound           -- environment for the bindings
     -> CoreProgram
     -> (IdEnv HowBound, FreeVarsInfo, [StgBinding])
 
 coreTopBindsToStg _        env [] = (env, emptyFVInfo, [])
-coreTopBindsToStg this_pkg env (b:bs)
+coreTopBindsToStg dflags env (b:bs)
   = (env2, fvs2, b':bs')
   where
         -- Notice the mutually-recursive "knot" here:
         --   env accumulates down the list of binds,
         --   fvs accumulates upwards
-        (env1, fvs2, b' ) = coreTopBindToStg this_pkg env fvs1 b
-        (env2, fvs1, bs') = coreTopBindsToStg this_pkg env1 bs
+        (env1, fvs2, b' ) = coreTopBindToStg dflags env fvs1 b
+        (env2, fvs1, bs') = coreTopBindsToStg dflags env1 bs
 
 coreTopBindToStg
-        :: PackageId
+        :: DynFlags
         -> IdEnv HowBound
         -> FreeVarsInfo         -- Info about the body
         -> CoreBind
         -> (IdEnv HowBound, FreeVarsInfo, StgBinding)
 
-coreTopBindToStg this_pkg env body_fvs (NonRec id rhs)
+coreTopBindToStg dflags env body_fvs (NonRec id rhs)
   = let
         env'      = extendVarEnv env id how_bound
         how_bound = LetBound TopLet $! manifestArity rhs
 
         (stg_rhs, fvs') =
             initLne env $ do
-              (stg_rhs, fvs') <- coreToTopStgRhs this_pkg body_fvs (id,rhs)
+              (stg_rhs, fvs') <- coreToTopStgRhs dflags body_fvs (id,rhs)
               return (stg_rhs, fvs')
 
         bind = StgNonRec id stg_rhs
@@ -192,7 +192,7 @@ coreTopBindToStg this_pkg env body_fvs (NonRec id rhs)
       --     assertion again!
     (env', fvs' `unionFVInfo` body_fvs, bind)
 
-coreTopBindToStg this_pkg env body_fvs (Rec pairs)
+coreTopBindToStg dflags env body_fvs (Rec pairs)
   = ASSERT( not (null pairs) )
     let
         binders = map fst pairs
@@ -203,7 +203,7 @@ coreTopBindToStg this_pkg env body_fvs (Rec pairs)
 
         (stg_rhss, fvs')
           = initLne env' $ do
-               (stg_rhss, fvss') <- mapAndUnzipM (coreToTopStgRhs this_pkg body_fvs) pairs
+               (stg_rhss, fvss') <- mapAndUnzipM (coreToTopStgRhs dflags body_fvs) pairs
                let fvs' = unionFVInfos fvss'
                return (stg_rhss, fvs')
 
@@ -231,16 +231,16 @@ consistentCafInfo id bind
 
 \begin{code}
 coreToTopStgRhs
-        :: PackageId
+        :: DynFlags
         -> FreeVarsInfo         -- Free var info for the scope of the binding
         -> (Id,CoreExpr)
         -> LneM (StgRhs, FreeVarsInfo)
 
-coreToTopStgRhs this_pkg scope_fv_info (bndr, rhs)
+coreToTopStgRhs dflags scope_fv_info (bndr, rhs)
   = do { (new_rhs, rhs_fvs, _) <- coreToStgExpr rhs
        ; lv_info <- freeVarsToLiveVars rhs_fvs
 
-       ; let stg_rhs   = mkTopStgRhs this_pkg rhs_fvs (mkSRT lv_info) bndr_info new_rhs
+       ; let stg_rhs   = mkTopStgRhs dflags rhs_fvs (mkSRT lv_info) bndr_info new_rhs
              stg_arity = stgRhsArity stg_rhs
        ; return (ASSERT2( arity_ok stg_arity, mk_arity_msg stg_arity) stg_rhs,
                  rhs_fvs) }
@@ -266,7 +266,7 @@ coreToTopStgRhs this_pkg scope_fv_info (bndr, rhs)
                 ptext (sLit "Id arity:") <+> ppr id_arity,
                 ptext (sLit "STG arity:") <+> ppr stg_arity]
 
-mkTopStgRhs :: PackageId -> FreeVarsInfo
+mkTopStgRhs :: DynFlags -> FreeVarsInfo
             -> SRT -> StgBinderInfo -> StgExpr
             -> StgRhs
 
@@ -277,8 +277,8 @@ mkTopStgRhs _ rhs_fvs srt binder_info (StgLam _ bndrs body)
                   srt
                   bndrs body
 
-mkTopStgRhs this_pkg _ _ _ (StgConApp con args)
-  | not (isDllConApp this_pkg con args)  -- Dynamic StgConApps are updatable
+mkTopStgRhs dflags _ _ _ (StgConApp con args)
+  | not (isDllConApp dflags con args)  -- Dynamic StgConApps are updatable
   = StgRhsCon noCCS con args
 
 mkTopStgRhs _ rhs_fvs srt binder_info rhs
diff --git a/compiler/stgSyn/StgSyn.lhs b/compiler/stgSyn/StgSyn.lhs
index dd026eb80c..a162b79fda 100644
--- a/compiler/stgSyn/StgSyn.lhs
+++ b/compiler/stgSyn/StgSyn.lhs
@@ -62,15 +62,15 @@ import TyCon            ( TyCon )
 import UniqSet
 import Unique		( Unique )
 import Bitmap
+import DynFlags
+import Platform
 import StaticFlags	( opt_SccProfilingOn )
 import Module
 import FastString
 
-#if mingw32_TARGET_OS
 import Packages		( isDllName )
 import Type		( typePrimRep )
 import TyCon		( PrimRep(..) )
-#endif
 \end{code}
 
 %************************************************************************
@@ -110,19 +110,22 @@ isStgTypeArg :: StgArg -> Bool
 isStgTypeArg (StgTypeArg _) = True
 isStgTypeArg _              = False
 
-isDllConApp :: PackageId -> DataCon -> [StgArg] -> Bool
+isDllConApp :: DynFlags -> DataCon -> [StgArg] -> Bool
 -- 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 is_dll_arg args
+isDllConApp dflags con args
+ | platformOS (targetPlatform dflags) == OSMinGW32
+    = isDllName this_pkg (dataConName con) || any is_dll_arg args
+ | otherwise = False
   where
-    is_dll_arg ::StgArg -> Bool
+    is_dll_arg :: StgArg -> Bool
     is_dll_arg (StgVarArg v) =  isAddrRep (typePrimRep (idType v))
                              && isDllName this_pkg (idName v)
     is_dll_arg _             = False
 
+    this_pkg = thisPackage dflags
+
 isAddrRep :: PrimRep -> Bool
 -- True of machine adddresses; these are the things that don't
 -- work across DLLs.
@@ -140,10 +143,6 @@ 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
 stgArgType (StgVarArg v)   = idType v