X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Frename%2FRnNames.lhs;h=bc7146b0624429ef7ffdd8551ee37aaff1aac829;hp=8b09f52a9a9b7d9cdba2f3b63248ce9ed75f8b98;hb=6a05ec5ef5373f61b7f9f5bdc344483417fa801b;hpb=c1681a73fa4ca4cf8758264ae387ac09a9e900d8 diff --git a/compiler/rename/RnNames.lhs b/compiler/rename/RnNames.lhs index 8b09f52..bc7146b 100644 --- a/compiler/rename/RnNames.lhs +++ b/compiler/rename/RnNames.lhs @@ -4,18 +4,25 @@ \section[RnNames]{Extracting imported and top-level names in scope} \begin{code} +{-# OPTIONS -w #-} +-- The above warning supression flag is a temporary kludge. +-- While working on this module you are encouraged to remove it and fix +-- any warnings in the module. See +-- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings +-- for details + module RnNames ( rnImports, importsFromLocalDecls, rnExports, getLocalDeclBinders, extendRdrEnvRn, - reportUnusedNames, finishDeprecations + reportUnusedNames, finishDeprecations, ) where #include "HsVersions.h" import DynFlags import HsSyn ( IE(..), ieName, ImportDecl(..), LImportDecl, - ForeignDecl(..), HsGroup(..), HsValBinds(..), + ForeignDecl(..), HsGroup(..), HsValBindsLR(..), Sig(..), collectHsBindLocatedBinders, tyClDeclNames, instDeclATs, isFamInstDecl, LIE ) @@ -29,6 +36,7 @@ import PrelNames import Module import Name import NameEnv +import UniqFM import NameSet import OccName import HscTypes @@ -38,7 +46,7 @@ import Maybes import SrcLoc import FiniteMap import ErrUtils -import BasicTypes ( DeprecTxt ) +import BasicTypes ( DeprecTxt, Fixity ) import DriverPhases ( isHsBoot ) import Util import ListSetOps @@ -229,7 +237,7 @@ rnImportDecl this_mod (L loc (ImportDecl loc_imp_mod_name want_boot other -> False imports = ImportAvails { - imp_mods = unitModuleEnv imp_mod (imp_mod, import_all, loc), + imp_mods = unitModuleEnv imp_mod (imp_mod, [(qual_mod_name, import_all, loc)]), imp_orphs = orphans, imp_finsts = finsts, imp_dep_mods = mkModDeps dependent_mods, @@ -266,36 +274,82 @@ From the top-level declarations of this module produce * the ImportAvails created by its bindings. -Complain about duplicate bindings - \begin{code} -importsFromLocalDecls :: HsGroup RdrName -> RnM TcGblEnv -importsFromLocalDecls group +-- Bool determines shadowing: +-- true: names in the group should shadow other UnQuals +-- with the same OccName (used in Template Haskell) +-- false: duplicates should be reported as an error +-- +-- The UniqFM (OccName -> FixItem) associates a Name's OccName's +-- FastString with a fixity declaration (that needs the actual OccName +-- to be plugged in). This fixity must be brought into scope when such +-- a Name is. +importsFromLocalDecls :: Bool -> HsGroup RdrName -> UniqFM (Located Fixity) -> RnM TcGblEnv +importsFromLocalDecls shadowP group fixities = do { gbl_env <- getGblEnv ; avails <- getLocalDeclBinders gbl_env group - ; rdr_env' <- extendRdrEnvRn (tcg_rdr_env gbl_env) avails + ; (rdr_env', fix_env') <- extendRdrEnvRn shadowP (tcg_rdr_env gbl_env, + tcg_fix_env gbl_env) + avails fixities ; traceRn (text "local avails: " <> ppr avails) - ; returnM (gbl_env { tcg_rdr_env = rdr_env' }) + ; returnM (gbl_env { tcg_rdr_env = rdr_env', + tcg_fix_env = fix_env'}) } -extendRdrEnvRn :: GlobalRdrEnv -> [AvailInfo] -> RnM GlobalRdrEnv +-- Bool determines shadowing as in importsFromLocalDecls. +-- UniqFM FixItem is the same as in importsFromLocalDecls. +-- -- Add the new locally-bound names one by one, checking for duplicates as -- we do so. Remember that in Template Haskell the duplicates --- might *already be* in the GlobalRdrEnv from higher up the module -extendRdrEnvRn rdr_env avails - = foldlM add_local rdr_env (gresFromAvails LocalDef avails) - where - add_local rdr_env gre - | gres <- lookupGlobalRdrEnv rdr_env (nameOccName (gre_name gre)) - , (dup_gre:_) <- filter isLocalGRE gres -- Check for existing *local* defns - = do { addDupDeclErr (gre_name dup_gre) (gre_name gre) - ; return rdr_env } - | otherwise - = return (extendGlobalRdrEnv rdr_env gre) +-- might *already be* in the GlobalRdrEnv from higher up the module. +-- +-- Also update the FixityEnv with the fixities for the names brought into scope. +-- +-- Note that the return values are the extensions of the two inputs, +-- not the extras relative to them. +extendRdrEnvRn :: Bool -> (GlobalRdrEnv, NameEnv FixItem) + -> [AvailInfo] -> UniqFM (Located Fixity) -> RnM (GlobalRdrEnv, NameEnv FixItem) +extendRdrEnvRn shadowP (rdr_env, fix_env) avails fixities = + let -- if there is a fixity decl for the gre, + -- add it to the fixity env + extendFixEnv env gre = + let name = gre_name gre + occ = nameOccName name + curKey = occNameFS occ in + case lookupUFM fixities curKey of + Nothing -> env + Just (L _ fi) -> extendNameEnv env name (FixItem occ fi) + + (rdr_env_to_extend, extender) = + if shadowP + then -- when shadowing is on, + -- (1) we need to remove the existing Unquals for the + -- names we're extending the env with + -- (2) but extending the env is simple + let names = concatMap availNames avails + new_occs = map nameOccName names + trimmed_rdr_env = hideSomeUnquals rdr_env new_occs + in + (trimmed_rdr_env, + \(cur_rdr_env, cur_fix_env) -> \gre -> + return (extendGlobalRdrEnv cur_rdr_env gre, + extendFixEnv cur_fix_env gre)) + else -- when shadowing is off, + -- (1) we don't munge the incoming env + -- (2) but we need to check for dups when extending + (rdr_env, + \(cur_rdr_env, cur_fix_env) -> \gre -> + let gres = lookupGlobalRdrEnv cur_rdr_env (nameOccName (gre_name gre)) + in case filter isLocalGRE gres of -- Check for existing *local* defns + dup_gre:_ -> do { addDupDeclErr (gre_name dup_gre) (gre_name gre) + ; return (cur_rdr_env, cur_fix_env) } + [] -> return (extendGlobalRdrEnv cur_rdr_env gre, + extendFixEnv cur_fix_env gre)) + in foldlM extender (rdr_env_to_extend, fix_env) (gresFromAvails LocalDef avails) \end{code} @getLocalDeclBinders@ returns the names for an @HsDecl@. It's @@ -315,11 +369,13 @@ raising a duplicate declaration error. So, we make a new name for it, but don't return it in the 'AvailInfo'. \begin{code} +-- Note: this function does NOT get the binders of the ValBinds that +-- will be bound during renaming getLocalDeclBinders :: TcGblEnv -> HsGroup RdrName -> RnM [AvailInfo] getLocalDeclBinders gbl_env (HsGroup {hs_valds = ValBindsIn val_decls val_sigs, - hs_tyclds = tycl_decls, - hs_instds = inst_decls, - hs_fords = foreign_decls }) + hs_tyclds = tycl_decls, + hs_instds = inst_decls, + hs_fords = foreign_decls }) = do { tc_names_s <- mappM new_tc tycl_decls ; at_names_s <- mappM inst_ats inst_decls ; val_names <- mappM new_simple val_bndrs @@ -327,19 +383,18 @@ getLocalDeclBinders gbl_env (HsGroup {hs_valds = ValBindsIn val_decls val_sigs, where mod = tcg_mod gbl_env is_hs_boot = isHsBoot (tcg_src gbl_env) ; - val_bndrs | is_hs_boot = sig_hs_bndrs - | otherwise = for_hs_bndrs ++ val_hs_bndrs - -- In a hs-boot file, the value binders come from the - -- *signatures*, and there should be no foreign binders + + 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 | is_hs_boot = [nm | L _ (TypeSig nm _) <- val_sigs] + | otherwise = for_hs_bndrs new_simple rdr_name = do nm <- newTopSrcBinder mod rdr_name return (Avail nm) - sig_hs_bndrs = [nm | L _ (TypeSig nm _) <- val_sigs] - val_hs_bndrs = collectHsBindLocatedBinders val_decls - for_hs_bndrs = [nm | L _ (ForeignImport nm _ _) <- foreign_decls] - new_tc tc_decl | isFamInstDecl (unLoc tc_decl) = do { main_name <- lookupFamInstDeclBndr mod main_rdr @@ -759,6 +814,10 @@ exports_from_avail (Just rdr_items) rdr_env imports this_mod kids_env :: NameEnv [Name] -- Maps a parent to its in-scope children kids_env = mkChildEnv (globalRdrEnvElts rdr_env) + imported_modules = [ qual_name + | (_, xs) <- moduleEnvElts $ imp_mods imports, + (qual_name, _, _) <- xs ] + exports_from_item :: ExportAccum -> LIE RdrName -> RnM ExportAccum exports_from_item acc@(ie_names, occs, exports) (L loc ie@(IEModuleContents mod)) @@ -770,10 +829,14 @@ exports_from_avail (Just rdr_items) rdr_env imports this_mod | otherwise = do { implicit_prelude <- doptM Opt_ImplicitPrelude - ; let gres = filter (isModuleExported implicit_prelude mod) - (globalRdrEnvElts rdr_env) + ; let { exportValid = (mod `elem` imported_modules) + || (moduleName this_mod == mod) + ; gres = filter (isModuleExported implicit_prelude mod) + (globalRdrEnvElts rdr_env) + } - ; warnIf (null gres) (nullModuleExport mod) + ; checkErr exportValid (moduleNotImported mod) + ; warnIf (exportValid && null gres) (nullModuleExport mod) ; occs' <- check_occs ie occs (map gre_name gres) -- This check_occs not only finds conflicts @@ -1110,7 +1173,7 @@ reportUnusedNames export_decls gbl_env -- qualified imports into account. But it's an improvement. add_expall mod acc = addToFM_C plusAvailEnv acc mod emptyAvailEnv - add_inst_mod (mod,_,_) acc + add_inst_mod (mod, _) acc | mod_name `elemFM` acc = acc -- We import something already | otherwise = addToFM acc mod_name emptyAvailEnv where @@ -1120,7 +1183,7 @@ reportUnusedNames export_decls gbl_env imports = tcg_imports gbl_env - direct_import_mods :: [(Module, Bool, SrcSpan)] + direct_import_mods :: [(Module, [(ModuleName, Bool, SrcSpan)])] -- See the type of the imp_mods for this triple direct_import_mods = moduleEnvElts (imp_mods imports) @@ -1129,10 +1192,11 @@ reportUnusedNames export_decls gbl_env -- [Note: not 'minimal_imports', because that includes directly-imported -- modules even if we use nothing from them; see notes above] -- - -- BUG WARNING: does not deal correctly with multiple imports of the same module - -- becuase direct_import_mods has only one entry per module + -- BUG WARNING: this code is generally buggy unused_imp_mods :: [(ModuleName, SrcSpan)] - unused_imp_mods = [(mod_name,loc) | (mod,no_imp,loc) <- direct_import_mods, + unused_imp_mods = [(mod_name,loc) + | (mod, xs) <- direct_import_mods, + (_, no_imp, loc) <- xs, let mod_name = moduleName mod, not (mod_name `elemFM` minimal_imports1), mod /= pRELUDE, @@ -1238,8 +1302,9 @@ printMinimalImports imps mod_ies <- initIfaceTcRn $ mappM to_ies (fmToList imps) ; this_mod <- getModule ; rdr_env <- getGlobalRdrEnv ; + dflags <- getDOpts ; ioToTcRn (do { h <- openFile (mkFilename this_mod) WriteMode ; - printForUser h (mkPrintUnqualified rdr_env) + printForUser h (mkPrintUnqualified dflags rdr_env) (vcat (map ppr_mod_ie mod_ies)) }) } where @@ -1354,6 +1419,11 @@ dupModuleExport mod quotes (ptext SLIT("Module") <+> ppr mod), ptext SLIT("in export list")] +moduleNotImported :: ModuleName -> SDoc +moduleNotImported mod + = ptext SLIT("The export item `module") <+> ppr mod <> + ptext SLIT("' is not imported") + nullModuleExport mod = ptext SLIT("The export item `module") <+> ppr mod <> ptext SLIT("' exports nothing")