X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Frename%2FRnNames.lhs;h=68286b7ac67589ed91911fb932ec92f2e5d54928;hp=7aad1171c659504c4cbcf02fcf9de9d4d259f4d1;hb=66579ff945831c5fc9a17c58c722ff01f2268d76;hpb=cae75f82226638691cfa1e85fc168f4b65ddce4d diff --git a/compiler/rename/RnNames.lhs b/compiler/rename/RnNames.lhs index 7aad117..68286b7 100644 --- a/compiler/rename/RnNames.lhs +++ b/compiler/rename/RnNames.lhs @@ -63,7 +63,7 @@ rnImports imports implicit_prelude <- doptM Opt_ImplicitPrelude let prel_imports = mkPrelImports this_mod implicit_prelude imports (source, ordinary) = partition is_source_import imports - is_source_import (L _ (ImportDecl _ is_boot _ _ _)) = is_boot + is_source_import (L _ (ImportDecl _ _ is_boot _ _ _)) = is_boot ifOptM Opt_WarnImplicitPrelude ( when (notNull prel_imports) $ addWarn (implicitPreludeWarn) @@ -99,13 +99,14 @@ mkPrelImports this_mod implicit_prelude import_decls | otherwise = [preludeImportDecl] where explicit_prelude_import - = notNull [ () | L _ (ImportDecl mod _ _ _ _) <- import_decls, + = notNull [ () | L _ (ImportDecl mod Nothing _ _ _ _) <- import_decls, unLoc mod == pRELUDE_NAME ] preludeImportDecl :: LImportDecl RdrName preludeImportDecl = L loc $ ImportDecl (L loc pRELUDE_NAME) + Nothing {- no specific package -} False {- Not a boot interface -} False {- Not qualified -} Nothing {- No "as" -} @@ -118,18 +119,22 @@ rnImportDecl :: Module -> LImportDecl RdrName -> RnM (LImportDecl Name, GlobalRdrEnv, ImportAvails,AnyHpcUsage) -rnImportDecl this_mod (L loc (ImportDecl loc_imp_mod_name want_boot +rnImportDecl this_mod (L loc (ImportDecl loc_imp_mod_name mb_pkg want_boot qual_only as_mod imp_details)) = setSrcSpan loc $ do + when (isJust mb_pkg) $ do + pkg_imports <- doptM Opt_PackageImports + when (not pkg_imports) $ addErr packageImportErr + -- If there's an error in loadInterface, (e.g. interface -- file not found) we get lots of spurious errors from 'filterImports' let imp_mod_name = unLoc loc_imp_mod_name doc = ppr imp_mod_name <+> ptext (sLit "is directly imported") - iface <- loadSrcInterface doc imp_mod_name want_boot + iface <- loadSrcInterface doc imp_mod_name want_boot mb_pkg -- Compiler sanity check: if the import didn't say -- {-# SOURCE #-} we should not get a hi-boot file @@ -239,7 +244,7 @@ rnImportDecl this_mod (L loc (ImportDecl loc_imp_mod_name want_boot _ -> return () ) - let new_imp_decl = L loc (ImportDecl loc_imp_mod_name want_boot + let new_imp_decl = L loc (ImportDecl loc_imp_mod_name mb_pkg want_boot qual_only as_mod new_imp_details) return (new_imp_decl, gbl_env, imports, mi_hpc iface) @@ -372,13 +377,16 @@ get_local_binders gbl_env (HsGroup {hs_valds = ValBindsIn _ val_sigs, mod = tcg_mod gbl_env is_hs_boot = isHsBoot (tcg_src gbl_env) ; + for_hs_bndrs :: [Located RdrName] for_hs_bndrs = [nm | L _ (ForeignImport nm _ _) <- foreign_decls] -- In a hs-boot file, the value binders come from the -- *signatures*, and there should be no foreign binders + val_bndrs :: [Located RdrName] val_bndrs | is_hs_boot = [nm | L _ (TypeSig nm _) <- val_sigs] | otherwise = for_hs_bndrs + new_simple :: Located RdrName -> RnM (GenAvailInfo Name) new_simple rdr_name = do nm <- newTopSrcBinder mod rdr_name return (Avail nm) @@ -633,7 +641,7 @@ filterAvail keep ie rest = let left = filter keep ns in if null left then rest else AvailTC tc left : rest --- | Given an import/export spec, construct the appropriate 'GlobalRdrElt's. +-- | Given an import\/export spec, construct the appropriate 'GlobalRdrElt's. gresFromIE :: ImpDeclSpec -> (LIE Name, AvailInfo) -> [GlobalRdrElt] gresFromIE decl_spec (L loc ie, avail) = gresFromAvail prov_fn avail @@ -998,7 +1006,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 @@ -1016,7 +1024,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 @@ -1024,7 +1032,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] @@ -1190,7 +1199,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 @@ -1332,7 +1344,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} @@ -1440,4 +1452,8 @@ moduleWarn mod (DeprecatedTxt txt) implicitPreludeWarn :: SDoc implicitPreludeWarn = ptext (sLit "Module `Prelude' implicitly imported") + +packageImportErr :: SDoc +packageImportErr + = ptext (sLit "Package-qualified imports are not enabled; use -XPackageImports") \end{code}