import RnHsDoc ( rnHsDoc )
import IfaceEnv ( ifaceExportNames )
import LoadIface ( loadSrcInterface, loadSysInterface )
-import TcRnMonad hiding (LIE)
+import TcRnMonad
import HeaderInfo ( mkPrelImports )
import PrelNames
import Outputable
import Maybes
import SrcLoc
-import FiniteMap
import ErrUtils
import Util
import FastString
import qualified Data.Set as Set
import System.IO
import Control.Monad
+import Data.Map (Map)
+import qualified Data.Map as Map
\end{code}
when (notNull prel_imports) $ addWarn (implicitPreludeWarn)
)
- stuff1 <- mapM (rnImportDecl this_mod) (prel_imports ++ ordinary)
- stuff2 <- mapM (rnImportDecl this_mod) source
- let (decls, rdr_env, imp_avails,hpc_usage) = combine (stuff1 ++ stuff2)
- return (decls, rdr_env, imp_avails,hpc_usage)
+ stuff1 <- mapM (rnImportDecl this_mod True) prel_imports
+ stuff2 <- mapM (rnImportDecl this_mod False) ordinary
+ stuff3 <- mapM (rnImportDecl this_mod False) source
+ let (decls, rdr_env, imp_avails, hpc_usage) = combine (stuff1 ++ stuff2 ++ stuff3)
+ return (decls, rdr_env, imp_avails, hpc_usage)
where
combine :: [(LImportDecl Name, GlobalRdrEnv, ImportAvails,AnyHpcUsage)]
imp_avails1 `plusImportAvails` imp_avails2,
hpc_usage1 || hpc_usage2)
-rnImportDecl :: Module
+rnImportDecl :: Module -> Bool
-> LImportDecl RdrName
-> RnM (LImportDecl Name, GlobalRdrEnv, ImportAvails,AnyHpcUsage)
-rnImportDecl this_mod (L loc (ImportDecl loc_imp_mod_name mb_pkg want_boot
+rnImportDecl this_mod implicit_prelude (L loc (ImportDecl loc_imp_mod_name mb_pkg want_boot
qual_only as_mod imp_details))
= setSrcSpan loc $ do
imp_mod_name = unLoc loc_imp_mod_name
doc = ppr imp_mod_name <+> ptext (sLit "is directly imported")
+ let isExplicit lie = case unLoc lie of
+ IEThingAll _ -> False
+ _ -> True
+ case imp_details of
+ Just (False, lies)
+ | all isExplicit lies ->
+ return ()
+ _ ->
+ unless implicit_prelude $
+ ifOptM Opt_WarnMissingImportList (addWarn (missingImportListWarn imp_mod_name))
+
iface <- loadSrcInterface doc imp_mod_name want_boot mb_pkg
-- Compiler sanity check: if the import didn't say
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'.
-
- 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.
+ there are two bindings for 'f'. There are several tricky points:
+
+ * 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.
+
+ * The *qualified* name M.f from the enclosing module must certainly
+ still be available. So we don't nuke it entirely; we just make
+ it seem like qualified import.
+
+ * We only shadow *External* names (which come from the main module)
+ Do not shadow *Inernal* names because in the bracket
+ [d| class C a where f :: a
+ f = 4 |]
+ rnSrcDecls will first call extendGlobalRdrEnvRn with C[f] from the
+ class decl, and *separately* extend the envt with the value binding.
+
+3. 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 :: [AvailInfo]
-> MiniFixityEnv
-> RnM (TcGblEnv, TcLclEnv)
-- Updates both the GlobalRdrEnv and the FixityEnv
- -- We return a new TcLclEnv only becuase we might have to
+ -- We return a new TcLclEnv only because we might have to
-- delete some bindings from it;
-- see Note [Top-level Names in Template Haskell decl quotes]
-- 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
+ rdr_env1 = transformGREs qual_gre new_occs rdr_env
lcl_env1 = lcl_env { tcl_rdr = delListFromOccEnv (tcl_rdr lcl_env) new_occs }
(rdr_env2, lcl_env2) | shadowP = (rdr_env1, lcl_env1)
| otherwise = (rdr_env, lcl_env)
where
name = gre_name gre
occ = nameOccName name
+
+ qual_gre :: GlobalRdrElt -> GlobalRdrElt
+ -- Transform top-level GREs from the module being compiled
+ -- so that they are out of the way of new definitions in a Template
+ -- Haskell bracket
+ -- See Note [Top-level Names in Template Haskell decl quotes]
+ -- Seems like 5 times as much work as it deserves!
+ --
+ -- For a LocalDef we make a (fake) qualified imported GRE for a
+ -- local GRE so that the original *qualified* name is still in scope
+ -- but the *unqualified* one no longer is. What a hack!
+
+ qual_gre gre@(GRE { gre_prov = LocalDef, gre_name = name })
+ | isExternalName name = gre { gre_prov = Imported [imp_spec] }
+ | otherwise = gre
+ -- Do not shadow Internal (ie Template Haskell) Names
+ -- See Note [Top-level Names in Template Haskell decl quotes]
+ where
+ mod = ASSERT2( isExternalName name, ppr name) moduleName (nameModule name)
+ imp_spec = ImpSpec { is_item = ImpAll, is_decl = decl_spec }
+ decl_spec = ImpDeclSpec { is_mod = mod, is_as = mod,
+ is_qual = True, -- Qualified only!
+ is_dloc = srcLocSpan (nameSrcLoc name) }
+
+ qual_gre gre@(GRE { gre_prov = Imported specs })
+ = gre { gre_prov = Imported (map qual_spec specs) }
+
+ qual_spec spec@(ImpSpec { is_decl = decl_spec })
+ = spec { is_decl = decl_spec { is_qual = True } }
\end{code}
@getLocalDeclBinders@ returns the names for an @HsDecl@. It's
-- Get all the top-level binders bound the group *except*
-- for value bindings, which are treated separately
-- Specificaly we return AvailInfo for
--- type decls
--- class decls
+-- type decls (incl constructors and record selectors)
+-- class decls (including class ops)
-- associated types
-- foreign imports
-- (in hs-boot files) value signatures
-- different parents). See the discussion at occ_env.
lookup_ie :: Bool -> IE RdrName -> MaybeErr Message [(IE Name,AvailInfo)]
lookup_ie opt_typeFamilies ie
- = let bad_ie = Failed (badImportItemErr iface decl_spec ie)
+ = let bad_ie :: MaybeErr Message a
+ bad_ie = Failed (badImportItemErr iface decl_spec ie)
lookup_name rdr
| isQual rdr = Failed (qualImportItemErr rdr)
-> [RdrName]
-> [ImportDeclUsage]
-type ImportMap = FiniteMap SrcLoc [AvailInfo]
+type ImportMap = Map SrcLoc [AvailInfo]
-- The intermediate data struture records, for each import
-- declaration, what stuff brought into scope by that
-- declaration is actually used in the module.
= map unused_decl imports
where
import_usage :: ImportMap
- import_usage = foldr add_rdr emptyFM rdrs
+ import_usage = foldr add_rdr Map.empty rdrs
unused_decl decl@(L loc (ImportDecl { ideclHiding = imps }))
= (decl, nubAvails used_avails, unused_imps)
where
- used_avails = lookupFM import_usage (srcSpanStart loc) `orElse` []
+ used_avails = Map.lookup (srcSpanStart loc) import_usage `orElse` []
used_names = availsToNameSet used_avails
unused_imps = case imps of
add_imp :: GlobalRdrElt -> ImportSpec -> ImportMap -> ImportMap
add_imp gre (ImpSpec { is_decl = imp_decl_spec }) iu
- = addToFM_C add iu decl_loc [avail]
+ = Map.insertWith add decl_loc [avail] iu
where
- add avails _ = avail : avails
+ add _ avails = avail : avails -- add is really just a specialised (++)
decl_loc = srcSpanStart (is_dloc imp_decl_spec)
name = gre_name gre
avail = case gre_par gre of
nullModuleExport mod
= ptext (sLit "The export item `module") <+> ppr mod <> ptext (sLit "' exports nothing")
+missingImportListWarn :: ModuleName -> SDoc
+missingImportListWarn mod
+ = ptext (sLit "The module") <+> quotes (ppr mod) <+> ptext (sLit "does not have an explicit import list")
+
moduleWarn :: ModuleName -> WarningTxt -> SDoc
moduleWarn mod (WarningTxt txt)
= sep [ ptext (sLit "Module") <+> quotes (ppr mod) <> ptext (sLit ":"),
projects / ghc-hetmet.git / blobdiff