From 11673fb316209c09f81ca9715beb17c0c6191af5 Mon Sep 17 00:00:00 2001
From: sewardj <unknown>
Date: Thu, 12 Oct 2000 08:57:03 +0000
Subject: [PATCH] [project @ 2000-10-12 08:57:03 by sewardj] DynFlag plumbing.

---
 ghc/compiler/coreSyn/CoreUnfold.lhs |    9 +++++----
 ghc/compiler/main/ErrUtils.lhs      |    7 ++++---
 ghc/compiler/prelude/TysWiredIn.lhs |   20 +++++++++++---------
 3 files changed, 20 insertions(+), 16 deletions(-)

diff --git a/ghc/compiler/coreSyn/CoreUnfold.lhs b/ghc/compiler/coreSyn/CoreUnfold.lhs
index 42db228..4ea9fb5 100644
--- 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
--- 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
--- 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
-- 
1.7.10.4