ghc/compiler/rename/RnEnv.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
   3 %
   4 \section[RnEnv]{Environment manipulation for the renamer monad}
   5
   6 \begin{code}
   7 module RnEnv where              -- Export everything
   8
   9 #include "HsVersions.h"
  10
  11 import CmdLineOpts      ( opt_WarnNameShadowing, opt_WarnUnusedMatches,
  12                           opt_WarnUnusedBinds, opt_WarnUnusedImports )
  13 import HsSyn
  14 import RdrHsSyn         ( RdrNameIE )
  15 import RnHsSyn          ( RenamedHsType )
  16 import RdrName          ( RdrName, rdrNameModule, rdrNameOcc, isQual, isUnqual,
  17                           mkRdrUnqual, qualifyRdrName
  18                         )
  19 import HsTypes          ( hsTyVarName, hsTyVarNames, replaceTyVarName )
  20
  21 import RnMonad
  22 import Name             ( Name, Provenance(..), ExportFlag(..), NamedThing(..),
  23                           ImportReason(..), getSrcLoc,
  24                           mkLocalName, mkImportedLocalName, mkGlobalName, mkUnboundName,
  25                           mkIPName, isWiredInName, hasBetterProv,
  26                           nameOccName, setNameModule, nameModule,
  27                           pprOccName, isLocallyDefined, nameUnique,
  28                           setNameProvenance, getNameProvenance, pprNameProvenance,
  29                           extendNameEnv_C, plusNameEnv_C, nameEnvElts
  30                         )
  31 import NameSet
  32 import OccName          ( OccName,
  33                           mkDFunOcc, occNameUserString, occNameString,
  34                           occNameFlavour
  35                         )
  36 import TysWiredIn       ( listTyCon )
  37 import Type             ( funTyCon )
  38 import Module           ( ModuleName, mkThisModule, moduleName, mkVanillaModule, pprModuleName )
  39 import FiniteMap
  40 import UniqSupply
  41 import SrcLoc           ( SrcLoc, noSrcLoc )
  42 import Outputable
  43 import Util             ( removeDups, equivClasses, thenCmp, sortLt )
  44 import List             ( nub )
  45 \end{code}
  46
  47
  48
  49 %*********************************************************
  50 %*                                                      *
  51 \subsection{Making new names}
  52 %*                                                      *
  53 %*********************************************************
  54
  55 \begin{code}
  56 implicitImportProvenance = NonLocalDef ImplicitImport False
  57
  58 newTopBinder :: Module -> OccName -> RnM d Name
  59 newTopBinder mod occ
  60   =     -- First check the cache
  61     traceRn (text "newTopBinder" <+> ppr mod <+> ppr occ) `thenRn_`
  62
  63     getNameSupplyRn             `thenRn` \ (us, inst_ns, cache, ipcache) ->
  64     let
  65         key          = (moduleName mod, occ)
  66     in
  67     case lookupFM cache key of
  68
  69         -- A hit in the cache!  We are at the binding site of the name, which is
  70         -- the time we know all about the Name's host Module (in particular, which
  71         -- package it comes from), so update the Module in the name.
  72         -- But otherwise *leave the Provenance alone*:
  73         --
  74         --      * For imported names, the Provenance may already be correct.
  75         --        e.g. We imported Prelude.hi, and set the provenance of PrelShow.Show
  76         --             to 'UserImport from Prelude'.  Note that we havn't yet opened PrelShow.hi
  77         --             Later we find we really need PrelShow.Show, so we open PrelShow.hi, and
  78         --             that's when we find the binding occurrence of Show.
  79         --
  80         --      * For locally defined names, we do a setProvenance on the Name
  81         --        right after newTopBinder, and then use updateProveances to finally
  82         --        set the provenances in the cache correctly.
  83         --
  84         -- NB: for wired-in names it's important not to
  85         -- forget that they are wired in even when compiling that module
  86         -- (else we spit out redundant defns into the interface file)
  87
  88         Just name -> let
  89                         new_name  = setNameModule name mod
  90                         new_cache = addToFM cache key new_name
  91                      in
  92                      setNameSupplyRn (us, inst_ns, new_cache, ipcache)  `thenRn_`
  93                      traceRn (text "newTopBinder: overwrite" <+> ppr new_name) `thenRn_`
  94                      returnRn new_name
  95
  96         -- Miss in the cache!
  97         -- Build a completely new Name, and put it in the cache
  98         -- Even for locally-defined names we use implicitImportProvenance;
  99         -- updateProvenances will set it to rights
 100         Nothing -> let
 101                         (us', us1) = splitUniqSupply us
 102                         uniq       = uniqFromSupply us1
 103                         new_name   = mkGlobalName uniq mod occ implicitImportProvenance
 104                         new_cache  = addToFM cache key new_name
 105                    in
 106                    setNameSupplyRn (us', inst_ns, new_cache, ipcache)   `thenRn_`
 107                    traceRn (text "newTopBinder: new" <+> ppr new_name) `thenRn_`
 108                    returnRn new_name
 109
 110
 111 mkImportedGlobalName :: ModuleName -> OccName -> RnM d Name
 112   -- Used for *occurrences*.  We make a place-holder Name, really just
 113   -- to agree on its unique, which gets overwritten when we read in
 114   -- the binding occurence later (newImportedBinder)
 115   -- The place-holder Name doesn't have the right Provenance, and its
 116   -- Module won't have the right Package either
 117   --
 118   -- This means that a renamed program may have incorrect info
 119   -- on implicitly-imported occurrences, but the correct info on the
 120   -- *binding* declaration. It's the type checker that propagates the
 121   -- correct information to all the occurrences.
 122   -- Since implicitly-imported names never occur in error messages,
 123   -- it doesn't matter that we get the correct info in place till later,
 124   -- (but since it affects DLL-ery it does matter that we get it right
 125   --  in the end).
 126 mkImportedGlobalName mod_name occ
 127   = getNameSupplyRn             `thenRn` \ (us, inst_ns, cache, ipcache) ->
 128     let
 129         key = (mod_name, occ)
 130     in
 131     case lookupFM cache key of
 132         Just name -> traceRn (text "mkImportedGlobalName: hit" <+> ppr name) `thenRn_`
 133                      returnRn name
 134         Nothing   -> setNameSupplyRn (us', inst_ns, new_cache, ipcache)         `thenRn_`
 135                      traceRn (text "mkImportedGlobalName: new" <+> ppr name)    `thenRn_`
 136                      returnRn name
 137                   where
 138                      (us', us1) = splitUniqSupply us
 139                      uniq       = uniqFromSupply us1
 140                      mod        = mkVanillaModule mod_name
 141                      name       = mkGlobalName uniq mod occ implicitImportProvenance
 142                      new_cache  = addToFM cache key name
 143
 144 updateProvenances :: [Name] -> RnM d ()
 145 -- Update the provenances of everything that is in scope.
 146 -- We must be careful not to disturb the Module package info
 147 -- already in the cache.  Why not?  Consider
 148 --   module A           module M( f )
 149 --      import M( f )     import N( f)
 150 --      import N
 151 -- So f is defined in N, and M re-exports it.
 152 -- When processing module A:
 153 --      1. We read M.hi first, and make a vanilla name N.f
 154 --         (without reading N.hi). The package info says <THIS>
 155 --         for lack of anything better.
 156 --      2. Now we read N, which update the cache to record
 157 --         the correct package for N.f.
 158 --      3. Finally we update provenances (once we've read all imports).
 159 -- Step 3 must not destroy package info recorded in Step 2.
 160
 161 updateProvenances names
 162   = getNameSupplyRn             `thenRn` \ (us, inst_ns, cache, ipcache) ->
 163     setNameSupplyRn (us, inst_ns, foldr update cache names, ipcache)
 164   where
 165     update name cache = addToFM_C update_prov cache key name
 166                       where
 167                         key = (moduleName (nameModule name), nameOccName name)
 168
 169     update_prov name_in_cache name_with_prov
 170         = setNameProvenance name_in_cache (getNameProvenance name_with_prov)
 171
 172
 173 mkImportedGlobalFromRdrName :: RdrName -> RnM d Name
 174 mkImportedGlobalFromRdrName rdr_name
 175   | isQual rdr_name
 176   = mkImportedGlobalName (rdrNameModule rdr_name) (rdrNameOcc rdr_name)
 177
 178   | otherwise
 179   =     -- An Unqual is allowed; interface files contain
 180         -- unqualified names for locally-defined things, such as
 181         -- constructors of a data type.
 182     getModuleRn                         `thenRn ` \ mod_name ->
 183     mkImportedGlobalName mod_name (rdrNameOcc rdr_name)
 184
 185
 186 getIPName rdr_name
 187   = getNameSupplyRn             `thenRn` \ (us, inst_ns, cache, ipcache) ->
 188     case lookupFM ipcache key of
 189         Just name -> returnRn name
 190         Nothing   -> setNameSupplyRn (us', inst_ns, cache, new_ipcache) `thenRn_`
 191                      returnRn name
 192                   where
 193                      (us', us1)  = splitUniqSupply us
 194                      uniq        = uniqFromSupply us1
 195                      name        = mkIPName uniq key
 196                      new_ipcache = addToFM ipcache key name
 197     where key = (rdrNameOcc rdr_name)
 198 \end{code}
 199
 200 %*********************************************************
 201 %*                                                      *
 202 \subsection{Dfuns and default methods}
 203 %*                                                      *
 204 %*********************************************************
 205
 206 @newImplicitBinder@ is used for
 207         (a) dfuns               (RnSource.rnDecl on InstDecls)
 208         (b) default methods     (RnSource.rnDecl on ClassDecls)
 209 when these dfuns/default methods are defined in the module being compiled
 210
 211 \begin{code}
 212 newImplicitBinder occ src_loc
 213   = getModuleRn                         `thenRn` \ mod_name ->
 214     newTopBinder (mkThisModule mod_name) occ    `thenRn` \ name ->
 215     returnRn (setNameProvenance name (LocalDef src_loc Exported))
 216 \end{code}
 217
 218 Make a name for the dict fun for an instance decl
 219
 220 \begin{code}
 221 newDFunName :: (OccName, OccName) -> SrcLoc -> RnMS Name
 222 newDFunName key@(cl_occ, tycon_occ) loc
 223   = newInstUniq string  `thenRn` \ inst_uniq ->
 224     newImplicitBinder (mkDFunOcc string inst_uniq) loc
 225   where
 226         -- Any string that is somewhat unique will do
 227     string = occNameString cl_occ ++ occNameString tycon_occ
 228 \end{code}
 229
 230 \begin{code}
 231 getDFunKey :: RenamedHsType -> (OccName, OccName)       -- Used to manufacture DFun names
 232 getDFunKey (HsForAllTy _ _ ty)              = getDFunKey ty
 233 getDFunKey (HsFunTy _ ty)                   = getDFunKey ty
 234 getDFunKey (HsPredTy (HsPClass cls (ty:_))) = (nameOccName cls, get_tycon_key ty)
 235
 236 get_tycon_key (HsTyVar tv)                   = getOccName tv
 237 get_tycon_key (HsAppTy ty _)                 = get_tycon_key ty
 238 get_tycon_key (HsTupleTy (HsTupCon n _) tys) = getOccName n
 239 get_tycon_key (HsListTy _)                   = getOccName listTyCon
 240 get_tycon_key (HsFunTy _ _)                  = getOccName funTyCon
 241 \end{code}
 242
 243
 244 %*********************************************************
 245 %*                                                      *
 246 \subsection{Binding}
 247 %*                                                      *
 248 %*********************************************************
 249
 250 \begin{code}
 251 -------------------------------------
 252 bindLocatedLocalsRn :: SDoc     -- Documentation string for error message
 253                     -> [(RdrName,SrcLoc)]
 254                     -> ([Name] -> RnMS a)
 255                     -> RnMS a
 256 bindLocatedLocalsRn doc_str rdr_names_w_loc enclosed_scope
 257   = checkDupOrQualNames doc_str rdr_names_w_loc `thenRn_`
 258
 259     getModeRn                           `thenRn` \ mode ->
 260     getLocalNameEnv                     `thenRn` \ name_env ->
 261
 262         -- Warn about shadowing, but only in source modules
 263     (case mode of
 264         SourceMode | opt_WarnNameShadowing -> mapRn_ (check_shadow name_env) rdr_names_w_loc
 265         other                              -> returnRn ()
 266     )                                   `thenRn_`
 267
 268     getNameSupplyRn             `thenRn` \ (us, inst_ns, cache, ipcache) ->
 269     let
 270         n          = length rdr_names_w_loc
 271         (us', us1) = splitUniqSupply us
 272         uniqs      = uniqsFromSupply n us1
 273         names      = [ mk_name uniq (rdrNameOcc rdr_name) loc
 274                      | ((rdr_name,loc), uniq) <- rdr_names_w_loc `zip` uniqs
 275                      ]
 276         mk_name    = case mode of
 277                         SourceMode    -> mkLocalName
 278                         InterfaceMode -> mkImportedLocalName
 279                      -- Keep track of whether the name originally came from
 280                      -- an interface file.
 281     in
 282     setNameSupplyRn (us', inst_ns, cache, ipcache)      `thenRn_`
 283
 284     let
 285         new_name_env = addListToRdrEnv name_env (map fst rdr_names_w_loc `zip` names)
 286     in
 287     setLocalNameEnv new_name_env (enclosed_scope names)
 288
 289   where
 290     check_shadow name_env (rdr_name,loc)
 291         = case lookupRdrEnv name_env rdr_name of
 292                 Nothing   -> returnRn ()
 293                 Just name -> pushSrcLocRn loc $
 294                              addWarnRn (shadowedNameWarn rdr_name)
 295
 296 bindCoreLocalFVRn :: RdrName -> (Name -> RnMS (a, FreeVars))
 297                   -> RnMS (a, FreeVars)
 298   -- A specialised variant when renaming stuff from interface
 299   -- files (of which there is a lot)
 300   --    * one at a time
 301   --    * no checks for shadowing
 302   --    * always imported
 303   --    * deal with free vars
 304 bindCoreLocalFVRn rdr_name enclosed_scope
 305   = getSrcLocRn                 `thenRn` \ loc ->
 306     getLocalNameEnv             `thenRn` \ name_env ->
 307     getNameSupplyRn             `thenRn` \ (us, inst_ns, cache, ipcache) ->
 308     let
 309         (us', us1) = splitUniqSupply us
 310         uniq       = uniqFromSupply us1
 311         name       = mkImportedLocalName uniq (rdrNameOcc rdr_name) loc
 312     in
 313     setNameSupplyRn (us', inst_ns, cache, ipcache)      `thenRn_`
 314     let
 315         new_name_env = extendRdrEnv name_env rdr_name name
 316     in
 317     setLocalNameEnv new_name_env (enclosed_scope name)  `thenRn` \ (result, fvs) ->
 318     returnRn (result, delFromNameSet fvs name)
 319
 320 bindCoreLocalsFVRn []     thing_inside = thing_inside []
 321 bindCoreLocalsFVRn (b:bs) thing_inside = bindCoreLocalFVRn b    $ \ name' ->
 322                                          bindCoreLocalsFVRn bs  $ \ names' ->
 323                                          thing_inside (name':names')
 324
 325 bindLocalNames names enclosed_scope
 326   = getLocalNameEnv             `thenRn` \ name_env ->
 327     setLocalNameEnv (addListToRdrEnv name_env pairs)
 328                     enclosed_scope
 329   where
 330     pairs = [(mkRdrUnqual (nameOccName n), n) | n <- names]
 331
 332 -------------------------------------
 333 bindLocalRn doc rdr_name enclosed_scope
 334   = getSrcLocRn                                 `thenRn` \ loc ->
 335     bindLocatedLocalsRn doc [(rdr_name,loc)]    $ \ (n:ns) ->
 336     ASSERT( null ns )
 337     enclosed_scope n
 338
 339 bindLocalsRn doc rdr_names enclosed_scope
 340   = getSrcLocRn         `thenRn` \ loc ->
 341     bindLocatedLocalsRn doc
 342                         (rdr_names `zip` repeat loc)
 343                         enclosed_scope
 344
 345         -- binLocalsFVRn is the same as bindLocalsRn
 346         -- except that it deals with free vars
 347 bindLocalsFVRn doc rdr_names enclosed_scope
 348   = bindLocalsRn doc rdr_names          $ \ names ->
 349     enclosed_scope names                `thenRn` \ (thing, fvs) ->
 350     returnRn (thing, delListFromNameSet fvs names)
 351
 352 -------------------------------------
 353 bindUVarRn :: SDoc -> RdrName -> (Name -> RnMS (a, FreeVars)) -> RnMS (a, FreeVars)
 354 bindUVarRn = bindLocalRn
 355
 356 -------------------------------------
 357 extendTyVarEnvFVRn :: [HsTyVarBndr Name] -> RnMS (a, FreeVars) -> RnMS (a, FreeVars)
 358         -- This tiresome function is used only in rnDecl on InstDecl
 359 extendTyVarEnvFVRn tyvars enclosed_scope
 360   = bindLocalNames tyvar_names enclosed_scope   `thenRn` \ (thing, fvs) ->
 361     returnRn (thing, delListFromNameSet fvs tyvar_names)
 362   where
 363     tyvar_names = hsTyVarNames tyvars
 364
 365 bindTyVarsRn :: SDoc -> [HsTyVarBndr RdrName]
 366               -> ([HsTyVarBndr Name] -> RnMS a)
 367               -> RnMS a
 368 bindTyVarsRn doc_str tyvar_names enclosed_scope
 369   = bindTyVars2Rn doc_str tyvar_names   $ \ names tyvars ->
 370     enclosed_scope tyvars
 371
 372 -- Gruesome name: return Names as well as HsTyVars
 373 bindTyVars2Rn :: SDoc -> [HsTyVarBndr RdrName]
 374               -> ([Name] -> [HsTyVarBndr Name] -> RnMS a)
 375               -> RnMS a
 376 bindTyVars2Rn doc_str tyvar_names enclosed_scope
 377   = getSrcLocRn                                 `thenRn` \ loc ->
 378     let
 379         located_tyvars = [(hsTyVarName tv, loc) | tv <- tyvar_names]
 380     in
 381     bindLocatedLocalsRn doc_str located_tyvars  $ \ names ->
 382     enclosed_scope names (zipWith replaceTyVarName tyvar_names names)
 383
 384 bindTyVarsFVRn :: SDoc -> [HsTyVarBndr RdrName]
 385               -> ([HsTyVarBndr Name] -> RnMS (a, FreeVars))
 386               -> RnMS (a, FreeVars)
 387 bindTyVarsFVRn doc_str rdr_names enclosed_scope
 388   = bindTyVars2Rn doc_str rdr_names     $ \ names tyvars ->
 389     enclosed_scope tyvars               `thenRn` \ (thing, fvs) ->
 390     returnRn (thing, delListFromNameSet fvs names)
 391
 392 bindTyVarsFV2Rn :: SDoc -> [HsTyVarBndr RdrName]
 393               -> ([Name] -> [HsTyVarBndr Name] -> RnMS (a, FreeVars))
 394               -> RnMS (a, FreeVars)
 395 bindTyVarsFV2Rn doc_str rdr_names enclosed_scope
 396   = bindTyVars2Rn doc_str rdr_names     $ \ names tyvars ->
 397     enclosed_scope names tyvars         `thenRn` \ (thing, fvs) ->
 398     returnRn (thing, delListFromNameSet fvs names)
 399
 400
 401 -------------------------------------
 402 checkDupOrQualNames, checkDupNames :: SDoc
 403                                    -> [(RdrName, SrcLoc)]
 404                                    -> RnM d ()
 405         -- Works in any variant of the renamer monad
 406
 407 checkDupOrQualNames doc_str rdr_names_w_loc
 408   =     -- Check for use of qualified names
 409     mapRn_ (qualNameErr doc_str) quals  `thenRn_`
 410     checkDupNames doc_str rdr_names_w_loc
 411   where
 412     quals = filter (isQual.fst) rdr_names_w_loc
 413
 414 checkDupNames doc_str rdr_names_w_loc
 415   =     -- Check for duplicated names in a binding group
 416     mapRn_ (dupNamesErr doc_str) dups
 417   where
 418     (_, dups) = removeDups (\(n1,l1) (n2,l2) -> n1 `compare` n2) rdr_names_w_loc
 419 \end{code}
 420
 421
 422 %*********************************************************
 423 %*                                                      *
 424 \subsection{Looking up names}
 425 %*                                                      *
 426 %*********************************************************
 427
 428 Looking up a name in the RnEnv.
 429
 430 \begin{code}
 431 lookupBndrRn rdr_name
 432   = traceRn (text "lookupBndrRn" <+> ppr rdr_name)      `thenRn_`
 433     getNameEnvs         `thenRn` \ (global_env, local_env) ->
 434
 435         -- Try local env
 436     case lookupRdrEnv local_env rdr_name of {
 437           Just name -> returnRn name ;
 438           Nothing   ->
 439
 440     getModeRn   `thenRn` \ mode ->
 441     case mode of
 442         InterfaceMode ->        -- Look in the global name cache
 443                             mkImportedGlobalFromRdrName rdr_name                `thenRn` \ n ->
 444                             traceRn (text "lookupBndrRn result:" <+> ppr n)     `thenRn_`
 445                             returnRn n
 446
 447         SourceMode    -> -- Source mode, so look up a *qualified* version
 448                          -- of the name, so that we get the right one even
 449                          -- if there are many with the same occ name
 450                          -- There must *be* a binding
 451                 getModuleRn             `thenRn` \ mod ->
 452                 case lookupRdrEnv global_env (qualifyRdrName mod rdr_name) of
 453                   Just (name:rest) -> ASSERT( null rest )
 454                                       returnRn name
 455                   Nothing          ->   -- Almost always this case is a compiler bug.
 456                                         -- But consider a type signature that doesn't have
 457                                         -- a corresponding binder:
 458                                         --      module M where { f :: Int->Int }
 459                                         -- We use lookupSigOccRn, which uses lookupBndrRn (for good reasons)
 460                                         -- and we don't want to panic.  So we report an out-of-scope error
 461                                         failWithRn (mkUnboundName rdr_name)
 462                                                    (unknownNameErr rdr_name)
 463     }
 464
 465 -- lookupOccRn looks up an occurrence of a RdrName
 466 lookupOccRn :: RdrName -> RnMS Name
 467 lookupOccRn rdr_name
 468   = getNameEnvs                         `thenRn` \ (global_env, local_env) ->
 469     lookup_occ global_env local_env rdr_name
 470
 471 -- lookupGlobalOccRn is like lookupOccRn, except that it looks in the global
 472 -- environment.  It's used only for
 473 --      record field names
 474 --      class op names in class and instance decls
 475 lookupGlobalOccRn :: RdrName -> RnMS Name
 476 lookupGlobalOccRn rdr_name
 477   = getNameEnvs                         `thenRn` \ (global_env, local_env) ->
 478     lookup_global_occ global_env rdr_name
 479
 480 -- lookupSigOccRn is used for type signatures and pragmas
 481 -- Is this valid?
 482 --   module A
 483 --      import M( f )
 484 --      f :: Int -> Int
 485 --      f x = x
 486 -- It's clear that the 'f' in the signature must refer to A.f
 487 -- The Haskell98 report does not stipulate this, but it will!
 488 -- So we must treat the 'f' in the signature in the same way
 489 -- as the binding occurrence of 'f', using lookupBndrRn
 490 lookupSigOccRn :: RdrName -> RnMS Name
 491 lookupSigOccRn = lookupBndrRn
 492
 493
 494 -- Look in both local and global env
 495 lookup_occ global_env local_env rdr_name
 496   = case lookupRdrEnv local_env rdr_name of
 497           Just name -> returnRn name
 498           Nothing   -> lookup_global_occ global_env rdr_name
 499
 500 -- Look in global env only
 501 lookup_global_occ global_env rdr_name
 502   = case lookupRdrEnv global_env rdr_name of
 503         Just [name]         -> returnRn name
 504         Just stuff@(name:_) -> addNameClashErrRn rdr_name stuff `thenRn_`
 505                                returnRn name
 506         Nothing -> getModeRn    `thenRn` \ mode ->
 507                    case mode of
 508                         -- Not found when processing source code; so fail
 509                         SourceMode    -> failWithRn (mkUnboundName rdr_name)
 510                                                     (unknownNameErr rdr_name)
 511
 512                         -- Not found when processing an imported declaration,
 513                         -- so we create a new name for the purpose
 514                         InterfaceMode -> mkImportedGlobalFromRdrName rdr_name
 515 \end{code}
 516 %
 517 @lookupImplicitOccRn@ takes an RdrName representing an {\em original} name,
 518 and adds it to the occurrence pool so that it'll be loaded later.
 519 This is used when language constructs
 520 (such as monad comprehensions, overloaded literals, or deriving clauses)
 521 require some stuff to be loaded that isn't explicitly mentioned in the code.
 522
 523 This doesn't apply in interface mode, where everything is explicit,
 524 but we don't check for this case:
 525 it does no harm to record an ``extra'' occurrence
 526 and @lookupImplicitOccRn@ isn't used much in interface mode
 527 (it's only the @Nothing@ clause of @rnDerivs@ that calls it at all I think).
 528
 529   \fbox{{\em Jan 98: this comment is wrong: @rnHsType@ uses it quite a bit.}}
 530
 531 For List and Tuple types it's important to get the correct
 532 @isLocallyDefined@ flag, which is used in turn when deciding
 533 whether there are any instance decls in this module are ``special''.
 534 The name cache should have the correct provenance, though.
 535
 536 \begin{code}
 537 lookupImplicitOccRn :: RdrName -> RnM d Name
 538 lookupImplicitOccRn rdr_name = mkImportedGlobalFromRdrName rdr_name
 539
 540 lookupImplicitOccsRn :: [RdrName] -> RnM d NameSet
 541 lookupImplicitOccsRn rdr_names
 542   = mapRn lookupImplicitOccRn rdr_names `thenRn` \ names ->
 543     returnRn (mkNameSet names)
 544 \end{code}
 545
 546 @unQualInScope@ returns a function that takes a @Name@ and tells whether
 547 its unqualified name is in scope.  This is put as a boolean flag in
 548 the @Name@'s provenance to guide whether or not to print the name qualified
 549 in error messages.
 550
 551 \begin{code}
 552 unQualInScope :: GlobalRdrEnv -> Name -> Bool
 553 unQualInScope env
 554   = lookup
 555   where
 556     lookup name = case lookupRdrEnv env (mkRdrUnqual (nameOccName name)) of
 557                            Just [name'] -> name == name'
 558                            other        -> False
 559 \end{code}
 560
 561 %************************************************************************
 562 %*                                                                      *
 563 \subsection{Envt utility functions}
 564 %*                                                                      *
 565 %************************************************************************
 566
 567 \subsubsection{NameEnv}%  ================
 568
 569 \begin{code}
 570 plusGlobalRdrEnv :: GlobalRdrEnv -> GlobalRdrEnv -> GlobalRdrEnv
 571 plusGlobalRdrEnv env1 env2 = plusFM_C combine_globals env1 env2
 572
 573 addOneToGlobalRdrEnv :: GlobalRdrEnv -> RdrName -> Name -> GlobalRdrEnv
 574 addOneToGlobalRdrEnv env rdr_name name = addToFM_C combine_globals env rdr_name [name]
 575
 576 delOneFromGlobalRdrEnv :: GlobalRdrEnv -> RdrName -> GlobalRdrEnv
 577 delOneFromGlobalRdrEnv env rdr_name = delFromFM env rdr_name
 578
 579 combine_globals :: [Name]       -- Old
 580                 -> [Name]       -- New
 581                 -> [Name]
 582 combine_globals ns_old ns_new   -- ns_new is often short
 583   = foldr add ns_old ns_new
 584   where
 585     add n ns | any (is_duplicate n) ns_old = map choose ns      -- Eliminate duplicates
 586              | otherwise                   = n:ns
 587              where
 588                choose m | n==m && n `hasBetterProv` m = n
 589                         | otherwise                   = m
 590
 591
 592 is_duplicate :: Name -> Name -> Bool
 593 is_duplicate n1 n2 | isLocallyDefined n1 && isLocallyDefined n2 = False
 594                    | otherwise                                  = n1 == n2
 595 \end{code}
 596 We treat two bindings of a locally-defined name as a duplicate,
 597 because they might be two separate, local defns and we want to report
 598 and error for that, {\em not} eliminate a duplicate.
 599
 600 On the other hand, if you import the same name from two different
 601 import statements, we {\em d}* want to eliminate the duplicate, not report
 602 an error.
 603
 604 If a module imports itself then there might be a local defn and an imported
 605 defn of the same name; in this case the names will compare as equal, but
 606 will still have different provenances.
 607
 608
 609
 610 \subsubsection{AvailInfo}%  ================
 611
 612 \begin{code}
 613 plusAvail (Avail n1)       (Avail n2)       = Avail n1
 614 plusAvail (AvailTC n1 ns1) (AvailTC n2 ns2) = AvailTC n2 (nub (ns1 ++ ns2))
 615 -- Added SOF 4/97
 616 #ifdef DEBUG
 617 plusAvail a1 a2 = pprPanic "RnEnv.plusAvail" (hsep [pprAvail a1,pprAvail a2])
 618 #endif
 619
 620 addAvail :: AvailEnv -> AvailInfo -> AvailEnv
 621 addAvail avails avail = extendNameEnv_C plusAvail avails (availName avail) avail
 622
 623 emptyAvailEnv = emptyNameEnv
 624 unitAvailEnv :: AvailInfo -> AvailEnv
 625 unitAvailEnv a = unitNameEnv (availName a) a
 626
 627 plusAvailEnv :: AvailEnv -> AvailEnv -> AvailEnv
 628 plusAvailEnv = plusNameEnv_C plusAvail
 629
 630 availEnvElts = nameEnvElts
 631
 632 addAvailToNameSet :: NameSet -> AvailInfo -> NameSet
 633 addAvailToNameSet names avail = addListToNameSet names (availNames avail)
 634
 635 availsToNameSet :: [AvailInfo] -> NameSet
 636 availsToNameSet avails = foldl addAvailToNameSet emptyNameSet avails
 637
 638 availName :: GenAvailInfo name -> name
 639 availName (Avail n)     = n
 640 availName (AvailTC n _) = n
 641
 642 availNames :: GenAvailInfo name -> [name]
 643 availNames (Avail n)      = [n]
 644 availNames (AvailTC n ns) = ns
 645
 646 addSysAvails :: AvailInfo -> [Name] -> AvailInfo
 647 addSysAvails avail          []  = avail
 648 addSysAvails (AvailTC n ns) sys = AvailTC n (sys ++ ns)
 649
 650 rdrAvailInfo :: AvailInfo -> RdrAvailInfo
 651 -- Used when building the avails we are going to put in an interface file
 652 -- We sort the components to reduce needless wobbling of interfaces
 653 rdrAvailInfo (Avail n)      = Avail   (nameOccName n)
 654 rdrAvailInfo (AvailTC n ns) = AvailTC (nameOccName n) (sortLt (<) (map nameOccName ns))
 655
 656 filterAvail :: RdrNameIE        -- Wanted
 657             -> AvailInfo        -- Available
 658             -> Maybe AvailInfo  -- Resulting available;
 659                                 -- Nothing if (any of the) wanted stuff isn't there
 660
 661 filterAvail ie@(IEThingWith want wants) avail@(AvailTC n ns)
 662   | sub_names_ok = Just (AvailTC n (filter is_wanted ns))
 663   | otherwise    = Nothing
 664   where
 665     is_wanted name = nameOccName name `elem` wanted_occs
 666     sub_names_ok   = all (`elem` avail_occs) wanted_occs
 667     avail_occs     = map nameOccName ns
 668     wanted_occs    = map rdrNameOcc (want:wants)
 669
 670 filterAvail (IEThingAbs _) (AvailTC n ns)       = ASSERT( n `elem` ns )
 671                                                   Just (AvailTC n [n])
 672
 673 filterAvail (IEThingAbs _) avail@(Avail n)      = Just avail            -- Type synonyms
 674
 675 filterAvail (IEVar _)      avail@(Avail n)      = Just avail
 676 filterAvail (IEVar v)      avail@(AvailTC n ns) = Just (AvailTC n (filter wanted ns))
 677                                                 where
 678                                                   wanted n = nameOccName n == occ
 679                                                   occ      = rdrNameOcc v
 680         -- The second equation happens if we import a class op, thus
 681         --      import A( op )
 682         -- where op is a class operation
 683
 684 filterAvail (IEThingAll _) avail@(AvailTC _ _)   = Just avail
 685         -- We don't complain even if the IE says T(..), but
 686         -- no constrs/class ops of T are available
 687         -- Instead that's caught with a warning by the caller
 688
 689 filterAvail ie avail = Nothing
 690
 691 pprAvail :: AvailInfo -> SDoc
 692 pprAvail (AvailTC n ns) = ppr n <> case filter (/= n) ns of
 693                                         []  -> empty
 694                                         ns' -> parens (hsep (punctuate comma (map ppr ns')))
 695
 696 pprAvail (Avail n) = ppr n
 697 \end{code}
 698
 699
 700
 701
 702 %************************************************************************
 703 %*                                                                      *
 704 \subsection{Free variable manipulation}
 705 %*                                                                      *
 706 %************************************************************************
 707
 708 \begin{code}
 709 type FreeVars   = NameSet
 710
 711 plusFV   :: FreeVars -> FreeVars -> FreeVars
 712 addOneFV :: FreeVars -> Name -> FreeVars
 713 unitFV   :: Name -> FreeVars
 714 emptyFVs :: FreeVars
 715 plusFVs  :: [FreeVars] -> FreeVars
 716
 717 isEmptyFVs = isEmptyNameSet
 718 emptyFVs   = emptyNameSet
 719 plusFVs    = unionManyNameSets
 720 plusFV     = unionNameSets
 721
 722 -- No point in adding implicitly imported names to the free-var set
 723 addOneFV s n = addOneToNameSet s n
 724 unitFV     n = unitNameSet n
 725
 726 -- A useful utility
 727 mapFvRn f xs = mapRn f xs       `thenRn` \ stuff ->
 728                let
 729                   (ys, fvs_s) = unzip stuff
 730                in
 731                returnRn (ys, plusFVs fvs_s)
 732 \end{code}
 733
 734
 735 %************************************************************************
 736 %*                                                                      *
 737 \subsection{Envt utility functions}
 738 %*                                                                      *
 739 %************************************************************************
 740
 741
 742
 743 \begin{code}
 744 warnUnusedModules :: [ModuleName] -> RnM d ()
 745 warnUnusedModules mods
 746   | not opt_WarnUnusedImports = returnRn ()
 747   | otherwise                 = mapRn_ (addWarnRn . unused_mod) mods
 748   where
 749     unused_mod m = vcat [ptext SLIT("Module") <+> quotes (pprModuleName m) <+>
 750                            text "is imported, but nothing from it is used",
 751                          parens (ptext SLIT("except perhaps to re-export instances visible in") <+>
 752                                    quotes (pprModuleName m))]
 753
 754 warnUnusedLocalBinds, warnUnusedImports, warnUnusedMatches :: [Name] -> RnM d ()
 755 warnUnusedImports names
 756   | not opt_WarnUnusedImports
 757   = returnRn ()         -- Don't force names unless necessary
 758   | otherwise
 759   = warnUnusedBinds (const True) names
 760
 761 warnUnusedLocalBinds ns
 762   | not opt_WarnUnusedBinds = returnRn ()
 763   | otherwise               = warnUnusedBinds (const True) ns
 764
 765 warnUnusedMatches names
 766   | opt_WarnUnusedMatches = warnUnusedGroup (const True) names
 767   | otherwise             = returnRn ()
 768
 769 -------------------------
 770
 771 warnUnusedBinds :: (Bool -> Bool) -> [Name] -> RnM d ()
 772 warnUnusedBinds warn_when_local names
 773   = mapRn_ (warnUnusedGroup warn_when_local) groups
 774   where
 775         -- Group by provenance
 776    groups = equivClasses cmp names
 777    name1 `cmp` name2 = getNameProvenance name1 `cmp_prov` getNameProvenance name2
 778
 779    cmp_prov (LocalDef _ _) (NonLocalDef _ _)       = LT
 780    cmp_prov (LocalDef loc1 _) (LocalDef loc2 _)    = loc1 `compare` loc2
 781    cmp_prov (NonLocalDef (UserImport m1 loc1 _) _)
 782             (NonLocalDef (UserImport m2 loc2 _) _) =
 783          (m1 `compare` m2) `thenCmp` (loc1 `compare` loc2)
 784    cmp_prov (NonLocalDef _ _) (LocalDef _ _)       = GT
 785                         -- In-scope NonLocalDefs must have UserImport info on them
 786
 787 -------------------------
 788
 789 --      NOTE: the function passed to warnUnusedGroup is
 790 --      now always (const True) so we should be able to
 791 --      simplify the code slightly.  I'm leaving it there
 792 --      for now just in case I havn't realised why it was there.
 793 --      Looks highly bogus to me.  SLPJ Dec 99
 794
 795 warnUnusedGroup :: (Bool -> Bool) -> [Name] -> RnM d ()
 796 warnUnusedGroup emit_warning names
 797   | null filtered_names         = returnRn ()
 798   | not (emit_warning is_local) = returnRn ()
 799   | otherwise
 800   = pushSrcLocRn def_loc        $
 801     addWarnRn                   $
 802     sep [msg <> colon, nest 4 (fsep (punctuate comma (map ppr filtered_names)))]
 803   where
 804     filtered_names = filter reportable names
 805     name1          = head filtered_names
 806     (is_local, def_loc, msg)
 807         = case getNameProvenance name1 of
 808                 LocalDef loc _                       -> (True, loc, text "Defined but not used")
 809                 NonLocalDef (UserImport mod loc _) _ ->
 810                  (True, loc, text "Imported from" <+> quotes (ppr mod) <+>
 811                                                       text "but not used")
 812                 other -> (False, getSrcLoc name1, text "Strangely defined but not used")
 813
 814     reportable name = case occNameUserString (nameOccName name) of
 815                         ('_' : _) -> False
 816                         zz_other  -> True
 817         -- Haskell 98 encourages compilers to suppress warnings about
 818         -- unused names in a pattern if they start with "_".
 819 \end{code}
 820
 821 \begin{code}
 822 addNameClashErrRn rdr_name (name1:names)
 823   = addErrRn (vcat [ptext SLIT("Ambiguous occurrence") <+> quotes (ppr rdr_name),
 824                     ptext SLIT("It could refer to") <+> vcat (msg1 : msgs)])
 825   where
 826     msg1 = ptext  SLIT("either") <+> mk_ref name1
 827     msgs = [ptext SLIT("    or") <+> mk_ref name | name <- names]
 828     mk_ref name = quotes (ppr name) <> comma <+> pprNameProvenance name
 829
 830 fixityClashErr (rdr_name, ((_,how_in_scope1), (_, how_in_scope2)))
 831   = hang (hsep [ptext SLIT("Conflicting fixities for"), quotes (ppr rdr_name)])
 832         4 (vcat [ppr how_in_scope1,
 833                  ppr how_in_scope2])
 834
 835 shadowedNameWarn shadow
 836   = hsep [ptext SLIT("This binding for"),
 837                quotes (ppr shadow),
 838                ptext SLIT("shadows an existing binding")]
 839
 840 unknownNameErr name
 841   = sep [text flavour, ptext SLIT("not in scope:"), quotes (ppr name)]
 842   where
 843     flavour = occNameFlavour (rdrNameOcc name)
 844
 845 qualNameErr descriptor (name,loc)
 846   = pushSrcLocRn loc $
 847     addErrRn (hsep [ ptext SLIT("Invalid use of qualified name"),
 848                      quotes (ppr name),
 849                      ptext SLIT("in"),
 850                      descriptor])
 851
 852 dupNamesErr descriptor ((name,loc) : dup_things)
 853   = pushSrcLocRn loc $
 854     addErrRn ((ptext SLIT("Conflicting definitions for") <+> quotes (ppr name))
 855               $$
 856               (ptext SLIT("in") <+> descriptor))
 857 \end{code}