X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Frename%2FRnNames.lhs;h=253d262fcf40271789e7200d031e6e71a6cea635;hb=72e37dedee9e8a109ebda4b13e49b7133b530591;hp=ae5ec9569bb34034fb6f8b736749d7af6c793493;hpb=55f3a503d72d89d7c57a0b10093dd4bdb0488c42;p=ghc-hetmet.git diff --git a/compiler/rename/RnNames.lhs b/compiler/rename/RnNames.lhs index ae5ec95..253d262 100644 --- a/compiler/rename/RnNames.lhs +++ b/compiler/rename/RnNames.lhs @@ -8,21 +8,21 @@ module RnNames ( rnImports, importsFromLocalDecls, rnExports, getLocalDeclBinders, extendRdrEnvRn, - reportUnusedNames, reportDeprecations + reportUnusedNames, finishDeprecations ) where #include "HsVersions.h" -import DynFlags ( DynFlag(..), GhcMode(..), DynFlags(..) ) +import DynFlags import HsSyn ( IE(..), ieName, ImportDecl(..), LImportDecl, ForeignDecl(..), HsGroup(..), HsValBinds(..), Sig(..), collectHsBindLocatedBinders, tyClDeclNames, - instDeclATs, isIdxTyDecl, + instDeclATs, isFamInstDecl, LIE ) import RnEnv import RnHsDoc ( rnHsDoc ) import IfaceEnv ( ifaceExportNames ) -import LoadIface ( loadSrcInterface ) +import LoadIface ( loadSrcInterface, loadSysInterface ) import TcRnMonad hiding (LIE) import PrelNames @@ -143,7 +143,7 @@ rnImportDecl this_mod (L loc (ImportDecl loc_imp_mod_name want_boot let imp_mod = mi_module iface deprecs = mi_deprecs iface - is_orph = mi_orphan iface + orph_iface = mi_orphan iface has_finsts = mi_finsts iface deps = mi_deps iface @@ -186,9 +186,9 @@ rnImportDecl this_mod (L loc (ImportDecl loc_imp_mod_name want_boot let -- Compute new transitive dependencies - orphans | is_orph = ASSERT( not (imp_mod `elem` dep_orphs deps) ) - imp_mod : dep_orphs deps - | otherwise = dep_orphs deps + orphans | orph_iface = ASSERT( not (imp_mod `elem` dep_orphs deps) ) + imp_mod : dep_orphs deps + | otherwise = dep_orphs deps finsts | has_finsts = ASSERT( not (imp_mod `elem` dep_finsts deps) ) imp_mod : dep_finsts deps @@ -336,7 +336,7 @@ getLocalDeclBinders gbl_env (HsGroup {hs_valds = ValBindsIn val_decls val_sigs, for_hs_bndrs = [nm | L _ (ForeignImport nm _ _) <- foreign_decls] new_tc tc_decl - | isIdxTyDecl (unLoc tc_decl) + | isFamInstDecl (unLoc tc_decl) = do { main_name <- lookupFamInstDeclBndr mod main_rdr ; sub_names <- mappM (newTopSrcBinder mod) sub_rdrs ; return (AvailTC main_name sub_names) } @@ -688,41 +688,44 @@ type ExportOccMap = OccEnv (Name, IE RdrName) -- it came from. It's illegal to export two distinct things -- that have the same occurrence name -rnExports :: Bool -- False => no 'module M(..) where' header at all +rnExports :: Bool -- False => no 'module M(..) where' header at all -> Maybe [LIE RdrName] -- Nothing => no explicit export list - -> RnM (Maybe [LIE Name], [AvailInfo]) + -> TcGblEnv + -> RnM TcGblEnv -- Complains if two distinct exports have same OccName -- Warns about identical exports. -- Complains about exports items not in scope -rnExports explicit_mod exports - = do TcGblEnv { tcg_mod = this_mod, - tcg_rdr_env = rdr_env, - tcg_imports = imports } <- getGblEnv - +rnExports explicit_mod exports + tcg_env@(TcGblEnv { tcg_mod = this_mod, + tcg_rdr_env = rdr_env, + tcg_imports = imports }) + = do { -- If the module header is omitted altogether, then behave -- as if the user had written "module Main(main) where..." -- EXCEPT in interactive mode, when we behave as if he had -- written "module Main where ..." -- Reason: don't want to complain about 'main' not in scope -- in interactive mode - ghc_mode <- getGhcMode - real_exports <- - case () of - () | explicit_mod - -> return exports - | ghc_mode == Interactive - -> return Nothing - | otherwise - -> do mainName <- lookupGlobalOccRn main_RDR_Unqual - return (Just ([noLoc (IEVar main_RDR_Unqual)])) - -- ToDo: the 'noLoc' here is unhelpful if 'main' turns - -- out to be out of scope - - (exp_spec, avails) <- exports_from_avail real_exports rdr_env imports this_mod - - return (exp_spec, nubAvails avails) -- Combine families + ; dflags <- getDOpts + ; let real_exports + | explicit_mod = exports + | ghcLink dflags == LinkInMemory = Nothing + | otherwise = Just ([noLoc (IEVar main_RDR_Unqual)]) + -- ToDo: the 'noLoc' here is unhelpful if 'main' + -- turns out to be out of scope + + ; (rn_exports, avails) <- exports_from_avail real_exports rdr_env imports this_mod + ; let final_avails = nubAvails avails -- Combine families + + ; return (tcg_env { tcg_exports = final_avails, + tcg_rn_exports = case tcg_rn_exports tcg_env of + Nothing -> Nothing + Just _ -> rn_exports, + tcg_dus = tcg_dus tcg_env `plusDU` + usesOnly (availsToNameSet final_avails) }) } + exports_from_avail :: Maybe [LIE RdrName] -- Nothing => no explicit export list @@ -904,13 +907,23 @@ check_occs ie occs names %********************************************************* \begin{code} -reportDeprecations :: DynFlags -> TcGblEnv -> RnM () -reportDeprecations dflags tcg_env - = ifOptM Opt_WarnDeprecations $ - do { (eps,hpt) <- getEpsAndHpt +finishDeprecations :: DynFlags -> Maybe DeprecTxt + -> TcGblEnv -> RnM TcGblEnv +-- (a) Report usasge of deprecated imports +-- (b) If the whole module is deprecated, update tcg_deprecs +-- All this happens only once per module +finishDeprecations dflags mod_deprec tcg_env + = do { (eps,hpt) <- getEpsAndHpt + ; ifOptM Opt_WarnDeprecations $ + mapM_ (check hpt (eps_PIT eps)) all_gres -- By this time, typechecking is complete, -- so the PIT is fully populated - ; mapM_ (check hpt (eps_PIT eps)) all_gres } + + -- Deal with a module deprecation; it overrides all existing deprecs + ; let new_deprecs = case mod_deprec of + Just txt -> DeprecAll txt + Nothing -> tcg_deprecs tcg_env + ; return (tcg_env { tcg_deprecs = new_deprecs }) } where used_names = allUses (tcg_dus tcg_env) -- Report on all deprecated uses; hence allUses @@ -949,18 +962,34 @@ lookupImpDeprec dflags hpt pit gre case gre_par gre of ParentIs p -> mi_dep_fn iface p -- its parent*, is deprec'd NoParent -> Nothing - Nothing - | isWiredInName name -> Nothing - -- We have not necessarily loaded the .hi file for a - -- wired-in name (yet), although we *could*. - -- And we never deprecate them - - | otherwise -> pprPanic "lookupDeprec" (ppr name) - -- By now all the interfaces should have been loaded + + Nothing -> Nothing -- See Note [Used names with interface not loaded] where name = gre_name gre \end{code} +Note [Used names with interface not loaded] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +By now all the interfaces should have been loaded, +because reportDeprecations happens after typechecking. +However, it's still (just) possible to to find a used +Name whose interface hasn't been loaded: + +a) It might be a WiredInName; in that case we may not load + its interface (although we could). + +b) It might be GHC.Real.fromRational, or GHC.Num.fromInteger + These are seen as "used" by the renamer (if -fno-implicit-prelude) + is on), but the typechecker may discard their uses + if in fact the in-scope fromRational is GHC.Read.fromRational, + (see tcPat.tcOverloadedLit), and the typechecker sees that the type + is fixed, say, to GHC.Base.Float (see Inst.lookupSimpleInst). + In that obscure case it won't force the interface in. + +In both cases we simply don't permit deprecations; +this is, after all, wired-in stuff. + + %********************************************************* %* * Unused names @@ -1134,8 +1163,6 @@ warnDuplicateImports :: [GlobalRdrElt] -> RnM () warnDuplicateImports gres = ifOptM Opt_WarnUnusedImports $ sequenceM_ [ warn name pr - -- The 'head' picks the first offending group - -- for this particular name | GRE { gre_name = name, gre_prov = Imported imps } <- gres , pr <- redundants imps ] where @@ -1154,7 +1181,12 @@ warnDuplicateImports gres redundants imps = [ (red_imp, cov_imp) | red_imp <- imps + , isExplicitItem (is_item red_imp) + -- Complain only about redundant imports + -- mentioned explicitly by the user , cov_imp <- take 1 (filter (covers red_imp) imps) ] + -- The 'take 1' picks the first offending group + -- for this particular name -- "red_imp" is a putative redundant import -- "cov_imp" potentially covers it @@ -1175,6 +1207,10 @@ warnDuplicateImports gres = False -- They bring into scope different qualified names | not (is_qual red_decl) && is_qual cov_decl = False -- Covering one doesn't bring unqualified name into scope + | otherwise + = not (isExplicitItem cov_item) -- Redundant one is selective and covering one isn't + || red_later -- or both are explicit; tie-break using red_later +{- | red_selective = not cov_selective -- Redundant one is selective and covering one isn't || red_later -- Both are explicit; tie-break using red_later @@ -1182,16 +1218,11 @@ warnDuplicateImports gres = not cov_selective -- Neither import is selective && (is_mod red_decl == is_mod cov_decl) -- They import the same module && red_later -- Tie-break +-} where red_loc = importSpecLoc red_imp cov_loc = importSpecLoc cov_imp red_later = red_loc > cov_loc - cov_selective = selectiveImpItem cov_item - red_selective = selectiveImpItem red_item - -selectiveImpItem :: ImpItemSpec -> Bool -selectiveImpItem ImpAll = False -selectiveImpItem (ImpSome {}) = True -- ToDo: deal with original imports with 'qualified' and 'as M' clauses printMinimalImports :: FiniteMap ModuleName AvailEnv -- Minimal imports @@ -1199,7 +1230,7 @@ printMinimalImports :: FiniteMap ModuleName AvailEnv -- Minimal imports printMinimalImports imps = ifOptM Opt_D_dump_minimal_imports $ do { - mod_ies <- mappM to_ies (fmToList imps) ; + mod_ies <- initIfaceTcRn $ mappM to_ies (fmToList imps) ; this_mod <- getModule ; rdr_env <- getGlobalRdrEnv ; ioToTcRn (do { h <- openFile (mkFilename this_mod) WriteMode ; @@ -1220,7 +1251,7 @@ printMinimalImports imps to_ies (mod, avail_env) = do ies <- mapM to_ie (availEnvElts avail_env) returnM (mod, ies) - to_ie :: AvailInfo -> RnM (IE Name) + to_ie :: AvailInfo -> IfG (IE Name) -- The main trick here is that if we're importing all the constructors -- we want to say "T(..)", but if we're importing only a subset we want -- to say "T(A,B,C)". So we have to find out what the module exports. @@ -1228,9 +1259,9 @@ printMinimalImports imps to_ie (AvailTC n [m]) = ASSERT( n==m ) returnM (IEThingAbs n) to_ie (AvailTC n ns) - = loadSrcInterface doc n_mod False `thenM` \ iface -> + = loadSysInterface doc n_mod `thenM` \ iface -> case [xs | (m,as) <- mi_exports iface, - moduleName m == n_mod, + m == n_mod, AvailTC x xs <- as, x == nameOccName n] of [xs] | all_used xs -> returnM (IEThingAll n) @@ -1240,7 +1271,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 = moduleName (nameModule n) + n_mod = nameModule n \end{code} @@ -1276,10 +1307,12 @@ typeItemErr name wherestr = sep [ ptext SLIT("Using 'type' tag on") <+> quotes (ppr name) <+> wherestr, ptext SLIT("Use -findexed-types to enable this extension") ] +exportClashErr :: GlobalRdrEnv -> Name -> Name -> IE RdrName -> IE RdrName + -> Message exportClashErr global_env name1 name2 ie1 ie2 = vcat [ ptext SLIT("Conflicting exports for") <+> quotes (ppr occ) <> colon - , ppr_export ie1 name1 - , ppr_export ie2 name2 ] + , ppr_export ie1' name1' + , ppr_export ie2' name2' ] where occ = nameOccName name1 ppr_export ie name = nest 2 (quotes (ppr ie) <+> ptext SLIT("exports") <+> @@ -1290,6 +1323,10 @@ exportClashErr global_env name1 name2 ie1 ie2 = case lookupGRE_Name global_env name of (gre:_) -> gre [] -> pprPanic "exportClashErr" (ppr name) + get_loc name = nameSrcLoc $ gre_name $ get_gre name + (name1', ie1', name2', ie2') = if get_loc name1 < get_loc name2 + then (name1, ie1, name2, ie2) + else (name2, ie2, name1, ie1) addDupDeclErr :: Name -> Name -> TcRn () addDupDeclErr name_a name_b