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 #include "HsVersions.h"
   8
   9 module RnEnv where              -- Export everything
  10
  11 IMP_Ubiq()
  12
  13 import CmdLineOpts      ( opt_WarnNameShadowing )
  14 import HsSyn
  15 import RdrHsSyn         ( RdrName(..), SYN_IE(RdrNameIE),
  16                           rdrNameOcc, ieOcc, isQual, qual
  17                         )
  18 import HsTypes          ( getTyVarName, replaceTyVarName )
  19 import RnMonad
  20 import Name             ( Name, OccName(..), Provenance(..), DefnInfo(..), ExportFlag(..),
  21                           occNameString, occNameFlavour,
  22                           SYN_IE(NameSet), emptyNameSet, addListToNameSet,
  23                           mkLocalName, mkGlobalName, modAndOcc, isLocallyDefinedName,
  24                           nameOccName, setNameProvenance, isVarOcc, getNameProvenance,
  25                           pprProvenance, pprOccName, pprModule, pprNameProvenance,
  26                           NamedThing(..)
  27                         )
  28 import TyCon            ( TyCon )
  29 import TysWiredIn       ( tupleTyCon, listTyCon, charTyCon, intTyCon )
  30 import FiniteMap
  31 import Outputable
  32 import Unique           ( Unique, unboundKey )
  33 import UniqFM           ( Uniquable(..) )
  34 import Maybes           ( maybeToBool )
  35 import UniqSupply
  36 import SrcLoc           ( SrcLoc, noSrcLoc )
  37 import Pretty
  38 import PprStyle         ( PprStyle(..) )
  39 import Util             --( panic, removeDups, pprTrace, assertPanic )
  40 #if __GLASGOW_HASKELL__ >= 202
  41 import List (nub)
  42 #endif
  43 \end{code}
  44
  45
  46
  47 %*********************************************************
  48 %*                                                      *
  49 \subsection{Making new names}
  50 %*                                                      *
  51 %*********************************************************
  52
  53 \begin{code}
  54 newGlobalName :: Module -> OccName -> RnM s d Name
  55 newGlobalName mod occ
  56   =     -- First check the cache
  57     getNameSupplyRn             `thenRn` \ (us, inst_ns, cache) ->
  58     let key = (mod,occ)         in
  59     case lookupFM cache key of
  60
  61         -- A hit in the cache!  Return it, but change the src loc
  62         -- of the thing we've found if this is a second definition site
  63         -- (that is, if loc /= NoSrcLoc)
  64         Just name ->  returnRn name
  65
  66         -- Miss in the cache, so build a new original name,
  67         -- and put it in the cache
  68         Nothing        ->
  69             let
  70                 (us', us1) = splitUniqSupply us
  71                 uniq       = getUnique us1
  72                 name       = mkGlobalName uniq mod occ VanillaDefn Implicit
  73                 cache'     = addToFM cache key name
  74             in
  75             setNameSupplyRn (us', inst_ns, cache')              `thenRn_`
  76             returnRn name
  77
  78 newLocallyDefinedGlobalName :: Module -> OccName
  79                             -> (Name -> ExportFlag) -> SrcLoc
  80                             -> RnM s d Name
  81 newLocallyDefinedGlobalName mod occ rec_exp_fn loc
  82   =     -- First check the cache
  83     getNameSupplyRn             `thenRn` \ (us, inst_ns, cache) ->
  84
  85         -- We are at the binding site for a locally-defined thing, so
  86         -- you might think it can't be in the cache, but it can if it's a
  87         -- wired in thing. In that case we need to use the correct unique etc...
  88         -- so all we do is replace its provenance.
  89         -- If it's not in the cache we put it there with the correct provenance.
  90         -- The idea is that, after all this, the cache
  91         -- will contain a Name with the correct Provenance (i.e. Local)
  92         --
  93         -- Actually, there's a catch.  If this is the *second* binding for something
  94         -- we want to allocate a *fresh* unique, rather than using the same Name as before.
  95         -- Otherwise we don't detect conflicting definitions of the same top-level name!
  96         -- So the only time we re-use a Name already in the cache is when it's one of
  97         -- the Implicit magic-unique ones mentioned in the previous para
  98     let
  99         provenance = LocalDef (rec_exp_fn new_name) loc
 100         (us', us1) = splitUniqSupply us
 101         uniq       = getUnique us1
 102         key        = (mod,occ)
 103         new_name   = case lookupFM cache key of
 104                          Just name | is_implicit_prov
 105                                    -> setNameProvenance name provenance
 106                                    where
 107                                       is_implicit_prov = case getNameProvenance name of
 108                                                             Implicit -> True
 109                                                             other    -> False
 110                          other   -> mkGlobalName uniq mod occ VanillaDefn provenance
 111
 112         new_cache  = addToFM cache key new_name
 113     in
 114     setNameSupplyRn (us', inst_ns, new_cache)           `thenRn_`
 115     returnRn new_name
 116
 117 -- newSysName is used to create the names for
 118 --      a) default methods
 119 -- These are never mentioned explicitly in source code (hence no point in looking
 120 -- them up in the NameEnv), but when reading an interface file
 121 -- we may want to slurp in their pragma info.  In the source file itself we
 122 -- need to create these names too so that we export them into the inferface file for this module.
 123
 124 newSysName :: OccName -> ExportFlag -> SrcLoc -> RnMS s Name
 125 newSysName occ export_flag loc
 126   = getModeRn   `thenRn` \ mode ->
 127     getModuleRn `thenRn` \ mod_name ->
 128     case mode of
 129         SourceMode -> newLocallyDefinedGlobalName
 130                                 mod_name occ
 131                                 (\_ -> export_flag)
 132                                 loc
 133         InterfaceMode -> newGlobalName mod_name occ
 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     newGlobalName mod_name (rdrNameOcc n)
 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 :: (PprStyle -> Doc)                -- 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     getNameEnv                  `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     setNameEnv 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 :: (PprStyle -> Doc)
 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 `cmp` n2) rdr_names_w_loc
 237 \end{code}
 238
 239
 240 %*********************************************************
 241 %*                                                      *
 242 \subsection{Looking up names}
 243 %*                                                      *
 244 %*********************************************************
 245
 246 Looking up a name in the RnEnv.
 247
 248 \begin{code}
 249 lookupRn :: NameEnv -> RdrName -> RnMS s Name
 250 lookupRn name_env rdr_name
 251   = case lookupFM name_env rdr_name of
 252
 253         -- Found it!
 254         Just name -> returnRn name
 255
 256         -- Not found
 257         Nothing -> getModeRn    `thenRn` \ mode ->
 258                    case mode of
 259                         -- Not found when processing source code; so fail
 260                         SourceMode    -> failWithRn (mkUnboundName rdr_name)
 261                                                     (unknownNameErr rdr_name)
 262
 263                         -- Not found when processing an imported declaration,
 264                         -- so we create a new name for the purpose
 265                         InterfaceMode ->
 266                             case rdr_name of
 267
 268                                 Qual mod_name occ -> newGlobalName mod_name occ
 269
 270                                 -- An Unqual is allowed; interface files contain
 271                                 -- unqualified names for locally-defined things, such as
 272                                 -- constructors of a data type.
 273                                 Unqual occ -> getModuleRn       `thenRn ` \ mod_name ->
 274                                               newGlobalName mod_name occ
 275
 276
 277 lookupBndrRn rdr_name
 278   = getNameEnv                  `thenRn` \ name_env ->
 279     lookupRn name_env rdr_name
 280
 281 -- Just like lookupRn except that we record the occurrence too
 282 -- Perhaps surprisingly, even wired-in names are recorded.
 283 -- Why?  So that we know which wired-in names are referred to when
 284 -- deciding which instance declarations to import.
 285 lookupOccRn :: RdrName -> RnMS s Name
 286 lookupOccRn rdr_name
 287   = getNameEnv                  `thenRn` \ name_env ->
 288     lookupRn name_env rdr_name  `thenRn` \ name ->
 289     addOccurrenceName Compulsory name
 290
 291 -- lookupGlobalOccRn is like lookupOccRn, except that it looks in the global
 292 -- environment.  It's used for record field names only.
 293 lookupGlobalOccRn :: RdrName -> RnMS s Name
 294 lookupGlobalOccRn rdr_name
 295   = getGlobalNameEnv            `thenRn` \ name_env ->
 296     lookupRn name_env rdr_name  `thenRn` \ name ->
 297     addOccurrenceName Compulsory name
 298
 299 -- lookupOptionalOccRn is similar, but it's used in places where
 300 -- we don't *have* to find a definition for the thing.
 301 lookupOptionalOccRn :: RdrName -> RnMS s Name
 302 lookupOptionalOccRn rdr_name
 303   = getNameEnv                  `thenRn` \ name_env ->
 304     lookupRn name_env rdr_name  `thenRn` \ name ->
 305     addOccurrenceName Optional name
 306
 307
 308
 309 -- lookupImplicitOccRn takes an RdrName representing an *original* name, and
 310 -- adds it to the occurrence pool so that it'll be loaded later.  This is
 311 -- used when language constructs (such as monad comprehensions, overloaded literals,
 312 -- or deriving clauses) require some stuff to be loaded that isn't explicitly
 313 -- mentioned in the code.
 314 --
 315 -- This doesn't apply in interface mode, where everything is explicit, but
 316 -- we don't check for this case: it does no harm to record an "extra" occurrence
 317 -- and lookupImplicitOccRn isn't used much in interface mode (it's only the
 318 -- Nothing clause of rnDerivs that calls it at all I think).
 319 --
 320 -- For List and Tuple types it's important to get the correct
 321 -- isLocallyDefined flag, which is used in turn when deciding
 322 -- whether there are any instance decls in this module are "special".
 323 -- The name cache should have the correct provenance, though.
 324
 325 lookupImplicitOccRn :: RdrName -> RnMS s Name
 326 lookupImplicitOccRn (Qual mod occ)
 327  = newGlobalName mod occ                `thenRn` \ name ->
 328    addOccurrenceName Compulsory name
 329
 330 addImplicitOccRn :: Name -> RnM s d Name
 331 addImplicitOccRn name = addOccurrenceName Compulsory name
 332
 333 addImplicitOccsRn :: [Name] -> RnM s d ()
 334 addImplicitOccsRn names = addOccurrenceNames Compulsory names
 335
 336 listType_RDR    = qual (modAndOcc listType_name)
 337 tupleType_RDR n = qual (modAndOcc (tupleType_name n))
 338
 339 charType_name    = getName charTyCon
 340 listType_name    = getName listTyCon
 341 tupleType_name n = getName (tupleTyCon n)
 342 \end{code}
 343
 344 \begin{code}
 345 lookupFixity :: RdrName -> RnMS s Fixity
 346 lookupFixity rdr_name
 347   = getFixityEnv        `thenRn` \ fixity_env ->
 348     returnRn (lookupFixityEnv fixity_env rdr_name)
 349 \end{code}
 350
 351
 352
 353 %************************************************************************
 354 %*                                                                      *
 355 \subsection{Envt utility functions}
 356 %*                                                                      *
 357 %************************************************************************
 358
 359 ===============  RnEnv  ================
 360 \begin{code}
 361 plusRnEnv (RnEnv n1 f1) (RnEnv n2 f2)
 362   = plusNameEnvRn n1 n2         `thenRn` \ n ->
 363     plusFixityEnvRn f1 f2       `thenRn` \ f ->
 364     returnRn (RnEnv n f)
 365 \end{code}
 366
 367 ===============  NameEnv  ================
 368 \begin{code}
 369 plusNameEnvRn :: NameEnv -> NameEnv -> RnM s d NameEnv
 370 plusNameEnvRn n1 n2
 371   = mapRn (addErrRn.nameClashErr) (conflictsFM (/=) n1 n2)              `thenRn_`
 372     returnRn (n1 `plusFM` n2)
 373
 374 addOneToNameEnv :: NameEnv -> RdrName -> Name -> NameEnv
 375 addOneToNameEnv env rdr_name name = addToFM env rdr_name name
 376
 377 lookupNameEnv :: NameEnv -> RdrName -> Maybe Name
 378 lookupNameEnv = lookupFM
 379
 380 delOneFromNameEnv :: NameEnv -> RdrName -> NameEnv
 381 delOneFromNameEnv env rdr_name = delFromFM env rdr_name
 382 \end{code}
 383
 384 ===============  FixityEnv  ================
 385 \begin{code}
 386 plusFixityEnvRn f1 f2
 387   = mapRn (addErrRn.fixityClashErr) (conflictsFM bad_fix f1 f2)         `thenRn_`
 388     returnRn (f1 `plusFM` f2)
 389
 390 addOneToFixityEnv env rdr_name fixity = addToFM env rdr_name fixity
 391
 392 lookupFixityEnv env rdr_name
 393   = case lookupFM env rdr_name of
 394         Just (fixity,_) -> fixity
 395         Nothing         -> Fixity 9 InfixL              -- Default case
 396
 397 bad_fix :: (Fixity, Provenance) -> (Fixity, Provenance) -> Bool
 398 bad_fix (f1,_) (f2,_) = f1 /= f2
 399
 400 pprFixityProvenance :: PprStyle -> (Fixity,Provenance) -> Doc
 401 pprFixityProvenance sty (fixity, prov) = pprProvenance sty prov
 402 \end{code}
 403
 404
 405
 406 ===============  Avails  ================
 407 \begin{code}
 408 emptyModuleAvails :: ModuleAvails
 409 plusModuleAvails ::  ModuleAvails ->  ModuleAvails ->  ModuleAvails
 410 lookupModuleAvails :: ModuleAvails -> Module -> Maybe [AvailInfo]
 411
 412 emptyModuleAvails = emptyFM
 413 plusModuleAvails  = plusFM_C (++)
 414 lookupModuleAvails = lookupFM
 415 \end{code}
 416
 417
 418 ===============  AvailInfo  ================
 419 \begin{code}
 420 plusAvail (Avail n1)       (Avail n2)       = Avail n1
 421 plusAvail (AvailTC n1 ns1) (AvailTC n2 ns2) = AvailTC n1 (nub (ns1 ++ ns2))
 422 plusAvail a NotAvailable = a
 423 plusAvail NotAvailable a = a
 424 -- Added SOF 4/97
 425 #ifdef DEBUG
 426 plusAvail a1 a2 = panic ("RnEnv.plusAvail " ++ (show (hsep [pprAvail PprDebug a1,pprAvail PprDebug a2])))
 427 #endif
 428
 429 addAvailToNameSet :: NameSet -> AvailInfo -> NameSet
 430 addAvailToNameSet names avail = addListToNameSet names (availNames avail)
 431
 432 availsToNameSet :: [AvailInfo] -> NameSet
 433 availsToNameSet avails = foldl addAvailToNameSet emptyNameSet avails
 434
 435 availName :: AvailInfo -> Name
 436 availName (Avail n)     = n
 437 availName (AvailTC n _) = n
 438
 439 availNames :: AvailInfo -> [Name]
 440 availNames NotAvailable   = []
 441 availNames (Avail n)      = [n]
 442 availNames (AvailTC n ns) = ns
 443
 444 -- availEntityNames is used to extract the names that can appear on their own in
 445 -- an export or import list.  For class decls, class methods can appear on their
 446 -- own, thus    import A( op )
 447 -- but constructors cannot; thus
 448 --              import B( T )
 449 -- means import type T from B, not constructor T.
 450
 451 availEntityNames :: AvailInfo -> [Name]
 452 availEntityNames NotAvailable   = []
 453 availEntityNames (Avail n)      = [n]
 454 availEntityNames (AvailTC n ns) = n : filter (isVarOcc . nameOccName) ns
 455
 456 filterAvail :: RdrNameIE        -- Wanted
 457             -> AvailInfo        -- Available
 458             -> AvailInfo        -- Resulting available;
 459                                 -- NotAvailable if wanted stuff isn't there
 460
 461 filterAvail ie@(IEThingWith want wants) avail@(AvailTC n ns)
 462   | sub_names_ok = AvailTC n (filter is_wanted ns)
 463   | otherwise    = pprTrace "filterAvail" (hsep [ppr PprDebug ie, pprAvail PprDebug avail]) $
 464                    NotAvailable
 465   where
 466     is_wanted name = nameOccName name `elem` wanted_occs
 467     sub_names_ok   = all (`elem` avail_occs) wanted_occs
 468     avail_occs     = map nameOccName ns
 469     wanted_occs    = map rdrNameOcc (want:wants)
 470
 471 filterAvail (IEThingAbs _) (AvailTC n ns)
 472   | n `elem` ns = AvailTC n [n]
 473
 474 filterAvail (IEThingAbs _) avail@(Avail n)      = avail         -- Type synonyms
 475
 476 filterAvail (IEVar _)      avail@(Avail n)      = avail
 477 filterAvail (IEVar v)      avail@(AvailTC n ns) = AvailTC n (filter wanted ns)
 478                                                 where
 479                                                   wanted n = nameOccName n == occ
 480                                                   occ      = rdrNameOcc v
 481         -- The second equation happens if we import a class op, thus
 482         --      import A( op )
 483         -- where op is a class operation
 484
 485 filterAvail (IEThingAll _) avail@(AvailTC _ _)  = avail
 486
 487 filterAvail ie avail = NotAvailable
 488
 489 {-      OLD     to be deleted
 490 hideAvail :: RdrNameIE          -- Hide this
 491           -> AvailInfo          -- Available
 492           -> AvailInfo          -- Resulting available;
 493 -- Don't complain about hiding non-existent things; that's done elsewhere
 494
 495 hideAvail ie NotAvailable
 496   = NotAvailable
 497
 498 hideAvail ie (Avail n)
 499   | not (ieOcc ie == nameOccName n) = Avail n           -- No match
 500   | otherwise                       = NotAvailable      -- Names match
 501
 502 hideAvail ie (AvailTC n ns)
 503   | not (ieOcc ie == nameOccName n)             -- No match
 504   = case ie of                                  -- But in case we are faced with ...hiding( (+) )
 505                                                 -- we filter the "ns" anyhow
 506         IEVar op -> AvailTC n (filter keep ns)
 507                  where
 508                     op_occ = rdrNameOcc op
 509                     keep n = nameOccName n /= op_occ
 510
 511         other    -> AvailTC n ns
 512
 513   | otherwise                                   -- Names match
 514   = case ie of
 515         IEThingAbs _           -> AvailTC n (filter (/= n) ns)
 516         IEThingAll _           -> NotAvailable
 517         IEThingWith hide hides -> AvailTC n (filter keep ns)
 518                                where
 519                                   keep n    = nameOccName n `notElem` hide_occs
 520                                   hide_occs = map rdrNameOcc (hide : hides)
 521 -}
 522
 523 -- In interfaces, pprAvail gets given the OccName of the "host" thing
 524 pprAvail PprInterface avail = ppr_avail (pprOccName PprInterface . nameOccName) avail
 525 pprAvail sty          avail = ppr_avail (ppr sty) avail
 526
 527 ppr_avail pp_name NotAvailable = ptext SLIT("NotAvailable")
 528 ppr_avail pp_name (AvailTC n ns) = hsep [
 529                                      pp_name n,
 530                                      parens  $ hsep $ punctuate comma $
 531                                      map pp_name ns
 532                                    ]
 533 ppr_avail pp_name (Avail n) = pp_name n
 534 \end{code}
 535
 536
 537
 538
 539 %************************************************************************
 540 %*                                                                      *
 541 \subsection{Finite map utilities}
 542 %*                                                                      *
 543 %************************************************************************
 544
 545
 546 Generally useful function on finite maps to check for overlap.
 547
 548 \begin{code}
 549 conflictsFM :: Ord a
 550             => (b->b->Bool)             -- False <=> no conflict; you can pick either
 551             -> FiniteMap a b -> FiniteMap a b
 552             -> [(a,(b,b))]
 553 conflictsFM bad fm1 fm2
 554   = filter (\(a,(b1,b2)) -> bad b1 b2)
 555            (fmToList (intersectFM_C (\b1 b2 -> (b1,b2)) fm1 fm2))
 556
 557 conflictFM :: Ord a
 558            => (b->b->Bool)
 559            -> FiniteMap a b -> a -> b
 560            -> [(a,(b,b))]
 561 conflictFM bad fm key elt
 562   = case lookupFM fm key of
 563         Just elt' | bad elt elt' -> [(key,(elt,elt'))]
 564         other                    -> []
 565 \end{code}
 566
 567
 568 %************************************************************************
 569 %*                                                                      *
 570 \subsection{Envt utility functions}
 571 %*                                                                      *
 572 %************************************************************************
 573
 574
 575 \begin{code}
 576 nameClashErr (rdr_name, (name1,name2)) sty
 577   = hang (hsep [ptext SLIT("Conflicting definitions for: "), ppr sty rdr_name])
 578         4 (vcat [pprNameProvenance sty name1,
 579                      pprNameProvenance sty name2])
 580
 581 fixityClashErr (rdr_name, (fp1,fp2)) sty
 582   = hang (hsep [ptext SLIT("Conflicting fixities for: "), ppr sty rdr_name])
 583         4 (vcat [pprFixityProvenance sty fp1,
 584                      pprFixityProvenance sty fp2])
 585
 586 shadowedNameWarn shadow sty
 587   = hcat [ptext SLIT("This binding for"),
 588                ppr sty shadow,
 589                ptext SLIT("shadows an existing binding")]
 590
 591 unknownNameErr name sty
 592   = sep [text flavour, ptext SLIT("not in scope:"), ppr sty name]
 593   where
 594     flavour = occNameFlavour (rdrNameOcc name)
 595
 596 qualNameErr descriptor (name,loc)
 597   = pushSrcLocRn loc $
 598     addErrRn (\sty -> hsep [ ptext SLIT("invalid use of qualified name"),
 599                              ppr sty name,
 600                              ptext SLIT("in"),
 601                              descriptor sty])
 602
 603 dupNamesErr descriptor ((name,loc) : dup_things)
 604   = pushSrcLocRn loc $
 605     addErrRn (\sty -> hsep [ptext SLIT("duplicate bindings of"),
 606                             ppr sty name,
 607                             ptext SLIT("in"), descriptor sty])
 608 \end{code}
 609