| 1 | % |
|---|
| 2 | % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998 |
|---|
| 3 | % |
|---|
| 4 | \section[RnNames]{Extracting imported and top-level names in scope} |
|---|
| 5 | |
|---|
| 6 | \begin{code} |
|---|
| 7 | module RnNames ( |
|---|
| 8 | rnImports, getLocalNonValBinders, |
|---|
| 9 | rnExports, extendGlobalRdrEnvRn, |
|---|
| 10 | gresFromAvails, |
|---|
| 11 | reportUnusedNames, |
|---|
| 12 | ) where |
|---|
| 13 | |
|---|
| 14 | #include "HsVersions.h" |
|---|
| 15 | |
|---|
| 16 | import DynFlags |
|---|
| 17 | import HsSyn |
|---|
| 18 | import TcEnv ( isBrackStage ) |
|---|
| 19 | import RnEnv |
|---|
| 20 | import RnHsDoc ( rnHsDoc ) |
|---|
| 21 | import LoadIface ( loadSrcInterface ) |
|---|
| 22 | import TcRnMonad |
|---|
| 23 | import PrelNames |
|---|
| 24 | import Module |
|---|
| 25 | import Name |
|---|
| 26 | import NameEnv |
|---|
| 27 | import NameSet |
|---|
| 28 | import Avail |
|---|
| 29 | import HscTypes |
|---|
| 30 | import RdrName |
|---|
| 31 | import Outputable |
|---|
| 32 | import Maybes |
|---|
| 33 | import SrcLoc |
|---|
| 34 | import ErrUtils |
|---|
| 35 | import Util |
|---|
| 36 | import FastString |
|---|
| 37 | import ListSetOps |
|---|
| 38 | |
|---|
| 39 | import Control.Monad |
|---|
| 40 | import Data.Map ( Map ) |
|---|
| 41 | import qualified Data.Map as Map |
|---|
| 42 | import Data.List ( partition, (\\), find ) |
|---|
| 43 | import qualified Data.Set as Set |
|---|
| 44 | import System.IO |
|---|
| 45 | \end{code} |
|---|
| 46 | |
|---|
| 47 | |
|---|
| 48 | %************************************************************************ |
|---|
| 49 | %* * |
|---|
| 50 | \subsection{rnImports} |
|---|
| 51 | %* * |
|---|
| 52 | %************************************************************************ |
|---|
| 53 | |
|---|
| 54 | Note [Tracking Trust Transitively] |
|---|
| 55 | ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
|---|
| 56 | When we import a package as well as checking that the direct imports are safe |
|---|
| 57 | according to the rules outlined in the Note [HscMain . Safe Haskell Trust Check] |
|---|
| 58 | we must also check that these rules hold transitively for all dependent modules |
|---|
| 59 | and packages. Doing this without caching any trust information would be very |
|---|
| 60 | slow as we would need to touch all packages and interface files a module depends |
|---|
| 61 | on. To avoid this we make use of the property that if a modules Safe Haskell |
|---|
| 62 | mode changes, this triggers a recompilation from that module in the dependcy |
|---|
| 63 | graph. So we can just worry mostly about direct imports. |
|---|
| 64 | |
|---|
| 65 | There is one trust property that can change for a package though without |
|---|
| 66 | recompliation being triggered: package trust. So we must check that all |
|---|
| 67 | packages a module tranitively depends on to be trusted are still trusted when |
|---|
| 68 | we are compiling this module (as due to recompilation avoidance some modules |
|---|
| 69 | below may not be considered trusted any more without recompilation being |
|---|
| 70 | triggered). |
|---|
| 71 | |
|---|
| 72 | We handle this by augmenting the existing transitive list of packages a module M |
|---|
| 73 | depends on with a bool for each package that says if it must be trusted when the |
|---|
| 74 | module M is being checked for trust. This list of trust required packages for a |
|---|
| 75 | single import is gathered in the rnImportDecl function and stored in an |
|---|
| 76 | ImportAvails data structure. The union of these trust required packages for all |
|---|
| 77 | imports is done by the rnImports function using the combine function which calls |
|---|
| 78 | the plusImportAvails function that is a union operation for the ImportAvails |
|---|
| 79 | type. This gives us in an ImportAvails structure all packages required to be |
|---|
| 80 | trusted for the module we are currently compiling. Checking that these packages |
|---|
| 81 | are still trusted (and that direct imports are trusted) is done in |
|---|
| 82 | HscMain.checkSafeImports. |
|---|
| 83 | |
|---|
| 84 | See the note below, [Trust Own Package] for a corner case in this method and |
|---|
| 85 | how its handled. |
|---|
| 86 | |
|---|
| 87 | |
|---|
| 88 | Note [Trust Own Package] |
|---|
| 89 | ~~~~~~~~~~~~~~~~~~~~~~~~ |
|---|
| 90 | There is a corner case of package trust checking that the usual transitive check |
|---|
| 91 | doesn't cover. (For how the usual check operates see the Note [Tracking Trust |
|---|
| 92 | Transitively] below). The case is when you import a -XSafe module M and M |
|---|
| 93 | imports a -XTrustworthy module N. If N resides in a different package than M, |
|---|
| 94 | then the usual check works as M will record a package dependency on N's package |
|---|
| 95 | and mark it as required to be trusted. If N resides in the same package as M |
|---|
| 96 | though, then importing M should require its own package be trusted due to N |
|---|
| 97 | (since M is -XSafe so doesn't create this requirement by itself). The usual |
|---|
| 98 | check fails as a module doesn't record a package dependency of its own package. |
|---|
| 99 | So instead we now have a bool field in a modules interface file that simply |
|---|
| 100 | states if the module requires its own package to be trusted. This field avoids |
|---|
| 101 | us having to load all interface files that the module depends on to see if one |
|---|
| 102 | is trustworthy. |
|---|
| 103 | |
|---|
| 104 | |
|---|
| 105 | Note [Trust Transitive Property] |
|---|
| 106 | ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
|---|
| 107 | So there is an interesting design question in regards to transitive trust |
|---|
| 108 | checking. Say I have a module B compiled with -XSafe. B is dependent on a bunch |
|---|
| 109 | of modules and packages, some packages it requires to be trusted as its using |
|---|
| 110 | -XTrustworthy modules from them. Now if I have a module A that doesn't use safe |
|---|
| 111 | haskell at all and simply imports B, should A inherit all the the trust |
|---|
| 112 | requirements from B? Should A now also require that a package p is trusted since |
|---|
| 113 | B required it? |
|---|
| 114 | |
|---|
| 115 | We currently say no but saying yes also makes sense. The difference is, if a |
|---|
| 116 | module M that doesn't use Safe Haskell imports a module N that does, should all |
|---|
| 117 | the trusted package requirements be dropped since M didn't declare that it cares |
|---|
| 118 | about Safe Haskell (so -XSafe is more strongly associated with the module doing |
|---|
| 119 | the importing) or should it be done still since the author of the module N that |
|---|
| 120 | uses Safe Haskell said they cared (so -XSafe is more strongly associated with |
|---|
| 121 | the module that was compiled that used it). |
|---|
| 122 | |
|---|
| 123 | Going with yes is a simpler semantics we think and harder for the user to stuff |
|---|
| 124 | up but it does mean that Safe Haskell will affect users who don't care about |
|---|
| 125 | Safe Haskell as they might grab a package from Cabal which uses safe haskell (say |
|---|
| 126 | network) and that packages imports -XTrustworthy modules from another package |
|---|
| 127 | (say bytestring), so requires that package is trusted. The user may now get |
|---|
| 128 | compilation errors in code that doesn't do anything with Safe Haskell simply |
|---|
| 129 | because they are using the network package. They will have to call 'ghc-pkg |
|---|
| 130 | trust network' to get everything working. Due to this invasive nature of going |
|---|
| 131 | with yes we have gone with no for now. |
|---|
| 132 | |
|---|
| 133 | |
|---|
| 134 | \begin{code} |
|---|
| 135 | -- | Process Import Decls |
|---|
| 136 | -- Do the non SOURCE ones first, so that we get a helpful warning for SOURCE |
|---|
| 137 | -- ones that are unnecessary |
|---|
| 138 | rnImports :: [LImportDecl RdrName] |
|---|
| 139 | -> RnM ([LImportDecl Name], GlobalRdrEnv, ImportAvails, AnyHpcUsage) |
|---|
| 140 | rnImports imports = do |
|---|
| 141 | this_mod <- getModule |
|---|
| 142 | let (source, ordinary) = partition is_source_import imports |
|---|
| 143 | is_source_import d = ideclSource (unLoc d) |
|---|
| 144 | stuff1 <- mapM (rnImportDecl this_mod) ordinary |
|---|
| 145 | stuff2 <- mapM (rnImportDecl this_mod) source |
|---|
| 146 | -- Safe Haskell: See Note [Tracking Trust Transitively] |
|---|
| 147 | let (decls, rdr_env, imp_avails, hpc_usage) = combine (stuff1 ++ stuff2) |
|---|
| 148 | return (decls, rdr_env, imp_avails, hpc_usage) |
|---|
| 149 | |
|---|
| 150 | where |
|---|
| 151 | combine :: [(LImportDecl Name, GlobalRdrEnv, ImportAvails, AnyHpcUsage)] |
|---|
| 152 | -> ([LImportDecl Name], GlobalRdrEnv, ImportAvails, AnyHpcUsage) |
|---|
| 153 | combine = foldr plus ([], emptyGlobalRdrEnv, emptyImportAvails, False) |
|---|
| 154 | |
|---|
| 155 | plus (decl, gbl_env1, imp_avails1,hpc_usage1) |
|---|
| 156 | (decls, gbl_env2, imp_avails2,hpc_usage2) |
|---|
| 157 | = ( decl:decls, |
|---|
| 158 | gbl_env1 `plusGlobalRdrEnv` gbl_env2, |
|---|
| 159 | imp_avails1 `plusImportAvails` imp_avails2, |
|---|
| 160 | hpc_usage1 || hpc_usage2 ) |
|---|
| 161 | |
|---|
| 162 | rnImportDecl :: Module -> LImportDecl RdrName |
|---|
| 163 | -> RnM (LImportDecl Name, GlobalRdrEnv, ImportAvails, AnyHpcUsage) |
|---|
| 164 | rnImportDecl this_mod |
|---|
| 165 | (L loc decl@(ImportDecl { ideclName = loc_imp_mod_name, ideclPkgQual = mb_pkg |
|---|
| 166 | , ideclSource = want_boot, ideclSafe = mod_safe |
|---|
| 167 | , ideclQualified = qual_only, ideclImplicit = implicit |
|---|
| 168 | , ideclAs = as_mod, ideclHiding = imp_details })) |
|---|
| 169 | = setSrcSpan loc $ do |
|---|
| 170 | |
|---|
| 171 | when (isJust mb_pkg) $ do |
|---|
| 172 | pkg_imports <- xoptM Opt_PackageImports |
|---|
| 173 | when (not pkg_imports) $ addErr packageImportErr |
|---|
| 174 | |
|---|
| 175 | -- If there's an error in loadInterface, (e.g. interface |
|---|
| 176 | -- file not found) we get lots of spurious errors from 'filterImports' |
|---|
| 177 | let imp_mod_name = unLoc loc_imp_mod_name |
|---|
| 178 | doc = ppr imp_mod_name <+> ptext (sLit "is directly imported") |
|---|
| 179 | |
|---|
| 180 | -- Check for a missing import list (Opt_WarnMissingImportList also |
|---|
| 181 | -- checks for T(..) items but that is done in checkDodgyImport below) |
|---|
| 182 | case imp_details of |
|---|
| 183 | Just (False, _) -> return () -- Explicit import list |
|---|
| 184 | _ | implicit -> return () -- Do not bleat for implicit imports |
|---|
| 185 | | qual_only -> return () |
|---|
| 186 | | otherwise -> ifWOptM Opt_WarnMissingImportList $ |
|---|
| 187 | addWarn (missingImportListWarn imp_mod_name) |
|---|
| 188 | |
|---|
| 189 | iface <- loadSrcInterface doc imp_mod_name want_boot mb_pkg |
|---|
| 190 | |
|---|
| 191 | -- Compiler sanity check: if the import didn't say |
|---|
| 192 | -- {-# SOURCE #-} we should not get a hi-boot file |
|---|
| 193 | WARN( not want_boot && mi_boot iface, ppr imp_mod_name ) do |
|---|
| 194 | |
|---|
| 195 | -- Issue a user warning for a redundant {- SOURCE -} import |
|---|
| 196 | -- NB that we arrange to read all the ordinary imports before |
|---|
| 197 | -- any of the {- SOURCE -} imports. |
|---|
| 198 | -- |
|---|
| 199 | -- in --make and GHCi, the compilation manager checks for this, |
|---|
| 200 | -- and indeed we shouldn't do it here because the existence of |
|---|
| 201 | -- the non-boot module depends on the compilation order, which |
|---|
| 202 | -- is not deterministic. The hs-boot test can show this up. |
|---|
| 203 | dflags <- getDynFlags |
|---|
| 204 | warnIf (want_boot && not (mi_boot iface) && isOneShot (ghcMode dflags)) |
|---|
| 205 | (warnRedundantSourceImport imp_mod_name) |
|---|
| 206 | when (mod_safe && not (safeImportsOn dflags)) $ |
|---|
| 207 | addErrAt loc (ptext (sLit "safe import can't be used as Safe Haskell isn't on!") |
|---|
| 208 | $+$ ptext (sLit $ "please enable Safe Haskell through either" |
|---|
| 209 | ++ "-XSafe, -XTruswrothy or -XUnsafe")) |
|---|
| 210 | |
|---|
| 211 | let imp_mod = mi_module iface |
|---|
| 212 | warns = mi_warns iface |
|---|
| 213 | orph_iface = mi_orphan iface |
|---|
| 214 | has_finsts = mi_finsts iface |
|---|
| 215 | deps = mi_deps iface |
|---|
| 216 | trust = getSafeMode $ mi_trust iface |
|---|
| 217 | trust_pkg = mi_trust_pkg iface |
|---|
| 218 | |
|---|
| 219 | qual_mod_name = as_mod `orElse` imp_mod_name |
|---|
| 220 | imp_spec = ImpDeclSpec { is_mod = imp_mod_name, is_qual = qual_only, |
|---|
| 221 | is_dloc = loc, is_as = qual_mod_name } |
|---|
| 222 | |
|---|
| 223 | -- filter the imports according to the import declaration |
|---|
| 224 | (new_imp_details, gres) <- filterImports iface imp_spec imp_details |
|---|
| 225 | |
|---|
| 226 | let gbl_env = mkGlobalRdrEnv (filterOut from_this_mod gres) |
|---|
| 227 | from_this_mod gre = nameModule (gre_name gre) == this_mod |
|---|
| 228 | -- If the module exports anything defined in this module, just |
|---|
| 229 | -- ignore it. Reason: otherwise it looks as if there are two |
|---|
| 230 | -- local definition sites for the thing, and an error gets |
|---|
| 231 | -- reported. Easiest thing is just to filter them out up |
|---|
| 232 | -- front. This situation only arises if a module imports |
|---|
| 233 | -- itself, or another module that imported it. (Necessarily, |
|---|
| 234 | -- this invoves a loop.) |
|---|
| 235 | -- |
|---|
| 236 | -- We do this *after* filterImports, so that if you say |
|---|
| 237 | -- module A where |
|---|
| 238 | -- import B( AType ) |
|---|
| 239 | -- type AType = ... |
|---|
| 240 | -- |
|---|
| 241 | -- module B( AType ) where |
|---|
| 242 | -- import {-# SOURCE #-} A( AType ) |
|---|
| 243 | -- |
|---|
| 244 | -- then you won't get a 'B does not export AType' message. |
|---|
| 245 | |
|---|
| 246 | |
|---|
| 247 | -- Compute new transitive dependencies |
|---|
| 248 | |
|---|
| 249 | orphans | orph_iface = ASSERT( not (imp_mod `elem` dep_orphs deps) ) |
|---|
| 250 | imp_mod : dep_orphs deps |
|---|
| 251 | | otherwise = dep_orphs deps |
|---|
| 252 | |
|---|
| 253 | finsts | has_finsts = ASSERT( not (imp_mod `elem` dep_finsts deps) ) |
|---|
| 254 | imp_mod : dep_finsts deps |
|---|
| 255 | | otherwise = dep_finsts deps |
|---|
| 256 | |
|---|
| 257 | pkg = modulePackageId (mi_module iface) |
|---|
| 258 | |
|---|
| 259 | -- Does this import mean we now require our own pkg |
|---|
| 260 | -- to be trusted? See Note [Trust Own Package] |
|---|
| 261 | ptrust = trust == Sf_Trustworthy || trust_pkg |
|---|
| 262 | |
|---|
| 263 | (dependent_mods, dependent_pkgs, pkg_trust_req) |
|---|
| 264 | | pkg == thisPackage dflags = |
|---|
| 265 | -- Imported module is from the home package |
|---|
| 266 | -- Take its dependent modules and add imp_mod itself |
|---|
| 267 | -- Take its dependent packages unchanged |
|---|
| 268 | -- |
|---|
| 269 | -- NB: (dep_mods deps) might include a hi-boot file |
|---|
| 270 | -- for the module being compiled, CM. Do *not* filter |
|---|
| 271 | -- this out (as we used to), because when we've |
|---|
| 272 | -- finished dealing with the direct imports we want to |
|---|
| 273 | -- know if any of them depended on CM.hi-boot, in |
|---|
| 274 | -- which case we should do the hi-boot consistency |
|---|
| 275 | -- check. See LoadIface.loadHiBootInterface |
|---|
| 276 | ((imp_mod_name, want_boot) : dep_mods deps, dep_pkgs deps, ptrust) |
|---|
| 277 | |
|---|
| 278 | | otherwise = |
|---|
| 279 | -- Imported module is from another package |
|---|
| 280 | -- Dump the dependent modules |
|---|
| 281 | -- Add the package imp_mod comes from to the dependent packages |
|---|
| 282 | ASSERT2( not (pkg `elem` (map fst $ dep_pkgs deps)) |
|---|
| 283 | , ppr pkg <+> ppr (dep_pkgs deps) ) |
|---|
| 284 | ([], (pkg, False) : dep_pkgs deps, False) |
|---|
| 285 | |
|---|
| 286 | -- True <=> import M () |
|---|
| 287 | import_all = case imp_details of |
|---|
| 288 | Just (is_hiding, ls) -> not is_hiding && null ls |
|---|
| 289 | _ -> False |
|---|
| 290 | |
|---|
| 291 | -- should the import be safe? |
|---|
| 292 | mod_safe' = mod_safe |
|---|
| 293 | || (not implicit && safeDirectImpsReq dflags) |
|---|
| 294 | || (implicit && safeImplicitImpsReq dflags) |
|---|
| 295 | |
|---|
| 296 | imports = ImportAvails { |
|---|
| 297 | imp_mods = unitModuleEnv imp_mod |
|---|
| 298 | [(qual_mod_name, import_all, loc, mod_safe')], |
|---|
| 299 | imp_orphs = orphans, |
|---|
| 300 | imp_finsts = finsts, |
|---|
| 301 | imp_dep_mods = mkModDeps dependent_mods, |
|---|
| 302 | imp_dep_pkgs = map fst $ dependent_pkgs, |
|---|
| 303 | -- Add in the imported modules trusted package |
|---|
| 304 | -- requirements. ONLY do this though if we import the |
|---|
| 305 | -- module as a safe import. |
|---|
| 306 | -- See Note [Tracking Trust Transitively] |
|---|
| 307 | -- and Note [Trust Transitive Property] |
|---|
| 308 | imp_trust_pkgs = if mod_safe' |
|---|
| 309 | then map fst $ filter snd dependent_pkgs |
|---|
| 310 | else [], |
|---|
| 311 | -- Do we require our own pkg to be trusted? |
|---|
| 312 | -- See Note [Trust Own Package] |
|---|
| 313 | imp_trust_own_pkg = pkg_trust_req |
|---|
| 314 | } |
|---|
| 315 | |
|---|
| 316 | -- Complain if we import a deprecated module |
|---|
| 317 | ifWOptM Opt_WarnWarningsDeprecations ( |
|---|
| 318 | case warns of |
|---|
| 319 | WarnAll txt -> addWarn $ moduleWarn imp_mod_name txt |
|---|
| 320 | _ -> return () |
|---|
| 321 | ) |
|---|
| 322 | |
|---|
| 323 | let new_imp_decl = L loc (decl { ideclSafe = mod_safe' |
|---|
| 324 | , ideclHiding = new_imp_details }) |
|---|
| 325 | |
|---|
| 326 | return (new_imp_decl, gbl_env, imports, mi_hpc iface) |
|---|
| 327 | |
|---|
| 328 | warnRedundantSourceImport :: ModuleName -> SDoc |
|---|
| 329 | warnRedundantSourceImport mod_name |
|---|
| 330 | = ptext (sLit "Unnecessary {-# SOURCE #-} in the import of module") |
|---|
| 331 | <+> quotes (ppr mod_name) |
|---|
| 332 | \end{code} |
|---|
| 333 | |
|---|
| 334 | |
|---|
| 335 | %************************************************************************ |
|---|
| 336 | %* * |
|---|
| 337 | \subsection{importsFromLocalDecls} |
|---|
| 338 | %* * |
|---|
| 339 | %************************************************************************ |
|---|
| 340 | |
|---|
| 341 | From the top-level declarations of this module produce |
|---|
| 342 | * the lexical environment |
|---|
| 343 | * the ImportAvails |
|---|
| 344 | created by its bindings. |
|---|
| 345 | |
|---|
| 346 | Note [Top-level Names in Template Haskell decl quotes] |
|---|
| 347 | ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
|---|
| 348 | Consider a Template Haskell declaration quotation like this: |
|---|
| 349 | module M where |
|---|
| 350 | f x = h [d| f = 3 |] |
|---|
| 351 | When renaming the declarations inside [d| ...|], we treat the |
|---|
| 352 | top level binders specially in two ways |
|---|
| 353 | |
|---|
| 354 | 1. We give them an Internal name, not (as usual) an External one. |
|---|
| 355 | Otherwise the NameCache gets confused by a second allocation of |
|---|
| 356 | M.f. (We used to invent a fake module ThFake to avoid this, but |
|---|
| 357 | that had other problems, notably in getting the correct answer for |
|---|
| 358 | nameIsLocalOrFrom in lookupFixity. So we now leave tcg_module |
|---|
| 359 | unaffected.) |
|---|
| 360 | |
|---|
| 361 | 2. We make them *shadow* the outer bindings. If we don't do that, |
|---|
| 362 | we'll get a complaint when extending the GlobalRdrEnv, saying that |
|---|
| 363 | there are two bindings for 'f'. There are several tricky points: |
|---|
| 364 | |
|---|
| 365 | * This shadowing applies even if the binding for 'f' is in a |
|---|
| 366 | where-clause, and hence is in the *local* RdrEnv not the *global* |
|---|
| 367 | RdrEnv. |
|---|
| 368 | |
|---|
| 369 | * The *qualified* name M.f from the enclosing module must certainly |
|---|
| 370 | still be available. So we don't nuke it entirely; we just make |
|---|
| 371 | it seem like qualified import. |
|---|
| 372 | |
|---|
| 373 | * We only shadow *External* names (which come from the main module) |
|---|
| 374 | Do not shadow *Inernal* names because in the bracket |
|---|
| 375 | [d| class C a where f :: a |
|---|
| 376 | f = 4 |] |
|---|
| 377 | rnSrcDecls will first call extendGlobalRdrEnvRn with C[f] from the |
|---|
| 378 | class decl, and *separately* extend the envt with the value binding. |
|---|
| 379 | |
|---|
| 380 | 3. We find out whether we are inside a [d| ... |] by testing the TH |
|---|
| 381 | stage. This is a slight hack, because the stage field was really |
|---|
| 382 | meant for the type checker, and here we are not interested in the |
|---|
| 383 | fields of Brack, hence the error thunks in thRnBrack. |
|---|
| 384 | |
|---|
| 385 | \begin{code} |
|---|
| 386 | extendGlobalRdrEnvRn :: [AvailInfo] |
|---|
| 387 | -> MiniFixityEnv |
|---|
| 388 | -> RnM (TcGblEnv, TcLclEnv) |
|---|
| 389 | -- Updates both the GlobalRdrEnv and the FixityEnv |
|---|
| 390 | -- We return a new TcLclEnv only because we might have to |
|---|
| 391 | -- delete some bindings from it; |
|---|
| 392 | -- see Note [Top-level Names in Template Haskell decl quotes] |
|---|
| 393 | |
|---|
| 394 | extendGlobalRdrEnvRn avails new_fixities |
|---|
| 395 | = do { (gbl_env, lcl_env) <- getEnvs |
|---|
| 396 | ; stage <- getStage |
|---|
| 397 | ; isGHCi <- getIsGHCi |
|---|
| 398 | ; let rdr_env = tcg_rdr_env gbl_env |
|---|
| 399 | fix_env = tcg_fix_env gbl_env |
|---|
| 400 | |
|---|
| 401 | -- Delete new_occs from global and local envs |
|---|
| 402 | -- If we are in a TemplateHaskell decl bracket, |
|---|
| 403 | -- we are going to shadow them |
|---|
| 404 | -- See Note [Top-level Names in Template Haskell decl quotes] |
|---|
| 405 | shadowP = isBrackStage stage |
|---|
| 406 | new_occs = map (nameOccName . gre_name) gres |
|---|
| 407 | rdr_env_TH = transformGREs qual_gre new_occs rdr_env |
|---|
| 408 | rdr_env_GHCi = delListFromOccEnv rdr_env new_occs |
|---|
| 409 | |
|---|
| 410 | lcl_env1 = lcl_env { tcl_rdr = delLocalRdrEnvList (tcl_rdr lcl_env) new_occs } |
|---|
| 411 | (rdr_env2, lcl_env2) | shadowP = (rdr_env_TH, lcl_env1) |
|---|
| 412 | | isGHCi = (rdr_env_GHCi, lcl_env1) |
|---|
| 413 | | otherwise = (rdr_env, lcl_env) |
|---|
| 414 | |
|---|
| 415 | rdr_env3 = foldl extendGlobalRdrEnv rdr_env2 gres |
|---|
| 416 | fix_env' = foldl extend_fix_env fix_env gres |
|---|
| 417 | (rdr_env', dups) = findLocalDupsRdrEnv rdr_env3 new_occs |
|---|
| 418 | |
|---|
| 419 | gbl_env' = gbl_env { tcg_rdr_env = rdr_env', tcg_fix_env = fix_env' } |
|---|
| 420 | |
|---|
| 421 | ; mapM_ addDupDeclErr dups |
|---|
| 422 | |
|---|
| 423 | ; traceRn (text "extendGlobalRdrEnvRn" <+> (ppr new_fixities $$ ppr fix_env $$ ppr fix_env')) |
|---|
| 424 | ; return (gbl_env', lcl_env2) } |
|---|
| 425 | where |
|---|
| 426 | gres = gresFromAvails LocalDef avails |
|---|
| 427 | |
|---|
| 428 | -- If there is a fixity decl for the gre, add it to the fixity env |
|---|
| 429 | extend_fix_env fix_env gre |
|---|
| 430 | | Just (L _ fi) <- lookupFsEnv new_fixities (occNameFS occ) |
|---|
| 431 | = extendNameEnv fix_env name (FixItem occ fi) |
|---|
| 432 | | otherwise |
|---|
| 433 | = fix_env |
|---|
| 434 | where |
|---|
| 435 | name = gre_name gre |
|---|
| 436 | occ = nameOccName name |
|---|
| 437 | |
|---|
| 438 | qual_gre :: GlobalRdrElt -> GlobalRdrElt |
|---|
| 439 | -- Transform top-level GREs from the module being compiled |
|---|
| 440 | -- so that they are out of the way of new definitions in a Template |
|---|
| 441 | -- Haskell bracket |
|---|
| 442 | -- See Note [Top-level Names in Template Haskell decl quotes] |
|---|
| 443 | -- Seems like 5 times as much work as it deserves! |
|---|
| 444 | -- |
|---|
| 445 | -- For a LocalDef we make a (fake) qualified imported GRE for a |
|---|
| 446 | -- local GRE so that the original *qualified* name is still in scope |
|---|
| 447 | -- but the *unqualified* one no longer is. What a hack! |
|---|
| 448 | |
|---|
| 449 | qual_gre gre@(GRE { gre_prov = LocalDef, gre_name = name }) |
|---|
| 450 | | isExternalName name = gre { gre_prov = Imported [imp_spec] } |
|---|
| 451 | | otherwise = gre |
|---|
| 452 | -- Do not shadow Internal (ie Template Haskell) Names |
|---|
| 453 | -- See Note [Top-level Names in Template Haskell decl quotes] |
|---|
| 454 | where |
|---|
| 455 | mod = ASSERT2( isExternalName name, ppr name) moduleName (nameModule name) |
|---|
| 456 | imp_spec = ImpSpec { is_item = ImpAll, is_decl = decl_spec } |
|---|
| 457 | decl_spec = ImpDeclSpec { is_mod = mod, is_as = mod, |
|---|
| 458 | is_qual = True, -- Qualified only! |
|---|
| 459 | is_dloc = srcLocSpan (nameSrcLoc name) } |
|---|
| 460 | |
|---|
| 461 | qual_gre gre@(GRE { gre_prov = Imported specs }) |
|---|
| 462 | = gre { gre_prov = Imported (map qual_spec specs) } |
|---|
| 463 | |
|---|
| 464 | qual_spec spec@(ImpSpec { is_decl = decl_spec }) |
|---|
| 465 | = spec { is_decl = decl_spec { is_qual = True } } |
|---|
| 466 | \end{code} |
|---|
| 467 | |
|---|
| 468 | @getLocalDeclBinders@ returns the names for an @HsDecl@. It's |
|---|
| 469 | used for source code. |
|---|
| 470 | |
|---|
| 471 | *** See "THE NAMING STORY" in HsDecls **** |
|---|
| 472 | |
|---|
| 473 | \begin{code} |
|---|
| 474 | getLocalNonValBinders :: MiniFixityEnv -> HsGroup RdrName |
|---|
| 475 | -> RnM ((TcGblEnv, TcLclEnv), NameSet) |
|---|
| 476 | -- Get all the top-level binders bound the group *except* |
|---|
| 477 | -- for value bindings, which are treated separately |
|---|
| 478 | -- Specificaly we return AvailInfo for |
|---|
| 479 | -- type decls (incl constructors and record selectors) |
|---|
| 480 | -- class decls (including class ops) |
|---|
| 481 | -- associated types |
|---|
| 482 | -- foreign imports |
|---|
| 483 | -- (in hs-boot files) value signatures |
|---|
| 484 | |
|---|
| 485 | getLocalNonValBinders fixity_env |
|---|
| 486 | (HsGroup { hs_valds = val_binds, |
|---|
| 487 | hs_tyclds = tycl_decls, |
|---|
| 488 | hs_instds = inst_decls, |
|---|
| 489 | hs_fords = foreign_decls }) |
|---|
| 490 | = do { -- Process all type/class decls *except* family instances |
|---|
| 491 | ; tc_avails <- mapM new_tc (concat tycl_decls) |
|---|
| 492 | ; envs <- extendGlobalRdrEnvRn tc_avails fixity_env |
|---|
| 493 | ; setEnvs envs $ do { |
|---|
| 494 | -- Bring these things into scope first |
|---|
| 495 | -- See Note [Looking up family names in family instances] |
|---|
| 496 | |
|---|
| 497 | -- Process all family instances |
|---|
| 498 | -- to bring new data constructors into scope |
|---|
| 499 | ; nti_avails <- concatMapM new_assoc inst_decls |
|---|
| 500 | |
|---|
| 501 | -- Finish off with value binders: |
|---|
| 502 | -- foreign decls for an ordinary module |
|---|
| 503 | -- type sigs in case of a hs-boot file only |
|---|
| 504 | ; is_boot <- tcIsHsBoot |
|---|
| 505 | ; let val_bndrs | is_boot = hs_boot_sig_bndrs |
|---|
| 506 | | otherwise = for_hs_bndrs |
|---|
| 507 | ; val_avails <- mapM new_simple val_bndrs |
|---|
| 508 | |
|---|
| 509 | ; let avails = nti_avails ++ val_avails |
|---|
| 510 | new_bndrs = availsToNameSet avails `unionNameSets` |
|---|
| 511 | availsToNameSet tc_avails |
|---|
| 512 | ; envs <- extendGlobalRdrEnvRn avails fixity_env |
|---|
| 513 | ; return (envs, new_bndrs) } } |
|---|
| 514 | where |
|---|
| 515 | for_hs_bndrs :: [Located RdrName] |
|---|
| 516 | for_hs_bndrs = [nm | L _ (ForeignImport nm _ _ _) <- foreign_decls] |
|---|
| 517 | |
|---|
| 518 | -- In a hs-boot file, the value binders come from the |
|---|
| 519 | -- *signatures*, and there should be no foreign binders |
|---|
| 520 | hs_boot_sig_bndrs = [n | L _ (TypeSig ns _) <- val_sigs, n <- ns] |
|---|
| 521 | ValBindsIn _ val_sigs = val_binds |
|---|
| 522 | |
|---|
| 523 | new_simple :: Located RdrName -> RnM AvailInfo |
|---|
| 524 | new_simple rdr_name = do{ nm <- newTopSrcBinder rdr_name |
|---|
| 525 | ; return (Avail nm) } |
|---|
| 526 | |
|---|
| 527 | new_tc tc_decl -- NOT for type/data instances |
|---|
| 528 | = do { let bndrs = hsTyClDeclBinders (unLoc tc_decl) |
|---|
| 529 | ; names@(main_name : _) <- mapM newTopSrcBinder bndrs |
|---|
| 530 | ; return (AvailTC main_name names) } |
|---|
| 531 | |
|---|
| 532 | new_assoc :: LInstDecl RdrName -> RnM [AvailInfo] |
|---|
| 533 | new_assoc (L _ (FamInstD { lid_inst = d })) |
|---|
| 534 | = do { avail <- new_ti Nothing d |
|---|
| 535 | ; return [avail] } |
|---|
| 536 | new_assoc (L _ (ClsInstD { cid_poly_ty = inst_ty, cid_fam_insts = ats })) |
|---|
| 537 | | Just (_, _, L loc cls_rdr, _) <- splitLHsInstDeclTy_maybe inst_ty |
|---|
| 538 | = do { cls_nm <- setSrcSpan loc $ lookupGlobalOccRn cls_rdr |
|---|
| 539 | ; mapM (new_ti (Just cls_nm) . unLoc) ats } |
|---|
| 540 | | otherwise |
|---|
| 541 | = return [] -- Do not crash on ill-formed instances |
|---|
| 542 | -- Eg instance !Show Int Trac #3811c |
|---|
| 543 | |
|---|
| 544 | new_ti :: Maybe Name -> FamInstDecl RdrName -> RnM AvailInfo |
|---|
| 545 | new_ti mb_cls ti_decl -- ONLY for type/data instances |
|---|
| 546 | = do { main_name <- lookupFamInstName mb_cls (fid_tycon ti_decl) |
|---|
| 547 | ; sub_names <- mapM newTopSrcBinder (hsFamInstBinders ti_decl) |
|---|
| 548 | ; return (AvailTC (unLoc main_name) sub_names) } |
|---|
| 549 | -- main_name is not bound here! |
|---|
| 550 | \end{code} |
|---|
| 551 | |
|---|
| 552 | Note [Looking up family names in family instances] |
|---|
| 553 | ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
|---|
| 554 | Consider |
|---|
| 555 | |
|---|
| 556 | module M where |
|---|
| 557 | type family T a :: * |
|---|
| 558 | type instance M.T Int = Bool |
|---|
| 559 | |
|---|
| 560 | We might think that we can simply use 'lookupOccRn' when processing the type |
|---|
| 561 | instance to look up 'M.T'. Alas, we can't! The type family declaration is in |
|---|
| 562 | the *same* HsGroup as the type instance declaration. Hence, as we are |
|---|
| 563 | currently collecting the binders declared in that HsGroup, these binders will |
|---|
| 564 | not have been added to the global environment yet. |
|---|
| 565 | |
|---|
| 566 | Solution is simple: process the type family declarations first, extend |
|---|
| 567 | the environment, and then process the type instances. |
|---|
| 568 | |
|---|
| 569 | |
|---|
| 570 | %************************************************************************ |
|---|
| 571 | %* * |
|---|
| 572 | \subsection{Filtering imports} |
|---|
| 573 | %* * |
|---|
| 574 | %************************************************************************ |
|---|
| 575 | |
|---|
| 576 | @filterImports@ takes the @ExportEnv@ telling what the imported module makes |
|---|
| 577 | available, and filters it through the import spec (if any). |
|---|
| 578 | |
|---|
| 579 | \begin{code} |
|---|
| 580 | filterImports :: ModIface |
|---|
| 581 | -> ImpDeclSpec -- The span for the entire import decl |
|---|
| 582 | -> Maybe (Bool, [LIE RdrName]) -- Import spec; True => hiding |
|---|
| 583 | -> RnM (Maybe (Bool, [LIE Name]), -- Import spec w/ Names |
|---|
| 584 | [GlobalRdrElt]) -- Same again, but in GRE form |
|---|
| 585 | filterImports iface decl_spec Nothing |
|---|
| 586 | = return (Nothing, gresFromAvails prov (mi_exports iface)) |
|---|
| 587 | where |
|---|
| 588 | prov = Imported [ImpSpec { is_decl = decl_spec, is_item = ImpAll }] |
|---|
| 589 | |
|---|
| 590 | |
|---|
| 591 | filterImports iface decl_spec (Just (want_hiding, import_items)) |
|---|
| 592 | = do -- check for errors, convert RdrNames to Names |
|---|
| 593 | opt_typeFamilies <- xoptM Opt_TypeFamilies |
|---|
| 594 | items1 <- mapM (lookup_lie opt_typeFamilies) import_items |
|---|
| 595 | |
|---|
| 596 | let items2 :: [(LIE Name, AvailInfo)] |
|---|
| 597 | items2 = concat items1 |
|---|
| 598 | -- NB the AvailInfo may have duplicates, and several items |
|---|
| 599 | -- for the same parent; e.g N(x) and N(y) |
|---|
| 600 | |
|---|
| 601 | names = availsToNameSet (map snd items2) |
|---|
| 602 | keep n = not (n `elemNameSet` names) |
|---|
| 603 | pruned_avails = filterAvails keep all_avails |
|---|
| 604 | hiding_prov = Imported [ImpSpec { is_decl = decl_spec, is_item = ImpAll }] |
|---|
| 605 | |
|---|
| 606 | gres | want_hiding = gresFromAvails hiding_prov pruned_avails |
|---|
| 607 | | otherwise = concatMap (gresFromIE decl_spec) items2 |
|---|
| 608 | |
|---|
| 609 | return (Just (want_hiding, map fst items2), gres) |
|---|
| 610 | where |
|---|
| 611 | all_avails = mi_exports iface |
|---|
| 612 | |
|---|
| 613 | -- This environment is how we map names mentioned in the import |
|---|
| 614 | -- list to the actual Name they correspond to, and the name family |
|---|
| 615 | -- that the Name belongs to (the AvailInfo). The situation is |
|---|
| 616 | -- complicated by associated families, which introduce a three-level |
|---|
| 617 | -- hierachy, where class = grand parent, assoc family = parent, and |
|---|
| 618 | -- data constructors = children. The occ_env entries for associated |
|---|
| 619 | -- families needs to capture all this information; hence, we have the |
|---|
| 620 | -- third component of the environment that gives the class name (= |
|---|
| 621 | -- grand parent) in case of associated families. |
|---|
| 622 | -- |
|---|
| 623 | -- This env will have entries for data constructors too, |
|---|
| 624 | -- they won't make any difference because naked entities like T |
|---|
| 625 | -- in an import list map to TcOccs, not VarOccs. |
|---|
| 626 | occ_env :: OccEnv (Name, -- the name |
|---|
| 627 | AvailInfo, -- the export item providing the name |
|---|
| 628 | Maybe Name) -- the parent of associated types |
|---|
| 629 | occ_env = mkOccEnv_C combine [ (nameOccName n, (n, a, Nothing)) |
|---|
| 630 | | a <- all_avails, n <- availNames a] |
|---|
| 631 | where |
|---|
| 632 | -- we know that (1) there are at most entries for one name, (2) their |
|---|
| 633 | -- first component is identical, (3) they are for tys/cls, and (4) one |
|---|
| 634 | -- entry has the name in its parent position (the other doesn't) |
|---|
| 635 | combine (name, AvailTC p1 subs1, Nothing) |
|---|
| 636 | (_ , AvailTC p2 subs2, Nothing) |
|---|
| 637 | = let |
|---|
| 638 | (parent, subs) = if p1 == name then (p2, subs1) else (p1, subs2) |
|---|
| 639 | in |
|---|
| 640 | (name, AvailTC name subs, Just parent) |
|---|
| 641 | combine x y = pprPanic "filterImports/combine" (ppr x $$ ppr y) |
|---|
| 642 | |
|---|
| 643 | lookup_lie :: Bool -> LIE RdrName -> TcRn [(LIE Name, AvailInfo)] |
|---|
| 644 | lookup_lie opt_typeFamilies (L loc ieRdr) |
|---|
| 645 | = do |
|---|
| 646 | stuff <- setSrcSpan loc $ |
|---|
| 647 | case lookup_ie opt_typeFamilies ieRdr of |
|---|
| 648 | Failed err -> addErr err >> return [] |
|---|
| 649 | Succeeded a -> return a |
|---|
| 650 | checkDodgyImport stuff |
|---|
| 651 | return [ (L loc ie, avail) | (ie,avail) <- stuff ] |
|---|
| 652 | where |
|---|
| 653 | -- Warn when importing T(..) if T was exported abstractly |
|---|
| 654 | checkDodgyImport stuff |
|---|
| 655 | | IEThingAll n <- ieRdr, (_, AvailTC _ [_]):_ <- stuff |
|---|
| 656 | = ifWOptM Opt_WarnDodgyImports (addWarn (dodgyImportWarn n)) |
|---|
| 657 | -- NB. use the RdrName for reporting the warning |
|---|
| 658 | | IEThingAll {} <- ieRdr |
|---|
| 659 | , not (is_qual decl_spec) |
|---|
| 660 | = ifWOptM Opt_WarnMissingImportList $ |
|---|
| 661 | addWarn (missingImportListItem ieRdr) |
|---|
| 662 | checkDodgyImport _ |
|---|
| 663 | = return () |
|---|
| 664 | |
|---|
| 665 | -- For each import item, we convert its RdrNames to Names, |
|---|
| 666 | -- and at the same time construct an AvailInfo corresponding |
|---|
| 667 | -- to what is actually imported by this item. |
|---|
| 668 | -- Returns Nothing on error. |
|---|
| 669 | -- We return a list here, because in the case of an import |
|---|
| 670 | -- item like C, if we are hiding, then C refers to *both* a |
|---|
| 671 | -- type/class and a data constructor. Moreover, when we import |
|---|
| 672 | -- data constructors of an associated family, we need separate |
|---|
| 673 | -- AvailInfos for the data constructors and the family (as they have |
|---|
| 674 | -- different parents). See the discussion at occ_env. |
|---|
| 675 | lookup_ie :: Bool -> IE RdrName -> MaybeErr MsgDoc [(IE Name,AvailInfo)] |
|---|
| 676 | lookup_ie opt_typeFamilies ie |
|---|
| 677 | = let bad_ie :: MaybeErr MsgDoc a |
|---|
| 678 | bad_ie = Failed (badImportItemErr iface decl_spec ie all_avails) |
|---|
| 679 | |
|---|
| 680 | lookup_name rdr |
|---|
| 681 | | isQual rdr = Failed (qualImportItemErr rdr) |
|---|
| 682 | | Just nm <- lookupOccEnv occ_env (rdrNameOcc rdr) = return nm |
|---|
| 683 | | otherwise = bad_ie |
|---|
| 684 | in |
|---|
| 685 | case ie of |
|---|
| 686 | IEVar n -> do |
|---|
| 687 | (name, avail, _) <- lookup_name n |
|---|
| 688 | return [(IEVar name, trimAvail avail name)] |
|---|
| 689 | |
|---|
| 690 | IEThingAll tc -> do |
|---|
| 691 | (name, avail@(AvailTC name2 subs), mb_parent) <- lookup_name tc |
|---|
| 692 | case mb_parent of |
|---|
| 693 | -- non-associated ty/cls |
|---|
| 694 | Nothing -> return [(IEThingAll name, avail)] |
|---|
| 695 | -- associated ty |
|---|
| 696 | Just parent -> return [(IEThingAll name, |
|---|
| 697 | AvailTC name2 (subs \\ [name])), |
|---|
| 698 | (IEThingAll name, AvailTC parent [name])] |
|---|
| 699 | |
|---|
| 700 | IEThingAbs tc |
|---|
| 701 | | want_hiding -- hiding ( C ) |
|---|
| 702 | -- Here the 'C' can be a data constructor |
|---|
| 703 | -- *or* a type/class, or even both |
|---|
| 704 | -> let tc_name = lookup_name tc |
|---|
| 705 | dc_name = lookup_name (setRdrNameSpace tc srcDataName) |
|---|
| 706 | in |
|---|
| 707 | case catMaybeErr [ tc_name, dc_name ] of |
|---|
| 708 | [] -> bad_ie |
|---|
| 709 | names -> return [mkIEThingAbs name | name <- names] |
|---|
| 710 | | otherwise |
|---|
| 711 | -> do nameAvail <- lookup_name tc |
|---|
| 712 | return [mkIEThingAbs nameAvail] |
|---|
| 713 | |
|---|
| 714 | IEThingWith tc ns -> do |
|---|
| 715 | (name, AvailTC _ subnames, mb_parent) <- lookup_name tc |
|---|
| 716 | let |
|---|
| 717 | env = mkOccEnv [(nameOccName s, s) | s <- subnames] |
|---|
| 718 | mb_children = map (lookupOccEnv env . rdrNameOcc) ns |
|---|
| 719 | children <- if any isNothing mb_children |
|---|
| 720 | then bad_ie |
|---|
| 721 | else return (catMaybes mb_children) |
|---|
| 722 | -- check for proper import of type families |
|---|
| 723 | when (not opt_typeFamilies && any isTyConName children) $ |
|---|
| 724 | Failed (typeItemErr (head . filter isTyConName $ children) |
|---|
| 725 | (text "in import list")) |
|---|
| 726 | case mb_parent of |
|---|
| 727 | -- non-associated ty/cls |
|---|
| 728 | Nothing -> return [(IEThingWith name children, |
|---|
| 729 | AvailTC name (name:children))] |
|---|
| 730 | -- associated ty |
|---|
| 731 | Just parent -> return [(IEThingWith name children, |
|---|
| 732 | AvailTC name children), |
|---|
| 733 | (IEThingWith name children, |
|---|
| 734 | AvailTC parent [name])] |
|---|
| 735 | |
|---|
| 736 | _other -> Failed illegalImportItemErr |
|---|
| 737 | -- could be IEModuleContents, IEGroup, IEDoc, IEDocNamed |
|---|
| 738 | -- all errors. |
|---|
| 739 | |
|---|
| 740 | where |
|---|
| 741 | mkIEThingAbs (n, av, Nothing ) = (IEThingAbs n, trimAvail av n) |
|---|
| 742 | mkIEThingAbs (n, _, Just parent) = (IEThingAbs n, AvailTC parent [n]) |
|---|
| 743 | |
|---|
| 744 | |
|---|
| 745 | catMaybeErr :: [MaybeErr err a] -> [a] |
|---|
| 746 | catMaybeErr ms = [ a | Succeeded a <- ms ] |
|---|
| 747 | \end{code} |
|---|
| 748 | |
|---|
| 749 | %************************************************************************ |
|---|
| 750 | %* * |
|---|
| 751 | \subsection{Import/Export Utils} |
|---|
| 752 | %* * |
|---|
| 753 | %************************************************************************ |
|---|
| 754 | |
|---|
| 755 | \begin{code} |
|---|
| 756 | greExportAvail :: GlobalRdrElt -> AvailInfo |
|---|
| 757 | greExportAvail gre |
|---|
| 758 | = case gre_par gre of |
|---|
| 759 | ParentIs p -> AvailTC p [me] |
|---|
| 760 | NoParent | isTyConName me -> AvailTC me [me] |
|---|
| 761 | | otherwise -> Avail me |
|---|
| 762 | where |
|---|
| 763 | me = gre_name gre |
|---|
| 764 | |
|---|
| 765 | plusAvail :: AvailInfo -> AvailInfo -> AvailInfo |
|---|
| 766 | plusAvail a1 a2 |
|---|
| 767 | | debugIsOn && availName a1 /= availName a2 |
|---|
| 768 | = pprPanic "RnEnv.plusAvail names differ" (hsep [ppr a1,ppr a2]) |
|---|
| 769 | plusAvail a1@(Avail {}) (Avail {}) = a1 |
|---|
| 770 | plusAvail (AvailTC _ []) a2@(AvailTC {}) = a2 |
|---|
| 771 | plusAvail a1@(AvailTC {}) (AvailTC _ []) = a1 |
|---|
| 772 | plusAvail (AvailTC n1 (s1:ss1)) (AvailTC n2 (s2:ss2)) |
|---|
| 773 | = case (n1==s1, n2==s2) of -- Maintain invariant the parent is first |
|---|
| 774 | (True,True) -> AvailTC n1 (s1 : (ss1 `unionLists` ss2)) |
|---|
| 775 | (True,False) -> AvailTC n1 (s1 : (ss1 `unionLists` (s2:ss2))) |
|---|
| 776 | (False,True) -> AvailTC n1 (s2 : ((s1:ss1) `unionLists` ss2)) |
|---|
| 777 | (False,False) -> AvailTC n1 ((s1:ss1) `unionLists` (s2:ss2)) |
|---|
| 778 | plusAvail a1 a2 = pprPanic "RnEnv.plusAvail" (hsep [ppr a1,ppr a2]) |
|---|
| 779 | |
|---|
| 780 | trimAvail :: AvailInfo -> Name -> AvailInfo |
|---|
| 781 | trimAvail (Avail n) _ = Avail n |
|---|
| 782 | trimAvail (AvailTC n ns) m = ASSERT( m `elem` ns) AvailTC n [m] |
|---|
| 783 | |
|---|
| 784 | -- | filters 'AvailInfo's by the given predicate |
|---|
| 785 | filterAvails :: (Name -> Bool) -> [AvailInfo] -> [AvailInfo] |
|---|
| 786 | filterAvails keep avails = foldr (filterAvail keep) [] avails |
|---|
| 787 | |
|---|
| 788 | -- | filters an 'AvailInfo' by the given predicate |
|---|
| 789 | filterAvail :: (Name -> Bool) -> AvailInfo -> [AvailInfo] -> [AvailInfo] |
|---|
| 790 | filterAvail keep ie rest = |
|---|
| 791 | case ie of |
|---|
| 792 | Avail n | keep n -> ie : rest |
|---|
| 793 | | otherwise -> rest |
|---|
| 794 | AvailTC tc ns -> |
|---|
| 795 | let left = filter keep ns in |
|---|
| 796 | if null left then rest else AvailTC tc left : rest |
|---|
| 797 | |
|---|
| 798 | -- | Given an import\/export spec, construct the appropriate 'GlobalRdrElt's. |
|---|
| 799 | gresFromIE :: ImpDeclSpec -> (LIE Name, AvailInfo) -> [GlobalRdrElt] |
|---|
| 800 | gresFromIE decl_spec (L loc ie, avail) |
|---|
| 801 | = gresFromAvail prov_fn avail |
|---|
| 802 | where |
|---|
| 803 | is_explicit = case ie of |
|---|
| 804 | IEThingAll name -> \n -> n == name |
|---|
| 805 | _ -> \_ -> True |
|---|
| 806 | prov_fn name = Imported [imp_spec] |
|---|
| 807 | where |
|---|
| 808 | imp_spec = ImpSpec { is_decl = decl_spec, is_item = item_spec } |
|---|
| 809 | item_spec = ImpSome { is_explicit = is_explicit name, is_iloc = loc } |
|---|
| 810 | |
|---|
| 811 | mkChildEnv :: [GlobalRdrElt] -> NameEnv [Name] |
|---|
| 812 | mkChildEnv gres = foldr add emptyNameEnv gres |
|---|
| 813 | where |
|---|
| 814 | add (GRE { gre_name = n, gre_par = ParentIs p }) env = extendNameEnv_Acc (:) singleton env p n |
|---|
| 815 | add _ env = env |
|---|
| 816 | |
|---|
| 817 | findChildren :: NameEnv [Name] -> Name -> [Name] |
|---|
| 818 | findChildren env n = lookupNameEnv env n `orElse` [] |
|---|
| 819 | |
|---|
| 820 | -- | Combines 'AvailInfo's from the same family |
|---|
| 821 | -- 'avails' may have several items with the same availName |
|---|
| 822 | -- E.g import Ix( Ix(..), index ) |
|---|
| 823 | -- will give Ix(Ix,index,range) and Ix(index) |
|---|
| 824 | -- We want to combine these; addAvail does that |
|---|
| 825 | nubAvails :: [AvailInfo] -> [AvailInfo] |
|---|
| 826 | nubAvails avails = nameEnvElts (foldl add emptyNameEnv avails) |
|---|
| 827 | where |
|---|
| 828 | add env avail = extendNameEnv_C plusAvail env (availName avail) avail |
|---|
| 829 | \end{code} |
|---|
| 830 | |
|---|
| 831 | |
|---|
| 832 | %************************************************************************ |
|---|
| 833 | %* * |
|---|
| 834 | \subsection{Export list processing} |
|---|
| 835 | %* * |
|---|
| 836 | %************************************************************************ |
|---|
| 837 | |
|---|
| 838 | Processing the export list. |
|---|
| 839 | |
|---|
| 840 | You might think that we should record things that appear in the export |
|---|
| 841 | list as ``occurrences'' (using @addOccurrenceName@), but you'd be |
|---|
| 842 | wrong. We do check (here) that they are in scope, but there is no |
|---|
| 843 | need to slurp in their actual declaration (which is what |
|---|
| 844 | @addOccurrenceName@ forces). |
|---|
| 845 | |
|---|
| 846 | Indeed, doing so would big trouble when compiling @PrelBase@, because |
|---|
| 847 | it re-exports @GHC@, which includes @takeMVar#@, whose type includes |
|---|
| 848 | @ConcBase.StateAndSynchVar#@, and so on... |
|---|
| 849 | |
|---|
| 850 | Note [Exports of data families] |
|---|
| 851 | ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
|---|
| 852 | Suppose you see (Trac #5306) |
|---|
| 853 | module M where |
|---|
| 854 | import X( F ) |
|---|
| 855 | data instance F Int = FInt |
|---|
| 856 | What does M export? AvailTC F [FInt] |
|---|
| 857 | or AvailTC F [F,FInt]? |
|---|
| 858 | The former is strictly right because F isn't defined in this module. |
|---|
| 859 | But then you can never do an explicit import of M, thus |
|---|
| 860 | import M( F( FInt ) ) |
|---|
| 861 | becuase F isn't exported by M. Nor can you import FInt alone from here |
|---|
| 862 | import M( FInt ) |
|---|
| 863 | because we don't have syntax to support that. (It looks like an import of |
|---|
| 864 | the type FInt.) |
|---|
| 865 | |
|---|
| 866 | At one point I implemented a compromise: |
|---|
| 867 | * When constructing exports with no export list, or with module M( |
|---|
| 868 | module M ), we add the parent to the exports as well. |
|---|
| 869 | * But not when you see module M( f ), even if f is a |
|---|
| 870 | class method with a parent. |
|---|
| 871 | * Nor when you see module M( module N ), with N /= M. |
|---|
| 872 | |
|---|
| 873 | But the compromise seemed too much of a hack, so we backed it out. |
|---|
| 874 | You just have to use an explicit export list: |
|---|
| 875 | module M( F(..) ) where ... |
|---|
| 876 | |
|---|
| 877 | \begin{code} |
|---|
| 878 | type ExportAccum -- The type of the accumulating parameter of |
|---|
| 879 | -- the main worker function in rnExports |
|---|
| 880 | = ([LIE Name], -- Export items with Names |
|---|
| 881 | ExportOccMap, -- Tracks exported occurrence names |
|---|
| 882 | [AvailInfo]) -- The accumulated exported stuff |
|---|
| 883 | -- Not nub'd! |
|---|
| 884 | |
|---|
| 885 | emptyExportAccum :: ExportAccum |
|---|
| 886 | emptyExportAccum = ([], emptyOccEnv, []) |
|---|
| 887 | |
|---|
| 888 | type ExportOccMap = OccEnv (Name, IE RdrName) |
|---|
| 889 | -- Tracks what a particular exported OccName |
|---|
| 890 | -- in an export list refers to, and which item |
|---|
| 891 | -- it came from. It's illegal to export two distinct things |
|---|
| 892 | -- that have the same occurrence name |
|---|
| 893 | |
|---|
| 894 | rnExports :: Bool -- False => no 'module M(..) where' header at all |
|---|
| 895 | -> Maybe [LIE RdrName] -- Nothing => no explicit export list |
|---|
| 896 | -> TcGblEnv |
|---|
| 897 | -> RnM TcGblEnv |
|---|
| 898 | |
|---|
| 899 | -- Complains if two distinct exports have same OccName |
|---|
| 900 | -- Warns about identical exports. |
|---|
| 901 | -- Complains about exports items not in scope |
|---|
| 902 | |
|---|
| 903 | rnExports explicit_mod exports |
|---|
| 904 | tcg_env@(TcGblEnv { tcg_mod = this_mod, |
|---|
| 905 | tcg_rdr_env = rdr_env, |
|---|
| 906 | tcg_imports = imports }) |
|---|
| 907 | = unsetWOptM Opt_WarnWarningsDeprecations $ |
|---|
| 908 | -- Do not report deprecations arising from the export |
|---|
| 909 | -- list, to avoid bleating about re-exporting a deprecated |
|---|
| 910 | -- thing (especially via 'module Foo' export item) |
|---|
| 911 | do { |
|---|
| 912 | -- If the module header is omitted altogether, then behave |
|---|
| 913 | -- as if the user had written "module Main(main) where..." |
|---|
| 914 | -- EXCEPT in interactive mode, when we behave as if he had |
|---|
| 915 | -- written "module Main where ..." |
|---|
| 916 | -- Reason: don't want to complain about 'main' not in scope |
|---|
| 917 | -- in interactive mode |
|---|
| 918 | ; dflags <- getDynFlags |
|---|
| 919 | ; let real_exports |
|---|
| 920 | | explicit_mod = exports |
|---|
| 921 | | ghcLink dflags == LinkInMemory = Nothing |
|---|
| 922 | | otherwise = Just ([noLoc (IEVar main_RDR_Unqual)]) |
|---|
| 923 | -- ToDo: the 'noLoc' here is unhelpful if 'main' |
|---|
| 924 | -- turns out to be out of scope |
|---|
| 925 | |
|---|
| 926 | ; (rn_exports, avails) <- exports_from_avail real_exports rdr_env imports this_mod |
|---|
| 927 | ; let final_avails = nubAvails avails -- Combine families |
|---|
| 928 | |
|---|
| 929 | ; traceRn (text "rnExports: Exports:" <+> ppr final_avails) |
|---|
| 930 | |
|---|
| 931 | ; return (tcg_env { tcg_exports = final_avails, |
|---|
| 932 | tcg_rn_exports = case tcg_rn_exports tcg_env of |
|---|
| 933 | Nothing -> Nothing |
|---|
| 934 | Just _ -> rn_exports, |
|---|
| 935 | tcg_dus = tcg_dus tcg_env `plusDU` |
|---|
| 936 | usesOnly (availsToNameSet final_avails) }) } |
|---|
| 937 | |
|---|
| 938 | exports_from_avail :: Maybe [LIE RdrName] |
|---|
| 939 | -- Nothing => no explicit export list |
|---|
| 940 | -> GlobalRdrEnv |
|---|
| 941 | -> ImportAvails |
|---|
| 942 | -> Module |
|---|
| 943 | -> RnM (Maybe [LIE Name], [AvailInfo]) |
|---|
| 944 | |
|---|
| 945 | exports_from_avail Nothing rdr_env _imports _this_mod |
|---|
| 946 | = -- The same as (module M) where M is the current module name, |
|---|
| 947 | -- so that's how we handle it. |
|---|
| 948 | let |
|---|
| 949 | avails = [ greExportAvail gre |
|---|
| 950 | | gre <- globalRdrEnvElts rdr_env |
|---|
| 951 | , isLocalGRE gre ] |
|---|
| 952 | in |
|---|
| 953 | return (Nothing, avails) |
|---|
| 954 | |
|---|
| 955 | exports_from_avail (Just rdr_items) rdr_env imports this_mod |
|---|
| 956 | = do (ie_names, _, exports) <- foldlM do_litem emptyExportAccum rdr_items |
|---|
| 957 | |
|---|
| 958 | return (Just ie_names, exports) |
|---|
| 959 | where |
|---|
| 960 | do_litem :: ExportAccum -> LIE RdrName -> RnM ExportAccum |
|---|
| 961 | do_litem acc lie = setSrcSpan (getLoc lie) (exports_from_item acc lie) |
|---|
| 962 | |
|---|
| 963 | kids_env :: NameEnv [Name] -- Maps a parent to its in-scope children |
|---|
| 964 | kids_env = mkChildEnv (globalRdrEnvElts rdr_env) |
|---|
| 965 | |
|---|
| 966 | imported_modules = [ qual_name |
|---|
| 967 | | xs <- moduleEnvElts $ imp_mods imports, |
|---|
| 968 | (qual_name, _, _, _) <- xs ] |
|---|
| 969 | |
|---|
| 970 | exports_from_item :: ExportAccum -> LIE RdrName -> RnM ExportAccum |
|---|
| 971 | exports_from_item acc@(ie_names, occs, exports) |
|---|
| 972 | (L loc (IEModuleContents mod)) |
|---|
| 973 | | let earlier_mods = [ mod | (L _ (IEModuleContents mod)) <- ie_names ] |
|---|
| 974 | , mod `elem` earlier_mods -- Duplicate export of M |
|---|
| 975 | = do { warn_dup_exports <- woptM Opt_WarnDuplicateExports ; |
|---|
| 976 | warnIf warn_dup_exports (dupModuleExport mod) ; |
|---|
| 977 | return acc } |
|---|
| 978 | |
|---|
| 979 | | otherwise |
|---|
| 980 | = do { implicit_prelude <- xoptM Opt_ImplicitPrelude |
|---|
| 981 | ; warnDodgyExports <- woptM Opt_WarnDodgyExports |
|---|
| 982 | ; let { exportValid = (mod `elem` imported_modules) |
|---|
| 983 | || (moduleName this_mod == mod) |
|---|
| 984 | ; gres = filter (isModuleExported implicit_prelude mod) |
|---|
| 985 | (globalRdrEnvElts rdr_env) |
|---|
| 986 | ; new_exports = map greExportAvail gres |
|---|
| 987 | ; names = map gre_name gres } |
|---|
| 988 | |
|---|
| 989 | ; checkErr exportValid (moduleNotImported mod) |
|---|
| 990 | ; warnIf (warnDodgyExports && exportValid && null names) |
|---|
| 991 | (nullModuleExport mod) |
|---|
| 992 | |
|---|
| 993 | ; addUsedRdrNames (concat [ [mkRdrQual mod occ, mkRdrUnqual occ] |
|---|
| 994 | | occ <- map nameOccName names ]) |
|---|
| 995 | -- The qualified and unqualified version of all of |
|---|
| 996 | -- these names are, in effect, used by this export |
|---|
| 997 | |
|---|
| 998 | ; occs' <- check_occs (IEModuleContents mod) occs names |
|---|
| 999 | -- This check_occs not only finds conflicts |
|---|
| 1000 | -- between this item and others, but also |
|---|
| 1001 | -- internally within this item. That is, if |
|---|
| 1002 | -- 'M.x' is in scope in several ways, we'll have |
|---|
| 1003 | -- several members of mod_avails with the same |
|---|
| 1004 | -- OccName. |
|---|
| 1005 | ; traceRn (vcat [ text "export mod" <+> ppr mod |
|---|
| 1006 | , ppr new_exports ]) |
|---|
| 1007 | ; return (L loc (IEModuleContents mod) : ie_names, |
|---|
| 1008 | occs', new_exports ++ exports) } |
|---|
| 1009 | |
|---|
| 1010 | exports_from_item acc@(lie_names, occs, exports) (L loc ie) |
|---|
| 1011 | | isDoc ie |
|---|
| 1012 | = do new_ie <- lookup_doc_ie ie |
|---|
| 1013 | return (L loc new_ie : lie_names, occs, exports) |
|---|
| 1014 | |
|---|
| 1015 | | otherwise |
|---|
| 1016 | = do (new_ie, avail) <- lookup_ie ie |
|---|
| 1017 | if isUnboundName (ieName new_ie) |
|---|
| 1018 | then return acc -- Avoid error cascade |
|---|
| 1019 | else do |
|---|
| 1020 | |
|---|
| 1021 | occs' <- check_occs ie occs (availNames avail) |
|---|
| 1022 | |
|---|
| 1023 | return (L loc new_ie : lie_names, occs', avail : exports) |
|---|
| 1024 | |
|---|
| 1025 | ------------- |
|---|
| 1026 | lookup_ie :: IE RdrName -> RnM (IE Name, AvailInfo) |
|---|
| 1027 | lookup_ie (IEVar rdr) |
|---|
| 1028 | = do gre <- lookupGreRn rdr |
|---|
| 1029 | return (IEVar (gre_name gre), greExportAvail gre) |
|---|
| 1030 | |
|---|
| 1031 | lookup_ie (IEThingAbs rdr) |
|---|
| 1032 | = do gre <- lookupGreRn rdr |
|---|
| 1033 | let name = gre_name gre |
|---|
| 1034 | case gre_par gre of |
|---|
| 1035 | NoParent -> return (IEThingAbs name, |
|---|
| 1036 | AvailTC name [name]) |
|---|
| 1037 | ParentIs p -> return (IEThingAbs name, |
|---|
| 1038 | AvailTC p [name]) |
|---|
| 1039 | |
|---|
| 1040 | lookup_ie ie@(IEThingAll rdr) |
|---|
| 1041 | = do name <- lookupGlobalOccRn rdr |
|---|
| 1042 | let kids = findChildren kids_env name |
|---|
| 1043 | mkKidRdrName = case isQual_maybe rdr of |
|---|
| 1044 | Nothing -> mkRdrUnqual |
|---|
| 1045 | Just (modName, _) -> mkRdrQual modName |
|---|
| 1046 | addUsedRdrNames $ map (mkKidRdrName . nameOccName) kids |
|---|
| 1047 | warnDodgyExports <- woptM Opt_WarnDodgyExports |
|---|
| 1048 | when (null kids) $ |
|---|
| 1049 | if isTyConName name |
|---|
| 1050 | then when warnDodgyExports $ addWarn (dodgyExportWarn name) |
|---|
| 1051 | else -- This occurs when you export T(..), but |
|---|
| 1052 | -- only import T abstractly, or T is a synonym. |
|---|
| 1053 | addErr (exportItemErr ie) |
|---|
| 1054 | |
|---|
| 1055 | return (IEThingAll name, AvailTC name (name:kids)) |
|---|
| 1056 | |
|---|
| 1057 | lookup_ie ie@(IEThingWith rdr sub_rdrs) |
|---|
| 1058 | = do name <- lookupGlobalOccRn rdr |
|---|
| 1059 | if isUnboundName name |
|---|
| 1060 | then return (IEThingWith name [], AvailTC name [name]) |
|---|
| 1061 | else do |
|---|
| 1062 | let env = mkOccEnv [ (nameOccName s, s) |
|---|
| 1063 | | s <- findChildren kids_env name ] |
|---|
| 1064 | mb_names = map (lookupOccEnv env . rdrNameOcc) sub_rdrs |
|---|
| 1065 | if any isNothing mb_names |
|---|
| 1066 | then do addErr (exportItemErr ie) |
|---|
| 1067 | return (IEThingWith name [], AvailTC name [name]) |
|---|
| 1068 | else do let names = catMaybes mb_names |
|---|
| 1069 | optTyFam <- xoptM Opt_TypeFamilies |
|---|
| 1070 | when (not optTyFam && any isTyConName names) $ |
|---|
| 1071 | addErr (typeItemErr ( head |
|---|
| 1072 | . filter isTyConName |
|---|
| 1073 | $ names ) |
|---|
| 1074 | (text "in export list")) |
|---|
| 1075 | return (IEThingWith name names, AvailTC name (name:names)) |
|---|
| 1076 | |
|---|
| 1077 | lookup_ie _ = panic "lookup_ie" -- Other cases covered earlier |
|---|
| 1078 | |
|---|
| 1079 | ------------- |
|---|
| 1080 | lookup_doc_ie :: IE RdrName -> RnM (IE Name) |
|---|
| 1081 | lookup_doc_ie (IEGroup lev doc) = do rn_doc <- rnHsDoc doc |
|---|
| 1082 | return (IEGroup lev rn_doc) |
|---|
| 1083 | lookup_doc_ie (IEDoc doc) = do rn_doc <- rnHsDoc doc |
|---|
| 1084 | return (IEDoc rn_doc) |
|---|
| 1085 | lookup_doc_ie (IEDocNamed str) = return (IEDocNamed str) |
|---|
| 1086 | lookup_doc_ie _ = panic "lookup_doc_ie" -- Other cases covered earlier |
|---|
| 1087 | |
|---|
| 1088 | |
|---|
| 1089 | isDoc :: IE RdrName -> Bool |
|---|
| 1090 | isDoc (IEDoc _) = True |
|---|
| 1091 | isDoc (IEDocNamed _) = True |
|---|
| 1092 | isDoc (IEGroup _ _) = True |
|---|
| 1093 | isDoc _ = False |
|---|
| 1094 | |
|---|
| 1095 | ------------------------------- |
|---|
| 1096 | isModuleExported :: Bool -> ModuleName -> GlobalRdrElt -> Bool |
|---|
| 1097 | -- True if the thing is in scope *both* unqualified, *and* with qualifier M |
|---|
| 1098 | isModuleExported implicit_prelude mod (GRE { gre_name = name, gre_prov = prov }) |
|---|
| 1099 | | implicit_prelude && isBuiltInSyntax name = False |
|---|
| 1100 | -- Optimisation: filter out names for built-in syntax |
|---|
| 1101 | -- They just clutter up the environment (esp tuples), and the parser |
|---|
| 1102 | -- will generate Exact RdrNames for them, so the cluttered |
|---|
| 1103 | -- envt is no use. To avoid doing this filter all the time, |
|---|
| 1104 | -- we use -XNoImplicitPrelude as a clue that the filter is |
|---|
| 1105 | -- worth while. Really, it's only useful for GHC.Base and GHC.Tuple. |
|---|
| 1106 | -- |
|---|
| 1107 | -- It's worth doing because it makes the environment smaller for |
|---|
| 1108 | -- every module that imports the Prelude |
|---|
| 1109 | | otherwise |
|---|
| 1110 | = case prov of |
|---|
| 1111 | LocalDef | Just name_mod <- nameModule_maybe name |
|---|
| 1112 | -> moduleName name_mod == mod |
|---|
| 1113 | | otherwise -> False |
|---|
| 1114 | Imported is -> any unQualSpecOK is && any (qualSpecOK mod) is |
|---|
| 1115 | |
|---|
| 1116 | ------------------------------- |
|---|
| 1117 | check_occs :: IE RdrName -> ExportOccMap -> [Name] -> RnM ExportOccMap |
|---|
| 1118 | check_occs ie occs names -- 'names' are the entities specifed by 'ie' |
|---|
| 1119 | = foldlM check occs names |
|---|
| 1120 | where |
|---|
| 1121 | check occs name |
|---|
| 1122 | = case lookupOccEnv occs name_occ of |
|---|
| 1123 | Nothing -> return (extendOccEnv occs name_occ (name, ie)) |
|---|
| 1124 | |
|---|
| 1125 | Just (name', ie') |
|---|
| 1126 | | name == name' -- Duplicate export |
|---|
| 1127 | -- But we don't want to warn if the same thing is exported |
|---|
| 1128 | -- by two different module exports. See ticket #4478. |
|---|
| 1129 | -> do unless (dupExport_ok name ie ie') $ do |
|---|
| 1130 | warn_dup_exports <- woptM Opt_WarnDuplicateExports |
|---|
| 1131 | warnIf warn_dup_exports (dupExportWarn name_occ ie ie') |
|---|
| 1132 | return occs |
|---|
| 1133 | |
|---|
| 1134 | | otherwise -- Same occ name but different names: an error |
|---|
| 1135 | -> do { global_env <- getGlobalRdrEnv ; |
|---|
| 1136 | addErr (exportClashErr global_env name' name ie' ie) ; |
|---|
| 1137 | return occs } |
|---|
| 1138 | where |
|---|
| 1139 | name_occ = nameOccName name |
|---|
| 1140 | |
|---|
| 1141 | |
|---|
| 1142 | dupExport_ok :: Name -> IE RdrName -> IE RdrName -> Bool |
|---|
| 1143 | -- The Name is exported by both IEs. Is that ok? |
|---|
| 1144 | -- "No" iff the name is mentioned explicitly in both IEs |
|---|
| 1145 | -- or one of the IEs mentions the name *alone* |
|---|
| 1146 | -- "Yes" otherwise |
|---|
| 1147 | -- |
|---|
| 1148 | -- Examples of "no": module M( f, f ) |
|---|
| 1149 | -- module M( fmap, Functor(..) ) |
|---|
| 1150 | -- module M( module Data.List, head ) |
|---|
| 1151 | -- |
|---|
| 1152 | -- Example of "yes" |
|---|
| 1153 | -- module M( module A, module B ) where |
|---|
| 1154 | -- import A( f ) |
|---|
| 1155 | -- import B( f ) |
|---|
| 1156 | -- |
|---|
| 1157 | -- Example of "yes" (Trac #2436) |
|---|
| 1158 | -- module M( C(..), T(..) ) where |
|---|
| 1159 | -- class C a where { data T a } |
|---|
| 1160 | -- instace C Int where { data T Int = TInt } |
|---|
| 1161 | -- |
|---|
| 1162 | -- Example of "yes" (Trac #2436) |
|---|
| 1163 | -- module Foo ( T ) where |
|---|
| 1164 | -- data family T a |
|---|
| 1165 | -- module Bar ( T(..), module Foo ) where |
|---|
| 1166 | -- import Foo |
|---|
| 1167 | -- data instance T Int = TInt |
|---|
| 1168 | |
|---|
| 1169 | dupExport_ok n ie1 ie2 |
|---|
| 1170 | = not ( single ie1 || single ie2 |
|---|
| 1171 | || (explicit_in ie1 && explicit_in ie2) ) |
|---|
| 1172 | where |
|---|
| 1173 | explicit_in (IEModuleContents _) = False -- module M |
|---|
| 1174 | explicit_in (IEThingAll r) = nameOccName n == rdrNameOcc r -- T(..) |
|---|
| 1175 | explicit_in _ = True |
|---|
| 1176 | |
|---|
| 1177 | single (IEVar {}) = True |
|---|
| 1178 | single (IEThingAbs {}) = True |
|---|
| 1179 | single _ = False |
|---|
| 1180 | \end{code} |
|---|
| 1181 | |
|---|
| 1182 | |
|---|
| 1183 | %********************************************************* |
|---|
| 1184 | %* * |
|---|
| 1185 | \subsection{Unused names} |
|---|
| 1186 | %* * |
|---|
| 1187 | %********************************************************* |
|---|
| 1188 | |
|---|
| 1189 | \begin{code} |
|---|
| 1190 | reportUnusedNames :: Maybe [LIE RdrName] -- Export list |
|---|
| 1191 | -> TcGblEnv -> RnM () |
|---|
| 1192 | reportUnusedNames _export_decls gbl_env |
|---|
| 1193 | = do { traceRn ((text "RUN") <+> (ppr (tcg_dus gbl_env))) |
|---|
| 1194 | ; warnUnusedImportDecls gbl_env |
|---|
| 1195 | ; warnUnusedTopBinds unused_locals } |
|---|
| 1196 | where |
|---|
| 1197 | used_names :: NameSet |
|---|
| 1198 | used_names = findUses (tcg_dus gbl_env) emptyNameSet |
|---|
| 1199 | -- NB: currently, if f x = g, we only treat 'g' as used if 'f' is used |
|---|
| 1200 | -- Hence findUses |
|---|
| 1201 | |
|---|
| 1202 | -- Collect the defined names from the in-scope environment |
|---|
| 1203 | defined_names :: [GlobalRdrElt] |
|---|
| 1204 | defined_names = globalRdrEnvElts (tcg_rdr_env gbl_env) |
|---|
| 1205 | |
|---|
| 1206 | -- Note that defined_and_used, defined_but_not_used |
|---|
| 1207 | -- are both [GRE]; that's why we need defined_and_used |
|---|
| 1208 | -- rather than just used_names |
|---|
| 1209 | _defined_and_used, defined_but_not_used :: [GlobalRdrElt] |
|---|
| 1210 | (_defined_and_used, defined_but_not_used) |
|---|
| 1211 | = partition (gre_is_used used_names) defined_names |
|---|
| 1212 | |
|---|
| 1213 | kids_env = mkChildEnv defined_names |
|---|
| 1214 | -- This is done in mkExports too; duplicated work |
|---|
| 1215 | |
|---|
| 1216 | gre_is_used :: NameSet -> GlobalRdrElt -> Bool |
|---|
| 1217 | gre_is_used used_names (GRE {gre_name = name}) |
|---|
| 1218 | = name `elemNameSet` used_names |
|---|
| 1219 | || any (`elemNameSet` used_names) (findChildren kids_env name) |
|---|
| 1220 | -- A use of C implies a use of T, |
|---|
| 1221 | -- if C was brought into scope by T(..) or T(C) |
|---|
| 1222 | |
|---|
| 1223 | -- Filter out the ones that are |
|---|
| 1224 | -- (a) defined in this module, and |
|---|
| 1225 | -- (b) not defined by a 'deriving' clause |
|---|
| 1226 | -- The latter have an Internal Name, so we can filter them out easily |
|---|
| 1227 | unused_locals :: [GlobalRdrElt] |
|---|
| 1228 | unused_locals = filter is_unused_local defined_but_not_used |
|---|
| 1229 | is_unused_local :: GlobalRdrElt -> Bool |
|---|
| 1230 | is_unused_local gre = isLocalGRE gre && isExternalName (gre_name gre) |
|---|
| 1231 | \end{code} |
|---|
| 1232 | |
|---|
| 1233 | %********************************************************* |
|---|
| 1234 | %* * |
|---|
| 1235 | \subsection{Unused imports} |
|---|
| 1236 | %* * |
|---|
| 1237 | %********************************************************* |
|---|
| 1238 | |
|---|
| 1239 | This code finds which import declarations are unused. The |
|---|
| 1240 | specification and implementation notes are here: |
|---|
| 1241 | http://hackage.haskell.org/trac/ghc/wiki/Commentary/Compiler/UnusedImports |
|---|
| 1242 | |
|---|
| 1243 | \begin{code} |
|---|
| 1244 | type ImportDeclUsage |
|---|
| 1245 | = ( LImportDecl Name -- The import declaration |
|---|
| 1246 | , [AvailInfo] -- What *is* used (normalised) |
|---|
| 1247 | , [Name] ) -- What is imported but *not* used |
|---|
| 1248 | \end{code} |
|---|
| 1249 | |
|---|
| 1250 | \begin{code} |
|---|
| 1251 | warnUnusedImportDecls :: TcGblEnv -> RnM () |
|---|
| 1252 | warnUnusedImportDecls gbl_env |
|---|
| 1253 | = do { uses <- readMutVar (tcg_used_rdrnames gbl_env) |
|---|
| 1254 | ; let imports = filter explicit_import (tcg_rn_imports gbl_env) |
|---|
| 1255 | rdr_env = tcg_rdr_env gbl_env |
|---|
| 1256 | |
|---|
| 1257 | ; let usage :: [ImportDeclUsage] |
|---|
| 1258 | usage = findImportUsage imports rdr_env (Set.elems uses) |
|---|
| 1259 | |
|---|
| 1260 | ; traceRn (vcat [ ptext (sLit "Uses:") <+> ppr (Set.elems uses) |
|---|
| 1261 | , ptext (sLit "Import usage") <+> ppr usage]) |
|---|
| 1262 | ; ifWOptM Opt_WarnUnusedImports $ |
|---|
| 1263 | mapM_ warnUnusedImport usage |
|---|
| 1264 | |
|---|
| 1265 | ; ifDOptM Opt_D_dump_minimal_imports $ |
|---|
| 1266 | printMinimalImports usage } |
|---|
| 1267 | where |
|---|
| 1268 | explicit_import (L _ decl) = unLoc (ideclName decl) /= pRELUDE_NAME |
|---|
| 1269 | -- Filter out the implicit Prelude import |
|---|
| 1270 | -- which we do not want to bleat about |
|---|
| 1271 | -- This also filters out an *explicit* Prelude import |
|---|
| 1272 | -- but solving that problem involves more plumbing, and |
|---|
| 1273 | -- it just doesn't seem worth it |
|---|
| 1274 | \end{code} |
|---|
| 1275 | |
|---|
| 1276 | \begin{code} |
|---|
| 1277 | findImportUsage :: [LImportDecl Name] |
|---|
| 1278 | -> GlobalRdrEnv |
|---|
| 1279 | -> [RdrName] |
|---|
| 1280 | -> [ImportDeclUsage] |
|---|
| 1281 | |
|---|
| 1282 | type ImportMap = Map SrcLoc [AvailInfo] |
|---|
| 1283 | -- The intermediate data struture records, for each import |
|---|
| 1284 | -- declaration, what stuff brought into scope by that |
|---|
| 1285 | -- declaration is actually used in the module. |
|---|
| 1286 | -- |
|---|
| 1287 | -- The SrcLoc is the location of the start |
|---|
| 1288 | -- of a particular 'import' declaration |
|---|
| 1289 | -- |
|---|
| 1290 | -- The AvailInfos are the things imported from that decl |
|---|
| 1291 | -- (just a list, not normalised) |
|---|
| 1292 | |
|---|
| 1293 | findImportUsage imports rdr_env rdrs |
|---|
| 1294 | = map unused_decl imports |
|---|
| 1295 | where |
|---|
| 1296 | import_usage :: ImportMap |
|---|
| 1297 | import_usage = foldr (addUsedRdrName rdr_env) Map.empty rdrs |
|---|
| 1298 | |
|---|
| 1299 | unused_decl decl@(L loc (ImportDecl { ideclHiding = imps })) |
|---|
| 1300 | = (decl, nubAvails used_avails, unused_imps) |
|---|
| 1301 | where |
|---|
| 1302 | used_avails = Map.lookup (srcSpanStart loc) import_usage `orElse` [] |
|---|
| 1303 | dont_report_as_unused = foldr add emptyNameSet used_avails |
|---|
| 1304 | add (Avail n) s = s `addOneToNameSet` n |
|---|
| 1305 | add (AvailTC n ns) s = s `addListToNameSet` (n:ns) |
|---|
| 1306 | -- If you use 'signum' from Num, then the user may well have |
|---|
| 1307 | -- imported Num(signum). We don't want to complain that |
|---|
| 1308 | -- Num is not itself mentioned. Hence adding 'n' as |
|---|
| 1309 | -- well to the list of of "don't report if unused" names |
|---|
| 1310 | |
|---|
| 1311 | unused_imps = case imps of |
|---|
| 1312 | Just (False, imp_ies) -> nameSetToList unused_imps |
|---|
| 1313 | where |
|---|
| 1314 | imp_names = mkNameSet (concatMap (ieNames . unLoc) imp_ies) |
|---|
| 1315 | unused_imps = imp_names `minusNameSet` dont_report_as_unused |
|---|
| 1316 | |
|---|
| 1317 | _other -> [] -- No explicit import list => no unused-name list |
|---|
| 1318 | |
|---|
| 1319 | addUsedRdrName :: GlobalRdrEnv -> RdrName -> ImportMap -> ImportMap |
|---|
| 1320 | -- For a used RdrName, find all the import decls that brought |
|---|
| 1321 | -- it into scope; choose one of them (bestImport), and record |
|---|
| 1322 | -- the RdrName in that import decl's entry in the ImportMap |
|---|
| 1323 | addUsedRdrName rdr_env rdr imp_map |
|---|
| 1324 | | [gre] <- lookupGRE_RdrName rdr rdr_env |
|---|
| 1325 | , Imported imps <- gre_prov gre |
|---|
| 1326 | = add_imp gre (bestImport imps) imp_map |
|---|
| 1327 | | otherwise |
|---|
| 1328 | = imp_map |
|---|
| 1329 | where |
|---|
| 1330 | add_imp :: GlobalRdrElt -> ImportSpec -> ImportMap -> ImportMap |
|---|
| 1331 | add_imp gre (ImpSpec { is_decl = imp_decl_spec }) imp_map |
|---|
| 1332 | = Map.insertWith add decl_loc [avail] imp_map |
|---|
| 1333 | where |
|---|
| 1334 | add _ avails = avail : avails -- add is really just a specialised (++) |
|---|
| 1335 | decl_loc = srcSpanStart (is_dloc imp_decl_spec) |
|---|
| 1336 | name = gre_name gre |
|---|
| 1337 | avail = case gre_par gre of |
|---|
| 1338 | ParentIs p -> AvailTC p [name] |
|---|
| 1339 | NoParent | isTyConName name -> AvailTC name [name] |
|---|
| 1340 | | otherwise -> Avail name |
|---|
| 1341 | |
|---|
| 1342 | bestImport :: [ImportSpec] -> ImportSpec |
|---|
| 1343 | bestImport iss |
|---|
| 1344 | = case partition isImpAll iss of |
|---|
| 1345 | ([], imp_somes) -> textuallyFirst imp_somes |
|---|
| 1346 | (imp_alls, _) -> textuallyFirst imp_alls |
|---|
| 1347 | |
|---|
| 1348 | textuallyFirst :: [ImportSpec] -> ImportSpec |
|---|
| 1349 | textuallyFirst iss = case sortWith (is_dloc . is_decl) iss of |
|---|
| 1350 | [] -> pprPanic "textuallyFirst" (ppr iss) |
|---|
| 1351 | (is:_) -> is |
|---|
| 1352 | |
|---|
| 1353 | isImpAll :: ImportSpec -> Bool |
|---|
| 1354 | isImpAll (ImpSpec { is_item = ImpAll }) = True |
|---|
| 1355 | isImpAll _other = False |
|---|
| 1356 | \end{code} |
|---|
| 1357 | |
|---|
| 1358 | \begin{code} |
|---|
| 1359 | warnUnusedImport :: ImportDeclUsage -> RnM () |
|---|
| 1360 | warnUnusedImport (L loc decl, used, unused) |
|---|
| 1361 | | Just (False,[]) <- ideclHiding decl |
|---|
| 1362 | = return () -- Do not warn for 'import M()' |
|---|
| 1363 | | null used = addWarnAt loc msg1 -- Nothing used; drop entire decl |
|---|
| 1364 | | null unused = return () -- Everything imported is used; nop |
|---|
| 1365 | | otherwise = addWarnAt loc msg2 -- Some imports are unused |
|---|
| 1366 | where |
|---|
| 1367 | msg1 = vcat [pp_herald <+> quotes pp_mod <+> pp_not_used, |
|---|
| 1368 | nest 2 (ptext (sLit "except perhaps to import instances from") |
|---|
| 1369 | <+> quotes pp_mod), |
|---|
| 1370 | ptext (sLit "To import instances alone, use:") |
|---|
| 1371 | <+> ptext (sLit "import") <+> pp_mod <> parens empty ] |
|---|
| 1372 | msg2 = sep [pp_herald <+> quotes (pprWithCommas ppr unused), |
|---|
| 1373 | text "from module" <+> quotes pp_mod <+> pp_not_used] |
|---|
| 1374 | pp_herald = text "The" <+> pp_qual <+> text "import of" |
|---|
| 1375 | pp_qual |
|---|
| 1376 | | ideclQualified decl = text "qualified" |
|---|
| 1377 | | otherwise = empty |
|---|
| 1378 | pp_mod = ppr (unLoc (ideclName decl)) |
|---|
| 1379 | pp_not_used = text "is redundant" |
|---|
| 1380 | \end{code} |
|---|
| 1381 | |
|---|
| 1382 | To print the minimal imports we walk over the user-supplied import |
|---|
| 1383 | decls, and simply trim their import lists. NB that |
|---|
| 1384 | |
|---|
| 1385 | * We do *not* change the 'qualified' or 'as' parts! |
|---|
| 1386 | |
|---|
| 1387 | * We do not disard a decl altogether; we might need instances |
|---|
| 1388 | from it. Instead we just trim to an empty import list |
|---|
| 1389 | |
|---|
| 1390 | \begin{code} |
|---|
| 1391 | printMinimalImports :: [ImportDeclUsage] -> RnM () |
|---|
| 1392 | printMinimalImports imports_w_usage |
|---|
| 1393 | = do { imports' <- mapM mk_minimal imports_w_usage |
|---|
| 1394 | ; this_mod <- getModule |
|---|
| 1395 | ; liftIO $ |
|---|
| 1396 | do { h <- openFile (mkFilename this_mod) WriteMode |
|---|
| 1397 | ; printForUser h neverQualify (vcat (map ppr imports')) } |
|---|
| 1398 | -- The neverQualify is important. We are printing Names |
|---|
| 1399 | -- but they are in the context of an 'import' decl, and |
|---|
| 1400 | -- we never qualify things inside there |
|---|
| 1401 | -- E.g. import Blag( f, b ) |
|---|
| 1402 | -- not import Blag( Blag.f, Blag.g )! |
|---|
| 1403 | } |
|---|
| 1404 | where |
|---|
| 1405 | mkFilename this_mod = moduleNameString (moduleName this_mod) ++ ".imports" |
|---|
| 1406 | |
|---|
| 1407 | mk_minimal (L l decl, used, unused) |
|---|
| 1408 | | null unused |
|---|
| 1409 | , Just (False, _) <- ideclHiding decl |
|---|
| 1410 | = return (L l decl) |
|---|
| 1411 | | otherwise |
|---|
| 1412 | = do { let ImportDecl { ideclName = L _ mod_name |
|---|
| 1413 | , ideclSource = is_boot |
|---|
| 1414 | , ideclPkgQual = mb_pkg } = decl |
|---|
| 1415 | ; iface <- loadSrcInterface doc mod_name is_boot mb_pkg |
|---|
| 1416 | ; let lies = map (L l) (concatMap (to_ie iface) used) |
|---|
| 1417 | ; return (L l (decl { ideclHiding = Just (False, lies) })) } |
|---|
| 1418 | where |
|---|
| 1419 | doc = text "Compute minimal imports for" <+> ppr decl |
|---|
| 1420 | |
|---|
| 1421 | to_ie :: ModIface -> AvailInfo -> [IE Name] |
|---|
| 1422 | -- The main trick here is that if we're importing all the constructors |
|---|
| 1423 | -- we want to say "T(..)", but if we're importing only a subset we want |
|---|
| 1424 | -- to say "T(A,B,C)". So we have to find out what the module exports. |
|---|
| 1425 | to_ie _ (Avail n) |
|---|
| 1426 | = [IEVar n] |
|---|
| 1427 | to_ie _ (AvailTC n [m]) |
|---|
| 1428 | | n==m = [IEThingAbs n] |
|---|
| 1429 | to_ie iface (AvailTC n ns) |
|---|
| 1430 | = case [xs | AvailTC x xs <- mi_exports iface |
|---|
| 1431 | , x == n |
|---|
| 1432 | , x `elem` xs -- Note [Partial export] |
|---|
| 1433 | ] of |
|---|
| 1434 | [xs] | all_used xs -> [IEThingAll n] |
|---|
| 1435 | | otherwise -> [IEThingWith n (filter (/= n) ns)] |
|---|
| 1436 | _other -> map IEVar ns |
|---|
| 1437 | where |
|---|
| 1438 | all_used avail_occs = all (`elem` ns) avail_occs |
|---|
| 1439 | \end{code} |
|---|
| 1440 | |
|---|
| 1441 | Note [Partial export] |
|---|
| 1442 | ~~~~~~~~~~~~~~~~~~~~~ |
|---|
| 1443 | Suppose we have |
|---|
| 1444 | |
|---|
| 1445 | module A( op ) where |
|---|
| 1446 | class C a where |
|---|
| 1447 | op :: a -> a |
|---|
| 1448 | |
|---|
| 1449 | module B where |
|---|
| 1450 | import A |
|---|
| 1451 | f = ..op... |
|---|
| 1452 | |
|---|
| 1453 | Then the minimal import for module B is |
|---|
| 1454 | import A( op ) |
|---|
| 1455 | not |
|---|
| 1456 | import A( C( op ) ) |
|---|
| 1457 | which we would usually generate if C was exported from B. Hence |
|---|
| 1458 | the (x `elem` xs) test when deciding what to generate. |
|---|
| 1459 | |
|---|
| 1460 | |
|---|
| 1461 | %************************************************************************ |
|---|
| 1462 | %* * |
|---|
| 1463 | \subsection{Errors} |
|---|
| 1464 | %* * |
|---|
| 1465 | %************************************************************************ |
|---|
| 1466 | |
|---|
| 1467 | \begin{code} |
|---|
| 1468 | qualImportItemErr :: RdrName -> SDoc |
|---|
| 1469 | qualImportItemErr rdr |
|---|
| 1470 | = hang (ptext (sLit "Illegal qualified name in import item:")) |
|---|
| 1471 | 2 (ppr rdr) |
|---|
| 1472 | |
|---|
| 1473 | badImportItemErrStd :: ModIface -> ImpDeclSpec -> IE RdrName -> SDoc |
|---|
| 1474 | badImportItemErrStd iface decl_spec ie |
|---|
| 1475 | = sep [ptext (sLit "Module"), quotes (ppr (is_mod decl_spec)), source_import, |
|---|
| 1476 | ptext (sLit "does not export"), quotes (ppr ie)] |
|---|
| 1477 | where |
|---|
| 1478 | source_import | mi_boot iface = ptext (sLit "(hi-boot interface)") |
|---|
| 1479 | | otherwise = empty |
|---|
| 1480 | |
|---|
| 1481 | badImportItemErrDataCon :: OccName -> ModIface -> ImpDeclSpec -> IE RdrName -> SDoc |
|---|
| 1482 | badImportItemErrDataCon dataType iface decl_spec ie |
|---|
| 1483 | = vcat [ ptext (sLit "In module") |
|---|
| 1484 | <+> quotes (ppr (is_mod decl_spec)) |
|---|
| 1485 | <+> source_import <> colon |
|---|
| 1486 | , nest 2 $ quotes datacon |
|---|
| 1487 | <+> ptext (sLit "is a data constructor of") |
|---|
| 1488 | <+> quotes (ppr dataType) |
|---|
| 1489 | , ptext (sLit "To import it use") |
|---|
| 1490 | , nest 2 $ quotes (ptext (sLit "import")) |
|---|
| 1491 | <+> ppr (is_mod decl_spec) |
|---|
| 1492 | <> parens_sp (ppr dataType <> parens_sp datacon) |
|---|
| 1493 | , ptext (sLit "or") |
|---|
| 1494 | , nest 2 $ quotes (ptext (sLit "import")) |
|---|
| 1495 | <+> ppr (is_mod decl_spec) |
|---|
| 1496 | <> parens_sp (ppr dataType <> ptext (sLit "(..)")) |
|---|
| 1497 | ] |
|---|
| 1498 | where |
|---|
| 1499 | datacon_occ = rdrNameOcc $ ieName ie |
|---|
| 1500 | datacon = parenSymOcc datacon_occ (ppr datacon_occ) |
|---|
| 1501 | source_import | mi_boot iface = ptext (sLit "(hi-boot interface)") |
|---|
| 1502 | | otherwise = empty |
|---|
| 1503 | parens_sp d = parens (space <> d <> space) -- T( f,g ) |
|---|
| 1504 | |
|---|
| 1505 | badImportItemErr :: ModIface -> ImpDeclSpec -> IE RdrName -> [AvailInfo] -> SDoc |
|---|
| 1506 | badImportItemErr iface decl_spec ie avails |
|---|
| 1507 | = case find checkIfDataCon avails of |
|---|
| 1508 | Just con -> badImportItemErrDataCon (availOccName con) iface decl_spec ie |
|---|
| 1509 | Nothing -> badImportItemErrStd iface decl_spec ie |
|---|
| 1510 | where |
|---|
| 1511 | checkIfDataCon (AvailTC _ ns) = |
|---|
| 1512 | case find (\n -> importedFS == nameOccNameFS n) ns of |
|---|
| 1513 | Just n -> isDataConName n |
|---|
| 1514 | Nothing -> False |
|---|
| 1515 | checkIfDataCon _ = False |
|---|
| 1516 | availOccName = nameOccName . availName |
|---|
| 1517 | nameOccNameFS = occNameFS . nameOccName |
|---|
| 1518 | importedFS = occNameFS . rdrNameOcc $ ieName ie |
|---|
| 1519 | |
|---|
| 1520 | illegalImportItemErr :: SDoc |
|---|
| 1521 | illegalImportItemErr = ptext (sLit "Illegal import item") |
|---|
| 1522 | |
|---|
| 1523 | dodgyImportWarn :: RdrName -> SDoc |
|---|
| 1524 | dodgyImportWarn item = dodgyMsg (ptext (sLit "import")) item |
|---|
| 1525 | dodgyExportWarn :: Name -> SDoc |
|---|
| 1526 | dodgyExportWarn item = dodgyMsg (ptext (sLit "export")) item |
|---|
| 1527 | |
|---|
| 1528 | dodgyMsg :: (OutputableBndr n, HasOccName n) => SDoc -> n -> SDoc |
|---|
| 1529 | dodgyMsg kind tc |
|---|
| 1530 | = sep [ ptext (sLit "The") <+> kind <+> ptext (sLit "item") <+> quotes (ppr (IEThingAll tc)) |
|---|
| 1531 | <+> ptext (sLit "suggests that"), |
|---|
| 1532 | quotes (ppr tc) <+> ptext (sLit "has (in-scope) constructors or class methods,"), |
|---|
| 1533 | ptext (sLit "but it has none") ] |
|---|
| 1534 | |
|---|
| 1535 | exportItemErr :: IE RdrName -> SDoc |
|---|
| 1536 | exportItemErr export_item |
|---|
| 1537 | = sep [ ptext (sLit "The export item") <+> quotes (ppr export_item), |
|---|
| 1538 | ptext (sLit "attempts to export constructors or class methods that are not visible here") ] |
|---|
| 1539 | |
|---|
| 1540 | typeItemErr :: Name -> SDoc -> SDoc |
|---|
| 1541 | typeItemErr name wherestr |
|---|
| 1542 | = sep [ ptext (sLit "Using 'type' tag on") <+> quotes (ppr name) <+> wherestr, |
|---|
| 1543 | ptext (sLit "Use -XTypeFamilies to enable this extension") ] |
|---|
| 1544 | |
|---|
| 1545 | exportClashErr :: GlobalRdrEnv -> Name -> Name -> IE RdrName -> IE RdrName |
|---|
| 1546 | -> MsgDoc |
|---|
| 1547 | exportClashErr global_env name1 name2 ie1 ie2 |
|---|
| 1548 | = vcat [ ptext (sLit "Conflicting exports for") <+> quotes (ppr occ) <> colon |
|---|
| 1549 | , ppr_export ie1' name1' |
|---|
| 1550 | , ppr_export ie2' name2' ] |
|---|
| 1551 | where |
|---|
| 1552 | occ = nameOccName name1 |
|---|
| 1553 | ppr_export ie name = nest 3 (hang (quotes (ppr ie) <+> ptext (sLit "exports") <+> |
|---|
| 1554 | quotes (ppr name)) |
|---|
| 1555 | 2 (pprNameProvenance (get_gre name))) |
|---|
| 1556 | |
|---|
| 1557 | -- get_gre finds a GRE for the Name, so that we can show its provenance |
|---|
| 1558 | get_gre name |
|---|
| 1559 | = case lookupGRE_Name global_env name of |
|---|
| 1560 | (gre:_) -> gre |
|---|
| 1561 | [] -> pprPanic "exportClashErr" (ppr name) |
|---|
| 1562 | get_loc name = greSrcSpan (get_gre name) |
|---|
| 1563 | (name1', ie1', name2', ie2') = if get_loc name1 < get_loc name2 |
|---|
| 1564 | then (name1, ie1, name2, ie2) |
|---|
| 1565 | else (name2, ie2, name1, ie1) |
|---|
| 1566 | |
|---|
| 1567 | -- the SrcSpan that pprNameProvenance prints out depends on whether |
|---|
| 1568 | -- the Name is defined locally or not: for a local definition the |
|---|
| 1569 | -- definition site is used, otherwise the location of the import |
|---|
| 1570 | -- declaration. We want to sort the export locations in |
|---|
| 1571 | -- exportClashErr by this SrcSpan, we need to extract it: |
|---|
| 1572 | greSrcSpan :: GlobalRdrElt -> SrcSpan |
|---|
| 1573 | greSrcSpan gre |
|---|
| 1574 | | Imported (is:_) <- gre_prov gre = is_dloc (is_decl is) |
|---|
| 1575 | | otherwise = name_span |
|---|
| 1576 | where |
|---|
| 1577 | name_span = nameSrcSpan (gre_name gre) |
|---|
| 1578 | |
|---|
| 1579 | addDupDeclErr :: [Name] -> TcRn () |
|---|
| 1580 | addDupDeclErr [] |
|---|
| 1581 | = panic "addDupDeclErr: empty list" |
|---|
| 1582 | addDupDeclErr names@(name : _) |
|---|
| 1583 | = addErrAt (getSrcSpan (last sorted_names)) $ |
|---|
| 1584 | -- Report the error at the later location |
|---|
| 1585 | vcat [ptext (sLit "Multiple declarations of") <+> |
|---|
| 1586 | quotes (ppr (nameOccName name)), |
|---|
| 1587 | -- NB. print the OccName, not the Name, because the |
|---|
| 1588 | -- latter might not be in scope in the RdrEnv and so will |
|---|
| 1589 | -- be printed qualified. |
|---|
| 1590 | ptext (sLit "Declared at:") <+> |
|---|
| 1591 | vcat (map (ppr . nameSrcLoc) sorted_names)] |
|---|
| 1592 | where |
|---|
| 1593 | sorted_names = sortWith nameSrcLoc names |
|---|
| 1594 | |
|---|
| 1595 | dupExportWarn :: OccName -> IE RdrName -> IE RdrName -> SDoc |
|---|
| 1596 | dupExportWarn occ_name ie1 ie2 |
|---|
| 1597 | = hsep [quotes (ppr occ_name), |
|---|
| 1598 | ptext (sLit "is exported by"), quotes (ppr ie1), |
|---|
| 1599 | ptext (sLit "and"), quotes (ppr ie2)] |
|---|
| 1600 | |
|---|
| 1601 | dupModuleExport :: ModuleName -> SDoc |
|---|
| 1602 | dupModuleExport mod |
|---|
| 1603 | = hsep [ptext (sLit "Duplicate"), |
|---|
| 1604 | quotes (ptext (sLit "Module") <+> ppr mod), |
|---|
| 1605 | ptext (sLit "in export list")] |
|---|
| 1606 | |
|---|
| 1607 | moduleNotImported :: ModuleName -> SDoc |
|---|
| 1608 | moduleNotImported mod |
|---|
| 1609 | = ptext (sLit "The export item `module") <+> ppr mod <> |
|---|
| 1610 | ptext (sLit "' is not imported") |
|---|
| 1611 | |
|---|
| 1612 | nullModuleExport :: ModuleName -> SDoc |
|---|
| 1613 | nullModuleExport mod |
|---|
| 1614 | = ptext (sLit "The export item `module") <+> ppr mod <> ptext (sLit "' exports nothing") |
|---|
| 1615 | |
|---|
| 1616 | missingImportListWarn :: ModuleName -> SDoc |
|---|
| 1617 | missingImportListWarn mod |
|---|
| 1618 | = ptext (sLit "The module") <+> quotes (ppr mod) <+> ptext (sLit "does not have an explicit import list") |
|---|
| 1619 | |
|---|
| 1620 | missingImportListItem :: IE RdrName -> SDoc |
|---|
| 1621 | missingImportListItem ie |
|---|
| 1622 | = ptext (sLit "The import item") <+> quotes (ppr ie) <+> ptext (sLit "does not have an explicit import list") |
|---|
| 1623 | |
|---|
| 1624 | moduleWarn :: ModuleName -> WarningTxt -> SDoc |
|---|
| 1625 | moduleWarn mod (WarningTxt txt) |
|---|
| 1626 | = sep [ ptext (sLit "Module") <+> quotes (ppr mod) <> ptext (sLit ":"), |
|---|
| 1627 | nest 2 (vcat (map ppr txt)) ] |
|---|
| 1628 | moduleWarn mod (DeprecatedTxt txt) |
|---|
| 1629 | = sep [ ptext (sLit "Module") <+> quotes (ppr mod) |
|---|
| 1630 | <+> ptext (sLit "is deprecated:"), |
|---|
| 1631 | nest 2 (vcat (map ppr txt)) ] |
|---|
| 1632 | |
|---|
| 1633 | packageImportErr :: SDoc |
|---|
| 1634 | packageImportErr |
|---|
| 1635 | = ptext (sLit "Package-qualified imports are not enabled; use -XPackageImports") |
|---|
| 1636 | \end{code} |
|---|