ghc/compiler/rename/RnEnv.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
   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_WarnUnusedNames )
  12 import HsSyn
  13 import RdrHsSyn         ( RdrName(..), RdrNameIE,
  14                           rdrNameOcc, ieOcc, isQual, qual
  15                         )
  16 import HsTypes          ( getTyVarName, replaceTyVarName )
  17 import BasicTypes       ( Fixity(..), FixityDirection(..), IfaceFlavour(..), pprModule )
  18 import RnMonad
  19 import Name             ( Name, OccName(..), Provenance(..), ExportFlag(..), NamedThing(..),
  20                           occNameString, occNameFlavour, getSrcLoc,
  21                           NameSet, emptyNameSet, addListToNameSet, nameSetToList,
  22                           mkLocalName, mkGlobalName, modAndOcc,
  23                           nameOccName, setNameProvenance, isVarOcc, getNameProvenance,
  24                           pprProvenance, pprOccName, pprModule, pprNameProvenance,
  25                           isLocalName
  26                         )
  27 import TyCon            ( TyCon )
  28 import TysWiredIn       ( tupleTyCon, listTyCon, charTyCon, intTyCon )
  29 import FiniteMap
  30 import Unique           ( Unique, Uniquable(..), unboundKey )
  31 import UniqFM           ( listToUFM, plusUFM_C )
  32 import Maybes           ( maybeToBool )
  33 import UniqSupply
  34 import SrcLoc           ( SrcLoc, noSrcLoc )
  35 import Outputable
  36 import Util             ( removeDups )
  37 import List             ( nub )
  38 \end{code}
  39
  40
  41
  42 %*********************************************************
  43 %*                                                      *
  44 \subsection{Making new names}
  45 %*                                                      *
  46 %*********************************************************
  47
  48 \begin{code}
  49 newImportedGlobalName :: Module -> OccName
  50                       -> IfaceFlavour
  51                       -> RnM s d Name
  52 newImportedGlobalName mod occ hif
  53   =     -- First check the cache
  54     getNameSupplyRn             `thenRn` \ (us, inst_ns, cache) ->
  55     let
  56         key = (mod,occ)
  57         prov = NonLocalDef noSrcLoc hif False
  58     in
  59     case lookupFM cache key of
  60
  61         -- A hit in the cache!
  62         -- If it has no provenance at the moment then set its provenance
  63         -- so that it has the right HiFlag component.
  64         -- (This is necessary
  65         -- for known-key things.  For example, GHCmain.lhs imports as SOURCE
  66         -- Main; but Main.main is a known-key thing.)
  67         -- Don't fiddle with the provenance if it already has one
  68         Just name -> case getNameProvenance name of
  69                         NoProvenance -> let
  70                                           new_name = setNameProvenance name prov
  71                                           new_cache = addToFM cache key new_name
  72                                         in
  73                                         setNameSupplyRn (us, inst_ns, new_cache)        `thenRn_`
  74                                         returnRn new_name
  75                         other        -> returnRn name
  76
  77         Nothing ->      -- Miss in the cache!
  78                         -- Build a new original name, and put it in the cache
  79                    let
  80                         (us', us1) = splitUniqSupply us
  81                         uniq       = getUnique us1
  82                         name       = mkGlobalName uniq mod occ prov
  83                         new_cache  = addToFM cache key name
  84                    in
  85                    setNameSupplyRn (us', inst_ns, new_cache)            `thenRn_`
  86                    returnRn name
  87
  88 {-
  89             let
  90               pprC ((mod,occ),name) = pprModule mod <> text "." <> pprOccName occ <+> text "--->"
  91                                      <+> ppr name
  92             in
  93             pprTrace "ng" (vcat [text "newGlobalName miss" <+> pprModule mod <+> pprOccName occ,
  94                            brackets (sep (map pprC (fmToList cache))),
  95                            text ""
  96                           ])            $
  97 -}
  98
  99
 100 newLocallyDefinedGlobalName :: Module -> OccName
 101                             -> (Name -> ExportFlag) -> SrcLoc
 102                             -> RnM s d Name
 103 newLocallyDefinedGlobalName mod occ rec_exp_fn loc
 104   =     -- First check the cache
 105     getNameSupplyRn             `thenRn` \ (us, inst_ns, cache) ->
 106     let
 107         key = (mod,occ)
 108     in
 109     case lookupFM cache key of
 110
 111         -- A hit in the cache!
 112         -- Overwrite whatever provenance is in the cache already;
 113         -- this updates WiredIn things and known-key things,
 114         -- which are there from the start, to LocalDef.
 115         Just name -> let
 116                         new_name = setNameProvenance name (LocalDef loc (rec_exp_fn new_name))
 117                         new_cache = addToFM cache key new_name
 118                      in
 119                      setNameSupplyRn (us, inst_ns, new_cache)           `thenRn_`
 120                      returnRn new_name
 121
 122         -- Miss in the cache!
 123         -- Build a new original name, and put it in the cache
 124         Nothing -> let
 125                         provenance = LocalDef loc (rec_exp_fn new_name)
 126                         (us', us1) = splitUniqSupply us
 127                         uniq       = getUnique us1
 128                         new_name   = mkGlobalName uniq mod occ provenance
 129                         new_cache  = addToFM cache key new_name
 130                    in
 131                    setNameSupplyRn (us', inst_ns, new_cache)            `thenRn_`
 132                    returnRn new_name
 133
 134
 135 -- newDfunName is a variant, specially for dfuns.
 136 -- When renaming derived definitions we are in *interface* mode (because we can trip
 137 -- over original names), but we still want to make the Dfun locally-defined.
 138 -- So we can't use whether or not we're in source mode to decide the locally-defined question.
 139 newDfunName :: Maybe RdrName -> SrcLoc -> RnMS s Name
 140 newDfunName Nothing src_loc                     -- Local instance decls have a "Nothing"
 141   = getModuleRn         `thenRn` \ mod_name ->
 142     newInstUniq         `thenRn` \ inst_uniq ->
 143     let
 144         dfun_occ = VarOcc (_PK_ ("$d" ++ show inst_uniq))
 145     in
 146     newLocallyDefinedGlobalName mod_name dfun_occ
 147                                 (\_ -> Exported) src_loc
 148
 149 newDfunName (Just n) src_loc                    -- Imported ones have "Just n"
 150   = getModuleRn         `thenRn` \ mod_name ->
 151     newImportedGlobalName mod_name (rdrNameOcc n) HiFile {- Correct? -}
 152
 153
 154 newLocalNames :: [(RdrName,SrcLoc)] -> RnM s d [Name]
 155 newLocalNames rdr_names
 156   = getNameSupplyRn             `thenRn` \ (us, inst_ns, cache) ->
 157     let
 158         n          = length rdr_names
 159         (us', us1) = splitUniqSupply us
 160         uniqs      = getUniques n us1
 161         locals     = [ mkLocalName uniq (rdrNameOcc rdr_name) loc
 162                      | ((rdr_name,loc), uniq) <- rdr_names `zip` uniqs
 163                      ]
 164     in
 165     setNameSupplyRn (us', inst_ns, cache)       `thenRn_`
 166     returnRn locals
 167
 168 -- mkUnboundName makes a place-holder Name; it shouldn't be looked at except possibly
 169 -- during compiler debugging.
 170 mkUnboundName :: RdrName -> Name
 171 mkUnboundName rdr_name = mkLocalName unboundKey (rdrNameOcc rdr_name) noSrcLoc
 172
 173 isUnboundName :: Name -> Bool
 174 isUnboundName name = uniqueOf name == unboundKey
 175 \end{code}
 176
 177 \begin{code}
 178 bindLocatedLocalsRn :: SDoc                     -- Documentation string for error message
 179                     -> [(RdrName,SrcLoc)]
 180                     -> ([Name] -> RnMS s a)
 181                     -> RnMS s a
 182 bindLocatedLocalsRn doc_str rdr_names_w_loc enclosed_scope
 183   = checkDupOrQualNames doc_str rdr_names_w_loc `thenRn_`
 184
 185     getLocalNameEnv                     `thenRn` \ name_env ->
 186     (if opt_WarnNameShadowing
 187      then
 188         mapRn (check_shadow name_env) rdr_names_w_loc
 189      else
 190         returnRn []
 191     )                                   `thenRn_`
 192
 193     newLocalNames rdr_names_w_loc       `thenRn` \ names ->
 194     let
 195         new_name_env = addListToFM name_env (map fst rdr_names_w_loc `zip` names)
 196     in
 197     setLocalNameEnv new_name_env (enclosed_scope names)
 198   where
 199     check_shadow name_env (rdr_name,loc)
 200         = case lookupFM name_env rdr_name of
 201                 Nothing   -> returnRn ()
 202                 Just name -> pushSrcLocRn loc $
 203                              addWarnRn (shadowedNameWarn rdr_name)
 204
 205 bindLocalsRn doc_str rdr_names enclosed_scope
 206   = getSrcLocRn         `thenRn` \ loc ->
 207     bindLocatedLocalsRn (text doc_str)
 208                         (rdr_names `zip` repeat loc)
 209                         enclosed_scope
 210
 211 bindTyVarsRn doc_str tyvar_names enclosed_scope
 212   = getSrcLocRn                                 `thenRn` \ loc ->
 213     let
 214         located_tyvars = [(getTyVarName tv, loc) | tv <- tyvar_names]
 215     in
 216     bindLocatedLocalsRn doc_str located_tyvars  $ \ names ->
 217     enclosed_scope (zipWith replaceTyVarName tyvar_names names)
 218
 219         -- Works in any variant of the renamer monad
 220 checkDupOrQualNames, checkDupNames :: SDoc
 221                                    -> [(RdrName, SrcLoc)]
 222                                    -> RnM s d ()
 223
 224 checkDupOrQualNames doc_str rdr_names_w_loc
 225   =     -- Check for use of qualified names
 226     mapRn (qualNameErr doc_str) quals   `thenRn_`
 227     checkDupNames doc_str rdr_names_w_loc
 228   where
 229     quals = filter (isQual.fst) rdr_names_w_loc
 230
 231 checkDupNames doc_str rdr_names_w_loc
 232   =     -- Check for dupicated names in a binding group
 233     mapRn (dupNamesErr doc_str) dups    `thenRn_`
 234     returnRn ()
 235   where
 236     (_, dups) = removeDups (\(n1,l1) (n2,l2) -> n1 `compare` n2) rdr_names_w_loc
 237
 238
 239 -- Yuk!
 240 ifaceFlavour name = case getNameProvenance name of
 241                         NonLocalDef _ hif _ -> hif
 242                         other               -> HiFile   -- Shouldn't happen
 243 \end{code}
 244
 245
 246 %*********************************************************
 247 %*                                                      *
 248 \subsection{Looking up names}
 249 %*                                                      *
 250 %*********************************************************
 251
 252 Looking up a name in the RnEnv.
 253
 254 \begin{code}
 255 lookupRn :: RdrName
 256          -> Maybe Name          -- Result of environment lookup
 257          -> RnMS s Name
 258
 259 lookupRn rdr_name (Just name)
 260   =     -- Found the name in the envt
 261     returnRn name       -- In interface mode the only things in
 262                         -- the environment are things in local (nested) scopes
 263
 264 lookupRn rdr_name Nothing
 265   =     -- We didn't find the name in the environment
 266     getModeRn           `thenRn` \ mode ->
 267     case mode of {
 268         SourceMode -> failWithRn (mkUnboundName rdr_name)
 269                                  (unknownNameErr rdr_name) ;
 270                 -- Souurce mode; lookup failure is an error
 271
 272         InterfaceMode _ _ ->
 273
 274
 275         ----------------------------------------------------
 276         -- OK, so we're in interface mode
 277         -- An Unqual is allowed; interface files contain
 278         -- unqualified names for locally-defined things, such as
 279         -- constructors of a data type.
 280         -- So, qualify the unqualified name with the
 281         -- module of the interface file, and try again
 282     case rdr_name of
 283         Unqual occ       -> getModuleRn         `thenRn` \ mod ->
 284                             newImportedGlobalName mod occ HiFile
 285         Qual mod occ hif -> newImportedGlobalName mod occ hif
 286
 287     }
 288
 289 lookupBndrRn rdr_name
 290   = lookupNameRn rdr_name               `thenRn` \ maybe_name ->
 291     lookupRn rdr_name maybe_name        `thenRn` \ name ->
 292
 293     if isLocalName name then
 294         returnRn name
 295     else
 296
 297         ----------------------------------------------------
 298         -- OK, so we're at the binding site of a top-level defn
 299         -- Check to see whether its an imported decl
 300     getModeRn           `thenRn` \ mode ->
 301     case mode of {
 302           SourceMode -> returnRn name ;
 303
 304           InterfaceMode _ print_unqual_fn ->
 305
 306         ----------------------------------------------------
 307         -- OK, the binding site of an *imported* defn
 308         -- so we can make the provenance more informative
 309     getSrcLocRn         `thenRn` \ src_loc ->
 310     let
 311         name' = case getNameProvenance name of
 312                     NonLocalDef _ hif _ -> setNameProvenance name
 313                                                 (NonLocalDef src_loc hif (print_unqual_fn name'))
 314                     other               -> name
 315     in
 316     returnRn name'
 317     }
 318
 319 -- Just like lookupRn except that we record the occurrence too
 320 -- Perhaps surprisingly, even wired-in names are recorded.
 321 -- Why?  So that we know which wired-in names are referred to when
 322 -- deciding which instance declarations to import.
 323 lookupOccRn :: RdrName -> RnMS s Name
 324 lookupOccRn rdr_name
 325   = lookupNameRn rdr_name               `thenRn` \ maybe_name ->
 326     lookupRn rdr_name maybe_name        `thenRn` \ name ->
 327     let
 328         name' = mungePrintUnqual rdr_name name
 329     in
 330     addOccurrenceName name'
 331
 332 -- lookupGlobalOccRn is like lookupOccRn, except that it looks in the global
 333 -- environment only.  It's used for record field names only.
 334 lookupGlobalOccRn :: RdrName -> RnMS s Name
 335 lookupGlobalOccRn rdr_name
 336   = lookupGlobalNameRn rdr_name         `thenRn` \ maybe_name ->
 337     lookupRn rdr_name maybe_name        `thenRn` \ name ->
 338     let
 339         name' = mungePrintUnqual rdr_name name
 340     in
 341     addOccurrenceName name'
 342
 343 -- mungePrintUnqual is used to make *imported* *occurrences* print unqualified
 344 -- if they were mentioned unqualified in the source code.
 345 -- This improves error messages from the type checker.
 346 -- NB: the binding site is treated differently; see lookupBndrRn
 347 --     After the type checker all occurrences are replaced by the one
 348 --     at the binding site.
 349 mungePrintUnqual (Qual _ _ _) name = name
 350 mungePrintUnqual (Unqual _)   name = case new_prov of
 351                                         Nothing    -> name
 352                                         Just prov' -> setNameProvenance name prov'
 353                                    where
 354                                      new_prov = case getNameProvenance name of
 355                                                    NonLocalDef loc hif False -> Just (NonLocalDef loc hif True)
 356                                                    other                     -> Nothing
 357
 358 -- lookupImplicitOccRn takes an RdrName representing an *original* name, and
 359 -- adds it to the occurrence pool so that it'll be loaded later.  This is
 360 -- used when language constructs (such as monad comprehensions, overloaded literals,
 361 -- or deriving clauses) require some stuff to be loaded that isn't explicitly
 362 -- mentioned in the code.
 363 --
 364 -- This doesn't apply in interface mode, where everything is explicit, but
 365 -- we don't check for this case: it does no harm to record an "extra" occurrence
 366 -- and lookupImplicitOccRn isn't used much in interface mode (it's only the
 367 -- Nothing clause of rnDerivs that calls it at all I think).
 368 --      [Jan 98: this comment is wrong: rnHsType uses it quite a bit.]
 369 --
 370 -- For List and Tuple types it's important to get the correct
 371 -- isLocallyDefined flag, which is used in turn when deciding
 372 -- whether there are any instance decls in this module are "special".
 373 -- The name cache should have the correct provenance, though.
 374
 375 lookupImplicitOccRn :: RdrName -> RnMS s Name
 376 lookupImplicitOccRn (Qual mod occ hif)
 377  = newImportedGlobalName mod occ hif    `thenRn` \ name ->
 378    addOccurrenceName name
 379
 380 addImplicitOccRn :: Name -> RnMS s Name
 381 addImplicitOccRn name = addOccurrenceName name
 382
 383 addImplicitOccsRn :: [Name] -> RnMS s ()
 384 addImplicitOccsRn names = addOccurrenceNames names
 385
 386 listType_RDR    = qual (modAndOcc listType_name)
 387 tupleType_RDR n = qual (modAndOcc (tupleType_name n))
 388
 389 charType_name    = getName charTyCon
 390 listType_name    = getName listTyCon
 391 tupleType_name n = getName (tupleTyCon n)
 392 \end{code}
 393
 394 \begin{code}
 395 lookupFixity :: RdrName -> RnMS s Fixity
 396 lookupFixity rdr_name
 397   = getFixityEnv        `thenRn` \ fixity_env ->
 398     returnRn (lookupFixityEnv fixity_env rdr_name)
 399 \end{code}
 400
 401 mkImportFn returns a function that takes a Name and tells whether
 402 its unqualified name is in scope.  This is put as a boolean flag in
 403 the Name's provenance to guide whether or not to print the name qualified
 404 in error messages.
 405
 406 \begin{code}
 407 mkImportFn :: RnEnv -> Name -> Bool
 408 mkImportFn (RnEnv env _)
 409   = lookup
 410   where
 411     lookup name = case lookupFM env (Unqual (nameOccName name)) of
 412                            Just (name', _) -> name == name'
 413                            Nothing         -> False
 414 \end{code}
 415
 416 %************************************************************************
 417 %*                                                                      *
 418 \subsection{Envt utility functions}
 419 %*                                                                      *
 420 %************************************************************************
 421
 422 ===============  RnEnv  ================
 423 \begin{code}
 424 plusRnEnv (RnEnv n1 f1) (RnEnv n2 f2)
 425   = plusGlobalNameEnvRn n1 n2           `thenRn` \ n ->
 426     plusFixityEnvRn f1 f2               `thenRn` \ f ->
 427     returnRn (RnEnv n f)
 428 \end{code}
 429
 430
 431 ===============  NameEnv  ================
 432 \begin{code}
 433 plusGlobalNameEnvRn :: GlobalNameEnv -> GlobalNameEnv -> RnM s d GlobalNameEnv
 434 plusGlobalNameEnvRn env1 env2
 435   = mapRn (addErrRn.nameClashErr) (conflictsFM conflicting_name env1 env2)              `thenRn_`
 436     returnRn (env1 `plusFM` env2)
 437
 438 addOneToGlobalNameEnv :: GlobalNameEnv -> RdrName -> (Name, HowInScope) -> RnM s d GlobalNameEnv
 439 addOneToGlobalNameEnv env rdr_name name
 440  = case lookupFM env rdr_name of
 441         Just name2 | conflicting_name name name2
 442                    -> addErrRn (nameClashErr (rdr_name, (name, name2))) `thenRn_`
 443                       returnRn env
 444
 445         other      -> returnRn (addToFM env rdr_name name)
 446
 447 delOneFromGlobalNameEnv :: GlobalNameEnv -> RdrName -> GlobalNameEnv
 448 delOneFromGlobalNameEnv env rdr_name = delFromFM env rdr_name
 449
 450 conflicting_name :: (Name, HowInScope) -> (Name, HowInScope) -> Bool
 451 conflicting_name (n1, FromLocalDefn _) (n2, FromLocalDefn _) = True
 452 conflicting_name (n1,h1)               (n2,h2)               = n1 /= n2
 453         -- We complain of a conflict if one RdrName maps to two different Names,
 454         -- OR if one RdrName maps to the same *locally-defined* Name.  The latter
 455         -- case is to catch two separate, local definitions of the same thing.
 456         --
 457         -- If a module imports itself then there might be a local defn and an imported
 458         -- defn of the same name; in this case the names will compare as equal, but
 459         -- will still have different HowInScope fields
 460
 461 lookupNameEnv :: NameEnv -> RdrName -> Maybe Name
 462 lookupNameEnv = lookupFM
 463 \end{code}
 464
 465 ===============  FixityEnv  ================
 466 \begin{code}
 467 plusFixityEnvRn f1 f2
 468   = mapRn (addErrRn.fixityClashErr) (conflictsFM bad_fix f1 f2)         `thenRn_`
 469     returnRn (f1 `plusFM` f2)
 470
 471 addOneToFixityEnv env rdr_name fixity = addToFM env rdr_name fixity
 472
 473 lookupFixityEnv env rdr_name
 474   = case lookupFM env rdr_name of
 475         Just (fixity,_) -> fixity
 476         Nothing         -> Fixity 9 InfixL              -- Default case
 477
 478 bad_fix :: (Fixity, HowInScope) -> (Fixity, HowInScope) -> Bool
 479 bad_fix (f1,_) (f2,_) = f1 /= f2
 480
 481 pprFixityProvenance :: (Fixity, HowInScope) -> SDoc
 482 pprFixityProvenance (fixity, how_in_scope) = ppr how_in_scope
 483 \end{code}
 484
 485
 486
 487 ===============  Avails  ================
 488 \begin{code}
 489 mkExportAvails :: Bool -> Module -> [AvailInfo] -> ExportAvails
 490 mkExportAvails unqualified_import mod_name avails
 491   = (mod_avail_env, entity_avail_env)
 492   where
 493         -- The "module M" syntax only applies to *unqualified* imports (1.4 Report, Section 5.1.1)
 494     mod_avail_env | unqualified_import = unitFM mod_name avails
 495                   | otherwise          = emptyFM
 496
 497     entity_avail_env = listToUFM [ (name,avail) | avail <- avails,
 498                                                   name  <- availEntityNames avail]
 499
 500 plusExportAvails ::  ExportAvails ->  ExportAvails ->  ExportAvails
 501 plusExportAvails (m1, e1) (m2, e2)
 502   = (plusFM_C (++) m1 m2, plusUFM_C plusAvail e1 e2)
 503 \end{code}
 504
 505
 506 ===============  AvailInfo  ================
 507 \begin{code}
 508 plusAvail (Avail n1)       (Avail n2)       = Avail n1
 509 plusAvail (AvailTC n1 ns1) (AvailTC n2 ns2) = AvailTC n1 (nub (ns1 ++ ns2))
 510 plusAvail a NotAvailable = a
 511 plusAvail NotAvailable a = a
 512 -- Added SOF 4/97
 513 #ifdef DEBUG
 514 plusAvail a1 a2 = pprPanic "RnEnv.plusAvail" (hsep [pprAvail a1,pprAvail a2])
 515 #endif
 516
 517 addAvailToNameSet :: NameSet -> AvailInfo -> NameSet
 518 addAvailToNameSet names avail = addListToNameSet names (availNames avail)
 519
 520 availsToNameSet :: [AvailInfo] -> NameSet
 521 availsToNameSet avails = foldl addAvailToNameSet emptyNameSet avails
 522
 523 availName :: AvailInfo -> Name
 524 availName (Avail n)     = n
 525 availName (AvailTC n _) = n
 526
 527 availNames :: AvailInfo -> [Name]
 528 availNames NotAvailable   = []
 529 availNames (Avail n)      = [n]
 530 availNames (AvailTC n ns) = ns
 531
 532 -- availEntityNames is used to extract the names that can appear on their own in
 533 -- an export or import list.  For class decls, class methods can appear on their
 534 -- own, thus    import A( op )
 535 -- but constructors cannot; thus
 536 --              import B( T )
 537 -- means import type T from B, not constructor T.
 538
 539 availEntityNames :: AvailInfo -> [Name]
 540 availEntityNames NotAvailable   = []
 541 availEntityNames (Avail n)      = [n]
 542 availEntityNames (AvailTC n ns) = n : filter (isVarOcc . nameOccName) ns
 543
 544 filterAvail :: RdrNameIE        -- Wanted
 545             -> AvailInfo        -- Available
 546             -> AvailInfo        -- Resulting available;
 547                                 -- NotAvailable if wanted stuff isn't there
 548
 549 filterAvail ie@(IEThingWith want wants) avail@(AvailTC n ns)
 550   | sub_names_ok = AvailTC n (filter is_wanted ns)
 551   | otherwise    = pprTrace "filterAvail" (hsep [ppr ie, pprAvail avail]) $
 552                    NotAvailable
 553   where
 554     is_wanted name = nameOccName name `elem` wanted_occs
 555     sub_names_ok   = all (`elem` avail_occs) wanted_occs
 556     avail_occs     = map nameOccName ns
 557     wanted_occs    = map rdrNameOcc (want:wants)
 558
 559 filterAvail (IEThingAbs _) (AvailTC n ns)
 560   | n `elem` ns = AvailTC n [n]
 561
 562 filterAvail (IEThingAbs _) avail@(Avail n)      = avail         -- Type synonyms
 563
 564 filterAvail (IEVar _)      avail@(Avail n)      = avail
 565 filterAvail (IEVar v)      avail@(AvailTC n ns) = AvailTC n (filter wanted ns)
 566                                                 where
 567                                                   wanted n = nameOccName n == occ
 568                                                   occ      = rdrNameOcc v
 569         -- The second equation happens if we import a class op, thus
 570         --      import A( op )
 571         -- where op is a class operation
 572
 573 filterAvail (IEThingAll _) avail@(AvailTC _ _)  = avail
 574
 575 filterAvail ie avail = NotAvailable
 576
 577
 578 -- In interfaces, pprAvail gets given the OccName of the "host" thing
 579 pprAvail avail = getPprStyle $ \ sty ->
 580                  if ifaceStyle sty then
 581                     ppr_avail (pprOccName . nameOccName) avail
 582                  else
 583                     ppr_avail ppr avail
 584
 585 ppr_avail pp_name NotAvailable = ptext SLIT("NotAvailable")
 586 ppr_avail pp_name (AvailTC n ns) = hsep [
 587                                      pp_name n,
 588                                      parens  $ hsep $ punctuate comma $
 589                                      map pp_name ns
 590                                    ]
 591 ppr_avail pp_name (Avail n) = pp_name n
 592 \end{code}
 593
 594
 595
 596
 597 %************************************************************************
 598 %*                                                                      *
 599 \subsection{Finite map utilities}
 600 %*                                                                      *
 601 %************************************************************************
 602
 603
 604 Generally useful function on finite maps to check for overlap.
 605
 606 \begin{code}
 607 conflictsFM :: Ord a
 608             => (b->b->Bool)             -- False <=> no conflict; you can pick either
 609             -> FiniteMap a b -> FiniteMap a b
 610             -> [(a,(b,b))]
 611 conflictsFM bad fm1 fm2
 612   = filter (\(a,(b1,b2)) -> bad b1 b2)
 613            (fmToList (intersectFM_C (\b1 b2 -> (b1,b2)) fm1 fm2))
 614
 615 conflictFM :: Ord a
 616            => (b->b->Bool)
 617            -> FiniteMap a b -> a -> b
 618            -> Maybe (a,(b,b))
 619 conflictFM bad fm key elt
 620   = case lookupFM fm key of
 621         Just elt' | bad elt elt' -> Just (key,(elt,elt'))
 622         other                    -> Nothing
 623 \end{code}
 624
 625
 626 %************************************************************************
 627 %*                                                                      *
 628 \subsection{Envt utility functions}
 629 %*                                                                      *
 630 %************************************************************************
 631
 632
 633 \begin{code}
 634 warnUnusedNames :: NameSet -> RnM s d ()
 635 warnUnusedNames names
 636   | not opt_WarnUnusedNames = returnRn ()
 637   | otherwise               = mapRn warn (nameSetToList names)  `thenRn_`
 638                               returnRn ()
 639   where
 640     warn name = pushSrcLocRn (getSrcLoc name) $
 641                 addWarnRn (unusedNameWarn name)
 642
 643 unusedNameWarn name = quotes (ppr name) <+> ptext SLIT("is bound but not used")
 644
 645 nameClashErr (rdr_name, ((_,how_in_scope1), (_, how_in_scope2)))
 646   = hang (hsep [ptext SLIT("Conflicting definitions for"), quotes (ppr rdr_name)])
 647         4 (vcat [ppr how_in_scope1,
 648                  ppr how_in_scope2])
 649
 650 fixityClashErr (rdr_name, ((_,how_in_scope1), (_, how_in_scope2)))
 651   = hang (hsep [ptext SLIT("Conflicting fixities for"), quotes (ppr rdr_name)])
 652         4 (vcat [ppr how_in_scope1,
 653                  ppr how_in_scope2])
 654
 655 shadowedNameWarn shadow
 656   = hcat [ptext SLIT("This binding for"),
 657                quotes (ppr shadow),
 658                ptext SLIT("shadows an existing binding")]
 659
 660 unknownNameErr name
 661   = sep [text flavour, ptext SLIT("not in scope:"), quotes (ppr name)]
 662   where
 663     flavour = occNameFlavour (rdrNameOcc name)
 664
 665 qualNameErr descriptor (name,loc)
 666   = pushSrcLocRn loc $
 667     addErrRn (hsep [ ptext SLIT("Invalid use of qualified name"),
 668                      quotes (ppr name),
 669                      ptext SLIT("in"),
 670                      descriptor])
 671
 672 dupNamesErr descriptor ((name,loc) : dup_things)
 673   = pushSrcLocRn loc $
 674     addErrRn (hsep [ptext SLIT("Conflicting definitions for"),
 675                     quotes (ppr name),
 676                     ptext SLIT("in"), descriptor])
 677 \end{code}
 678