[project @ 2000-10-12 08:57:03 by sewardj]

DynFlag plumbing.

diff --git a/ghc/compiler/coreSyn/CoreUnfold.lhs b/ghc/compiler/coreSyn/CoreUnfold.lhs
index 42db228..4ea9fb5 100644 (file)
--- a/ghc/compiler/coreSyn/CoreUnfold.lhs
+++ b/ghc/compiler/coreSyn/CoreUnfold.lhs
@@ -37,7 +37,7 @@ import CmdLineOpts    ( opt_UF_CreationThreshold,
                          opt_UF_KeenessFactor,
                          opt_UF_CheapOp, opt_UF_DearOp,
                          opt_UnfoldCasms, opt_PprStyle_Debug,
-                         opt_D_dump_inlinings
+                         DynFlags, dopt_D_dump_inlinings
                        )
 import CoreSyn
 import PprCore         ( pprCoreExpr )
@@ -509,7 +509,8 @@ them inlining is to give them a NOINLINE pragma, which we do in
 StrictAnal.addStrictnessInfoToTopId
 
 \begin{code}
-callSiteInline :: Bool                 -- True <=> the Id is black listed
+callSiteInline :: DynFlags
+              -> Bool                  -- True <=> the Id is black listed
               -> Bool                  -- 'inline' note at call site
               -> OccInfo
               -> Id                    -- The Id
@@ -518,7 +519,7 @@ callSiteInline :: Bool                      -- True <=> the Id is black listed
               -> Maybe CoreExpr        -- Unfolding, if any
 
 
-callSiteInline black_listed inline_call occ id arg_infos interesting_cont
+callSiteInline dflags black_listed inline_call occ id arg_infos interesting_cont
   = case idUnfolding id of {
        NoUnfolding -> Nothing ;
        OtherCon cs -> Nothing ;
@@ -612,7 +613,7 @@ callSiteInline black_listed inline_call occ id arg_infos interesting_cont
                
     in    
 #ifdef DEBUG
-    if opt_D_dump_inlinings then
+    if dopt_D_dump_inlinings dflags then
        pprTrace "Considering inlining"
                 (ppr id <+> vcat [text "black listed:" <+> ppr black_listed,
                                   text "occ info:" <+> ppr occ,

diff --git a/ghc/compiler/main/ErrUtils.lhs b/ghc/compiler/main/ErrUtils.lhs
index f67bedc..d6a64f3 100644 (file)
--- a/ghc/compiler/main/ErrUtils.lhs
+++ b/ghc/compiler/main/ErrUtils.lhs
@@ -20,6 +20,7 @@ import Bag            ( Bag, bagToList, isEmptyBag )
 import SrcLoc          ( SrcLoc, noSrcLoc )
 import Util            ( sortLt )
 import Outputable
+import CmdLineOpts     ( DynFlags )
 
 import System          ( ExitCode(..), exitWith )
 import IO              ( hPutStr, stderr )
@@ -99,9 +100,9 @@ doIfSet flag action | flag      = action
 
 \begin{code}
 dumpIfSet :: DynFlags -> (DynFlags -> Bool) -> String -> SDoc -> IO ()
-dumpIfSet flag hdr doc
-  | not flag  = return ()
-  | otherwise = printDump dump
+dumpIfSet dflags flag hdr doc
+  | not (flag dflags)  = return ()
+  | otherwise          = printDump dump
   where
     dump = vcat [text "", 
                 line <+> text hdr <+> line,

diff --git a/ghc/compiler/prelude/TysWiredIn.lhs b/ghc/compiler/prelude/TysWiredIn.lhs
index 2db5050..91c068d 100644 (file)
--- a/ghc/compiler/prelude/TysWiredIn.lhs
+++ b/ghc/compiler/prelude/TysWiredIn.lhs
@@ -111,7 +111,7 @@ import Type         ( Type, mkTyConTy, mkTyConApp, mkSigmaTy, mkTyVarTys,
                          TauType, ClassContext )
 import Unique          ( incrUnique, mkTupleTyConUnique, mkTupleDataConUnique )
 import PrelNames
-import CmdLineOpts      ( opt_GlasgowExts )
+import CmdLineOpts      ( DynFlags, dopt_GlasgowExts )
 import Array
 import Maybe           ( fromJust )
 import FiniteMap       ( lookupFM )
@@ -416,9 +416,10 @@ restricted set of types as arguments and results (the restricting factor
 being the )
 
 \begin{code}
-isFFIArgumentTy :: Bool -> Type -> Bool
+isFFIArgumentTy :: DynFlags -> Bool -> Type -> Bool
 -- Checks for valid argument type for a 'foreign import'
-isFFIArgumentTy is_safe ty = checkRepTyCon (legalOutgoingTyCon is_safe) ty
+isFFIArgumentTy dflags is_safe ty 
+   = checkRepTyCon (legalOutgoingTyCon dflags is_safe) ty
 
 isFFIExternalTy :: Type -> Bool
 -- Types that are allowed as arguments of a 'foreign export'
@@ -469,25 +470,26 @@ legalIncomingTyCon :: TyCon -> Bool
 -- bytearrays from a _ccall_ / foreign declaration
 -- (or be passed them as arguments in foreign exported functions).
 legalIncomingTyCon tc
-  | getUnique tc `elem` [ foreignObjTyConKey, byteArrayTyConKey, mutableByteArrayTyConKey ] 
+  | getUnique tc `elem` [ foreignObjTyConKey, byteArrayTyConKey, 
+                                              mutableByteArrayTyConKey ] 
   = False
   -- It's also illegal to make foreign exports that take unboxed
   -- arguments.  The RTS API currently can't invoke such things.  --SDM 7/2000
   | otherwise
   = boxedMarshalableTyCon tc
 
-legalOutgoingTyCon :: Bool -> TyCon -> Bool
+legalOutgoingTyCon :: DynFlags -> Bool -> TyCon -> Bool
 -- Checks validity of types going from Haskell -> external world
 -- The boolean is true for a 'safe' call (when we don't want to
 -- pass Haskell pointers to the world)
-legalOutgoingTyCon be_safe tc
+legalOutgoingTyCon dflags be_safe tc
   | be_safe && getUnique tc `elem` [byteArrayTyConKey, mutableByteArrayTyConKey]
   = False
   | otherwise
-  = marshalableTyCon tc
+  = marshalableTyCon dflags tc
 
-marshalableTyCon tc
-  =  (opt_GlasgowExts && isUnLiftedTyCon tc)
+marshalableTyCon dflags tc
+  =  (dopt_GlasgowExts dflags && isUnLiftedTyCon tc)
   || boxedMarshalableTyCon tc
 
 boxedMarshalableTyCon tc