X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Frename%2FRnNames.lhs;h=a7b84ebdefe86f4b7d7d38fe9432d86d2420f720;hp=e629dac7cf1e983bb85375aeb13f069527ef993e;hb=34cc75e1a62638f2833815746ebce0a9114dc26b;hpb=1867a7bb8c59ea514b4f47f5434842543933ec9a diff --git a/compiler/rename/RnNames.lhs b/compiler/rename/RnNames.lhs index e629dac..a7b84eb 100644 --- a/compiler/rename/RnNames.lhs +++ b/compiler/rename/RnNames.lhs @@ -14,6 +14,7 @@ module RnNames ( import DynFlags import HsSyn +import TcEnv ( isBrackStage ) import RnEnv import RnHsDoc ( rnHsDoc ) import IfaceEnv ( ifaceExportNames ) @@ -142,8 +143,14 @@ rnImportDecl this_mod (L loc (ImportDecl loc_imp_mod_name mb_pkg want_boot -- Issue a user warning for a redundant {- SOURCE -} import -- NB that we arrange to read all the ordinary imports before - -- any of the {- SOURCE -} imports - warnIf (want_boot && not (mi_boot iface)) + -- any of the {- SOURCE -} imports. + -- + -- in --make and GHCi, the compilation manager checks for this, + -- and indeed we shouldn't do it here because the existence of + -- the non-boot module depends on the compilation order, which + -- is not deterministic. The hs-boot test can show this up. + dflags <- getDOpts + warnIf (want_boot && not (mi_boot iface) && isOneShot (ghcMode dflags)) (warnRedundantSourceImport imp_mod_name) let @@ -268,44 +275,57 @@ From the top-level declarations of this module produce * the ImportAvails created by its bindings. -Note [Shadowing in extendGlobalRdrEnvRn] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Usually when etending the GlobalRdrEnv we complain if a new binding -duplicates an existing one. By adding the bindings one at a time, -this check also complains if we add two new bindings for the same name. -(Remember that in Template Haskell the duplicates might *already be* -in the GlobalRdrEnv from higher up the module.) - -But with a Template Haskell quotation we want to *shadow*: +Note [Top-level Names in Template Haskell decl quotes] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider a Template Haskell declaration quotation like this: + module M where f x = h [d| f = 3 |] -Here the inner binding for 'f' simply shadows the outer one. -And that applies even if the binding for 'f' is in a where-clause, -and hence is in the *local* RdrEnv not the *global* RdrEnv. +When renaming the declarations inside [d| ...|], we treat the +top level binders specially in two ways + +1. We give them an Internal name, not (as usual) an External one. + Otherwise the NameCache gets confused by a second allocation of + M.f. (We used to invent a fake module ThFake to avoid this, but + that had other problems, notably in getting the correct answer for + nameIsLocalOrFrom in lookupFixity. So we now leave tcg_module + unaffected.) + +2. We make them *shadow* the outer bindings. If we don't do that, + we'll get a complaint when extending the GlobalRdrEnv, saying that + there are two bindings for 'f'. -Hence the shadowP boolean passed in. + This shadowing applies even if the binding for 'f' is in a + where-clause, and hence is in the *local* RdrEnv not the *global* + RdrEnv. + +We find out whether we are inside a [d| ... |] by testing the TH +stage. This is a slight hack, because the stage field was really meant for +the type checker, and here we are not interested in the fields of Brack, +hence the error thunks in thRnBrack. \begin{code} -extendGlobalRdrEnvRn :: Bool -- Note [Shadowing in extendGlobalRdrEnvRn] - -> [AvailInfo] +extendGlobalRdrEnvRn :: [AvailInfo] -> MiniFixityEnv -> RnM (TcGblEnv, TcLclEnv) -- Updates both the GlobalRdrEnv and the FixityEnv -- We return a new TcLclEnv only becuase we might have to - -- delete some bindings from it; see Note [Shadowing in extendGlobalRdrEnvRn] + -- delete some bindings from it; + -- see Note [Top-level Names in Template Haskell decl quotes] -extendGlobalRdrEnvRn shadowP avails new_fixities +extendGlobalRdrEnvRn avails new_fixities = do { (gbl_env, lcl_env) <- getEnvs + ; stage <- getStage ; let rdr_env = tcg_rdr_env gbl_env fix_env = tcg_fix_env gbl_env -- Delete new_occs from global and local envs - -- We are going to shadow them - -- See Note [Shadowing in extendGlobalRdrEnvRn] + -- If we are in a TemplateHaskell decl bracket, + -- we are going to shadow them + -- See Note [Top-level Names in Template Haskell decl quotes] + shadowP = isBrackStage stage new_occs = map (nameOccName . gre_name) gres rdr_env1 = hideSomeUnquals rdr_env new_occs lcl_env1 = lcl_env { tcl_rdr = delListFromOccEnv (tcl_rdr lcl_env) new_occs } - - -- Note [Shadowing in extendGlobalRdrEnvRn] (rdr_env2, lcl_env2) | shadowP = (rdr_env1, lcl_env1) | otherwise = (rdr_env, lcl_env) @@ -941,7 +961,9 @@ isModuleExported implicit_prelude mod (GRE { gre_name = name, gre_prov = prov }) -- every module that imports the Prelude | otherwise = case prov of - LocalDef -> moduleName (nameModule name) == mod + LocalDef | Just name_mod <- nameModule_maybe name + -> moduleName name_mod == mod + | otherwise -> False Imported is -> any unQualSpecOK is && any (qualSpecOK mod) is ------------------------------- @@ -1006,7 +1028,7 @@ finishWarnings dflags mod_warn tcg_env (parens imp_msg) <> colon, (ppr deprec_txt) ]) where - name_mod = nameModule name + name_mod = ASSERT2( isExternalName name, ppr name ) nameModule name imp_mod = importSpecModule imp_spec imp_msg = ptext (sLit "imported from") <+> ppr imp_mod <> extra extra | imp_mod == moduleName name_mod = empty @@ -1024,7 +1046,7 @@ lookupImpDeprec :: DynFlags -> HomePackageTable -> PackageIfaceTable -> GlobalRdrElt -> Maybe WarningTxt -- The name is definitely imported, so look in HPT, PIT lookupImpDeprec dflags hpt pit gre - = case lookupIfaceByModule dflags hpt pit (nameModule name) of + = case lookupIfaceByModule dflags hpt pit mod of Just iface -> mi_warn_fn iface name `mplus` -- Bleat if the thing, *or case gre_par gre of ParentIs p -> mi_warn_fn iface p -- its parent*, is warn'd @@ -1032,7 +1054,8 @@ lookupImpDeprec dflags hpt pit gre Nothing -> Nothing -- See Note [Used names with interface not loaded] where - name = gre_name gre + name = gre_name gre + mod = ASSERT2( isExternalName name, ppr name ) nameModule name \end{code} Note [Used names with interface not loaded] @@ -1198,7 +1221,10 @@ reportUnusedNames export_decls gbl_env (_, no_imp, loc) <- xs, let mod_name = moduleName mod, not (mod_name `elemFM` minimal_imports1), - mod /= pRELUDE, + moduleName mod /= pRELUDE_NAME, + -- XXX not really correct, but we don't want + -- to generate warnings when compiling against + -- a compat version of base. not no_imp] -- The not no_imp part is not to complain about -- import M (), which is an idiom for importing @@ -1340,7 +1366,7 @@ printMinimalImports imps where all_used avail_occs = all (`elem` map nameOccName ns) avail_occs doc = text "Compute minimal imports from" <+> ppr n - n_mod = nameModule n + n_mod = ASSERT( isExternalName n ) nameModule n \end{code} @@ -1369,8 +1395,9 @@ dodgyExportWarn item = dodgyMsg (ptext (sLit "export")) item dodgyMsg :: OutputableBndr n => SDoc -> n -> SDoc dodgyMsg kind tc - = sep [ ptext (sLit "The") <+> kind <+> ptext (sLit "item") <+> quotes (ppr (IEThingAll tc)), - ptext (sLit "suggests that") <+> quotes (ppr tc) <+> ptext (sLit "has constructors or class methods,"), + = sep [ ptext (sLit "The") <+> kind <+> ptext (sLit "item") <+> quotes (ppr (IEThingAll tc)) + <+> ptext (sLit "suggests that"), + quotes (ppr tc) <+> ptext (sLit "has (in-scope) constructors or class methods,"), ptext (sLit "but it has none") ] exportItemErr :: IE RdrName -> SDoc