From: sewardj Date: Wed, 11 Oct 2000 16:45:53 +0000 (+0000) Subject: [project @ 2000-10-11 16:45:53 by sewardj] X-Git-Tag: Approximately_9120_patches~3630 X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=a237946da277f10bd3d223e5926d118044d24194;p=ghc-hetmet.git [project @ 2000-10-11 16:45:53 by sewardj] Do most of the DynFlags plumbing. Also remove stuff pertaining to search paths since the finder does all that now. --- diff --git a/ghc/compiler/rename/Rename.lhs b/ghc/compiler/rename/Rename.lhs index cc228ae..9d340f2 100644 --- a/ghc/compiler/rename/Rename.lhs +++ b/ghc/compiler/rename/Rename.lhs @@ -15,7 +15,7 @@ import RnHsSyn ( RenamedHsModule, RenamedHsDecl, extractHsTyNames, extractHsCtxtTyNames ) -import CmdLineOpts ( opt_HiMap, opt_D_dump_rn_trace, opt_D_dump_minimal_imports, +import CmdLineOpts ( dopt_D_dump_rn_trace, dopt_D_dump_minimal_imports, opt_D_dump_rn, opt_D_dump_rn_stats, opt_WarnDeprecations, opt_WarnUnusedBinds ) diff --git a/ghc/compiler/rename/RnExpr.lhs b/ghc/compiler/rename/RnExpr.lhs index 992e5c1..0225370 100644 --- a/ghc/compiler/rename/RnExpr.lhs +++ b/ghc/compiler/rename/RnExpr.lhs @@ -26,7 +26,7 @@ import RnHsSyn import RnMonad import RnEnv import RnIfaces ( lookupFixityRn ) -import CmdLineOpts ( opt_GlasgowExts, opt_IgnoreAsserts ) +import CmdLineOpts ( dopt_GlasgowExts, opt_IgnoreAsserts ) import Literal ( inIntRange ) import BasicTypes ( Fixity(..), FixityDirection(..), defaultFixity, negateFixity ) import PrelNames ( hasKey, assertIdKey, @@ -67,14 +67,15 @@ rnPat (VarPatIn name) returnRn (VarPatIn vname, emptyFVs) rnPat (SigPatIn pat ty) - | opt_GlasgowExts - = rnPat pat `thenRn` \ (pat', fvs1) -> - rnHsType doc ty `thenRn` \ (ty', fvs2) -> - returnRn (SigPatIn pat' ty', fvs1 `plusFV` fvs2) - - | otherwise - = addErrRn (patSigErr ty) `thenRn_` - rnPat pat + = doptsRn dopt_GlasgowExts `thenRn` \ opt_GlasgowExts -> + + if opt_GlasgowExts + then rnPat pat `thenRn` \ (pat', fvs1) -> + rnHsType doc ty `thenRn` \ (ty', fvs2) -> + returnRn (SigPatIn pat' ty', fvs1 `plusFV` fvs2) + + else addErrRn (patSigErr ty) `thenRn_` + rnPat pat where doc = text "a pattern type-signature" @@ -183,6 +184,7 @@ rnMatch match@(Match _ pats maybe_rhs_sig grhss) mapFvRn rnPat pats `thenRn` \ (pats', pat_fvs) -> rnGRHSs grhss `thenRn` \ (grhss', grhss_fvs) -> + doptsRn dopt_GlasgowExts `thenRn` \ opt_GlasgowExts -> (case maybe_rhs_sig of Nothing -> returnRn (Nothing, emptyFVs) Just ty | opt_GlasgowExts -> rnHsType doc_sig ty `thenRn` \ (ty', ty_fvs) -> @@ -218,7 +220,8 @@ rnGRHSs (GRHSs grhss binds maybe_ty) returnRn (GRHSs grhss' binds' Nothing, fvGRHSs) rnGRHS (GRHS guarded locn) - = pushSrcLocRn locn $ + = doptsRn dopt_GlasgowExts `thenRn` \ opt_GlasgowExts -> + pushSrcLocRn locn $ (if not (opt_GlasgowExts || is_standard_guard guarded) then addWarnRn (nonStdGuardErr guarded) else diff --git a/ghc/compiler/rename/RnIfaces.lhs b/ghc/compiler/rename/RnIfaces.lhs index bb13311..08e7fb9 100644 --- a/ghc/compiler/rename/RnIfaces.lhs +++ b/ghc/compiler/rename/RnIfaces.lhs @@ -1120,10 +1120,12 @@ findAndReadIface doc_str mod_name hi_boot_file -- one for 'normal' ones, the other for .hi-boot files, -- hence the need to signal which kind we're interested. - getHiMaps `thenRn` \ (search_path, hi_map, hiboot_map) -> + --getHiMaps `thenRn` \ (search_path, hi_map, hiboot_map) -> let - relevant_map | hi_boot_file = hiboot_map - | otherwise = hi_map + bomb = panic "findAndReadInterface: hi_maps: FIXME" + search_path = panic "findAndReadInterface: search_path: FIXME" + relevant_map | hi_boot_file = bomb --hiboot_map + | otherwise = bomb --hi_map in case lookupFM relevant_map mod_name of -- Found the file diff --git a/ghc/compiler/rename/RnMonad.lhs b/ghc/compiler/rename/RnMonad.lhs index f266b24..f5d4641 100644 --- a/ghc/compiler/rename/RnMonad.lhs +++ b/ghc/compiler/rename/RnMonad.lhs @@ -48,11 +48,9 @@ import Name ( Name, OccName, NamedThing(..), getSrcLoc, decode, mkLocalName, mkUnboundName, mkKnownKeyGlobal, NameEnv, lookupNameEnv, emptyNameEnv, unitNameEnv, extendNameEnvList ) -import Module ( Module, ModuleName, ModuleHiMap, SearchPath, WhereFrom, - mkModuleHiMaps, moduleName, mkSearchPath - ) +import Module ( Module, ModuleName, WhereFrom, moduleName ) import NameSet -import CmdLineOpts ( opt_D_dump_rn_trace, opt_HiMap ) +import CmdLineOpts ( DynFlags, dopt_D_dump_rn_trace ) import PrelInfo ( wiredInNames, knownKeyRdrNames ) import SrcLoc ( SrcLoc, mkGeneratedSrcLoc ) import Unique ( Unique ) @@ -60,6 +58,7 @@ import FiniteMap ( FiniteMap, emptyFM, listToFM, plusFM ) import Bag ( Bag, mapBag, emptyBag, isEmptyBag, snocBag ) import UniqSupply import Outputable +import CmFind ( Finder ) infixr 9 `thenRn`, `thenRn_` \end{code} @@ -78,8 +77,9 @@ ioToRnM io rn_down g_down = (io >>= \ ok -> return (Right ok)) (\ err -> return (Left err)) traceRn :: SDoc -> RnM d () -traceRn msg | opt_D_dump_rn_trace = putDocRn msg - | otherwise = returnRn () +traceRn msg + = doptsRn dopt_D_dump_rn_trace `thenRn` \b -> + if b then putDocRn msg else returnRn () putDocRn :: SDoc -> RnM d () putDocRn msg = ioToRnM (printErrs msg) `thenRn_` @@ -109,14 +109,14 @@ data RnDown rn_loc :: SrcLoc, -- Current locn rn_finder :: Finder, - rn_flags :: DynFlags, + rn_dflags :: DynFlags, rn_gst :: GlobalSymbolTable, -- Both home modules and packages, -- at the moment we started compiling -- this module rn_errs :: IORef (Bag WarnMsg, Bag ErrMsg), rn_ns :: IORef NameSupply, - rn_ifaces :: IORef Ifaces, + rn_ifaces :: IORef Ifaces } -- For renaming source code @@ -209,7 +209,7 @@ data WhatsImported name = NothingAtAll -- The module is below us in the [(name,Version)] -- List guaranteed non-empty deriving( Eq ) -- 'Specifically' doesn't let you say "I imported f but none of the fixities in - -- the module. If you use anything in the module you get its fixity and rule version + -- the module". If you use anything in the module you get its fixity and rule version -- So if the fixities or rules change, you'll recompile, even if you don't use either. -- This is easy to implement, and it's safer: you might not have used the rules last -- time round, but if someone has added a new rule you might need it this time @@ -236,6 +236,8 @@ data ParsedIface type RdrNamePragma = () -- Fudge for now ------------------- +\end{code} + %************************************************************************ %* * \subsection{The renamer state} @@ -275,7 +277,6 @@ data Ifaces = Ifaces { -- See comments with RnIfaces.lookupFixity iDeprecs :: DeprecationEnv, - -- EPHEMERAL FIELDS -- These fields persist during the compilation of a single module only @@ -283,7 +284,7 @@ data Ifaces = Ifaces { -- All the names (whether "big" or "small", whether wired-in or not, -- whether locally defined or not) that have been slurped in so far. - iVSlurp :: [(Name,Version)], + iVSlurp :: [(Name,Version)] -- All the (a) non-wired-in (b) "big" (c) non-locally-defined -- names that have been slurped in so far, with their versions. -- This is used to generate the "usage" information for this module. @@ -326,10 +327,8 @@ type ImportedModuleInfo initRn :: DynFlags -> Finder -> GlobalSymbolTable -> PersistentRenamerState -> Module -> SrcLoc - -> RnMG r - -> IO (r, Bag ErrMsg, Bag WarnMsg) -initRn flags finder gst prs mod loc do_rn = do +initRn dflags finder gst prs mod loc do_rn = do himaps <- mkModuleHiMaps dirs names_var <- newIORef (prsNS pcs) errs_var <- newIORef (emptyBag,emptyBag) @@ -339,7 +338,7 @@ initRn flags finder gst prs mod loc do_rn = do rn_loc = loc, rn_finder = finder, - rn_flags = flags, + rn_dflags = dflags, rn_gst = gst, rn_ns = names_var, @@ -407,23 +406,24 @@ The @NameSupply@ includes a @UniqueSupply@, so if you call it more than once you must either split it, or install a fresh unique supply. \begin{code} -renameSourceCode :: Module - -> NameSupply +renameSourceCode :: DynFlags + -> Module + -> RnNameSupply -> RnMS r -> r -renameSourceCode mod name_supply m +renameSourceCode dflags mod name_supply m = unsafePerformIO ( -- It's not really unsafe! When renaming source code we -- only do any I/O if we need to read in a fixity declaration; -- and that doesn't happen in pragmas etc - mkModuleHiMaps (mkSearchPath opt_HiMap) >>= \ himaps -> newIORef name_supply >>= \ names_var -> newIORef (emptyBag,emptyBag) >>= \ errs_var -> let - rn_down = RnDown { rn_loc = mkGeneratedSrcLoc, rn_ns = names_var, - rn_errs = errs_var, rn_hi_maps = himaps, + rn_down = RnDown { rn_dflags = dflags, + rn_loc = mkGeneratedSrcLoc, rn_ns = names_var, + rn_errs = errs_var, rn_mod = mod, rn_ifaces = panic "rnameSourceCode: rn_ifaces" -- Not required } @@ -570,6 +570,10 @@ checkErrsRn :: RnM d Bool -- True <=> no errors so far checkErrsRn (RnDown {rn_errs = errs_var}) l_down = readIORef errs_var >>= \ (warns,errs) -> return (isEmptyBag errs) + +doptsRn :: (DynFlags -> Bool) -> RnM d Bool +doptsRn dopt (RnDown { rn_dflags = dflags}) l_down + = return (dopt dflags) \end{code} @@ -694,9 +698,4 @@ getIfacesRn (RnDown {rn_ifaces = iface_var}) _ setIfacesRn :: Ifaces -> RnM d () setIfacesRn ifaces (RnDown {rn_ifaces = iface_var}) _ = writeIORef iface_var ifaces - -getHiMaps :: RnM d (SearchPath, ModuleHiMap, ModuleHiMap) -getHiMaps (RnDown {rn_hi_maps = himaps}) _ - = return himaps -\end{code} \end{code} diff --git a/ghc/compiler/rename/RnNames.lhs b/ghc/compiler/rename/RnNames.lhs index 3607cd3..eb83ac5 100644 --- a/ghc/compiler/rename/RnNames.lhs +++ b/ghc/compiler/rename/RnNames.lhs @@ -10,7 +10,7 @@ module RnNames ( #include "HsVersions.h" -import CmdLineOpts ( opt_NoImplicitPrelude, opt_WarnDuplicateExports, opt_SourceUnchanged ) +import CmdLineOpts ( opt_NoImplicitPrelude, opt_WarnDuplicateExports ) import HsSyn ( HsModule(..), HsDecl(..), IE(..), ieName, ImportDecl(..), collectTopBinders @@ -191,7 +191,7 @@ checkEarlyExit mod_name returnRn (outOfDate, Nothing) Right iface - | not opt_SourceUnchanged + | panic "checkEarlyExit: ???: not opt_SourceUnchanged" -> -- Source code changed traceRn (nest 4 (text "source file changed or recompilation check turned off")) `thenRn_` returnRn (False, Just iface) diff --git a/ghc/compiler/rename/RnSource.lhs b/ghc/compiler/rename/RnSource.lhs index c99a24b..07afca2 100644 --- a/ghc/compiler/rename/RnSource.lhs +++ b/ghc/compiler/rename/RnSource.lhs @@ -46,7 +46,7 @@ import Bag ( bagToList ) import List ( partition, nub ) import Outputable import SrcLoc ( SrcLoc ) -import CmdLineOpts ( opt_GlasgowExts, opt_WarnUnusedMatches ) -- Warn of unused for-all'd tyvars +import CmdLineOpts ( opt_WarnUnusedMatches, dopt_GlasgowExts ) -- Warn of unused for-all'd tyvars import Unique ( Uniquable(..) ) import ErrUtils ( Message ) import CStrings ( isCLabelString ) @@ -155,17 +155,18 @@ rnDecl (TyClD (TyData new_or_data context tycon tyvars condecls nconstrs derivin rnDecl (TyClD (TySynonym name tyvars ty src_loc)) = pushSrcLocRn src_loc $ + doptsRn dopt_GlasgowExts `thenRn` \ glaExts -> lookupTopBndrRn name `thenRn` \ name' -> bindTyVarsFVRn syn_doc tyvars $ \ tyvars' -> - rnHsType syn_doc (unquantify ty) `thenRn` \ (ty', ty_fvs) -> + rnHsType syn_doc (unquantify glaExts ty) `thenRn` \ (ty', ty_fvs) -> returnRn (TyClD (TySynonym name' tyvars' ty' src_loc), ty_fvs) where syn_doc = text "the declaration for type synonym" <+> quotes (ppr name) -- For H98 we do *not* universally quantify on the RHS of a synonym -- Silently discard context... but the tyvars in the rest won't be in scope - unquantify (HsForAllTy Nothing ctxt ty) | not opt_GlasgowExts = ty - unquantify ty = ty + unquantify glaExts (HsForAllTy Nothing ctxt ty) | glaExts = ty + unquantify glaExys ty = ty rnDecl (TyClD (ClassDecl context cname tyvars fds sigs mbinds pragmas names src_loc))