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