ghc/compiler/rename/RnNames.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
   3 %
   4 \section[RnNames]{Extracting imported and top-level names in scope}
   5
   6 \begin{code}
   7 #include "HsVersions.h"
   8
   9 module RnNames (
  10         getGlobalNames
  11     ) where
  12
  13 IMP_Ubiq()
  14
  15 import CmdLineOpts      ( opt_SourceUnchanged, opt_NoImplicitPrelude )
  16 import HsSyn    ( HsModule(..), HsDecl(..), FixityDecl(..), Fixity, Fake, InPat, IE(..), HsTyVar,
  17                   TyDecl, ClassDecl, InstDecl, DefaultDecl, ImportDecl(..), HsBinds, IfaceSig
  18                 )
  19 import HsBinds  ( collectTopBinders )
  20 import HsImpExp ( ieName )
  21 import RdrHsSyn ( RdrNameHsDecl(..), RdrName(..), RdrNameIE(..), SYN_IE(RdrNameImportDecl),
  22                   SYN_IE(RdrNameHsModule), SYN_IE(RdrNameFixityDecl),
  23                   rdrNameOcc, ieOcc
  24                 )
  25 import RnHsSyn  ( RenamedHsModule(..), RenamedFixityDecl(..) )
  26 import RnIfaces ( getInterfaceExports, getDeclBinders, checkUpToDate, recordSlurp )
  27 import RnEnv
  28 import RnMonad
  29 import FiniteMap
  30 import PrelMods
  31 import UniqFM   ( UniqFM, emptyUFM, addListToUFM_C, lookupUFM )
  32 import Bag      ( Bag, bagToList )
  33 import Maybes   ( maybeToBool, expectJust )
  34 import Name
  35 import Pretty
  36 import PprStyle ( PprStyle(..) )
  37 import Util     ( panic, pprTrace, assertPanic )
  38 #if __GLASGOW_HASKELL__ >= 202
  39 import Outputable
  40 #endif
  41 \end{code}
  42
  43
  44
  45 %************************************************************************
  46 %*                                                                      *
  47 \subsection{Get global names}
  48 %*                                                                      *
  49 %************************************************************************
  50
  51 \begin{code}
  52 getGlobalNames :: RdrNameHsModule
  53                -> RnMG (Maybe (ExportEnv, RnEnv, NameSet))
  54                         -- Nothing <=> no need to recompile
  55                         -- The NameSet is the set of names that are
  56                         --      either locally defined,
  57                         --      or explicitly imported
  58
  59 getGlobalNames m@(HsModule this_mod _ exports imports _ _ mod_loc)
  60   = fixRn (\ ~(rec_exp_fn, _) ->
  61
  62         -- PROCESS LOCAL DECLS
  63         -- Do these *first* so that the correct provenance gets
  64         -- into the global name cache.
  65       importsFromLocalDecls rec_exp_fn m        `thenRn` \ (local_rn_env, local_mod_avails, local_avails) ->
  66
  67         -- PROCESS IMPORT DECLS
  68       mapAndUnzip3Rn importsFromImportDecl all_imports
  69                                                 `thenRn` \ (imp_rn_envs, imp_avails_s, explicit_imports_s) ->
  70
  71         -- CHECK FOR EARLY EXIT
  72       checkEarlyExit this_mod                   `thenRn` \ early_exit ->
  73       if early_exit then
  74                 returnRn (junk_exp_fn, Nothing)
  75       else
  76
  77         -- COMBINE RESULTS
  78         -- We put the local env first, so that a local provenance
  79         -- "wins", even if a module imports itself.
  80       foldlRn plusRnEnv emptyRnEnv imp_rn_envs          `thenRn` \ imp_rn_env ->
  81       plusRnEnv local_rn_env imp_rn_env                 `thenRn` \ rn_env ->
  82       let
  83          all_avails :: ModuleAvails
  84          all_avails = foldr plusModuleAvails local_mod_avails imp_avails_s
  85
  86          explicit_names :: NameSet      -- locally defined or explicitly imported
  87          explicit_names = foldr add_on emptyNameSet (local_avails : explicit_imports_s)
  88          add_on avails names = foldr (unionNameSets . mkNameSet . availNames) names avails
  89       in
  90
  91         -- PROCESS EXPORT LISTS
  92       exportsFromAvail this_mod exports all_avails rn_env
  93                                                         `thenRn` \ (export_fn, export_env) ->
  94
  95         -- RECORD THAT LOCALLY DEFINED THINGS ARE AVAILABLE
  96       mapRn (recordSlurp Nothing) local_avails          `thenRn_`
  97
  98       returnRn (export_fn, Just (export_env, rn_env, explicit_names))
  99     )                                                   `thenRn` \ (_, result) ->
 100     returnRn result
 101   where
 102     junk_exp_fn = error "RnNames:export_fn"
 103
 104     all_imports = prel_imports ++ imports
 105
 106         -- NB: opt_NoImplicitPrelude is slightly different to import Prelude ();
 107         -- because the former doesn't even look at Prelude.hi for instance declarations,
 108         -- whereas the latter does.
 109     prel_imports | this_mod == pRELUDE ||
 110                    explicit_prelude_import ||
 111                    opt_NoImplicitPrelude
 112                  = []
 113
 114                  | otherwise               = [ImportDecl pRELUDE
 115                                                          False          {- Not qualified -}
 116                                                          Nothing        {- No "as" -}
 117                                                          Nothing        {- No import list -}
 118                                                          mod_loc]
 119
 120     explicit_prelude_import
 121       = not (null [ () | (ImportDecl mod qual _ _ _) <- imports, mod == pRELUDE ])
 122 \end{code}
 123
 124 \begin{code}
 125 checkEarlyExit mod
 126   = checkErrsRn                         `thenRn` \ no_errs_so_far ->
 127     if not no_errs_so_far then
 128         -- Found errors already, so exit now
 129         returnRn True
 130     else
 131     if not opt_SourceUnchanged then
 132         -- Source code changed and no errors yet... carry on
 133         returnRn False
 134     else
 135         -- Unchanged source, and no errors yet; see if usage info
 136         -- up to date, and exit if so
 137         checkUpToDate mod                       `thenRn` \ up_to_date ->
 138         returnRn up_to_date
 139 \end{code}
 140
 141
 142 \begin{code}
 143 importsFromImportDecl :: RdrNameImportDecl
 144                       -> RnMG (RnEnv, ModuleAvails, [AvailInfo])
 145
 146 importsFromImportDecl (ImportDecl mod qual_only as_mod import_spec loc)
 147   = pushSrcLocRn loc $
 148     getInterfaceExports mod                     `thenRn` \ (avails, fixities) ->
 149     filterImports mod import_spec avails        `thenRn` \ (filtered_avails, hides, explicits) ->
 150     let
 151         filtered_avails' = map set_avail_prov filtered_avails
 152         fixities'        = [ (occ,(fixity,provenance)) | (occ,fixity) <- fixities ]
 153     in
 154     qualifyImports mod
 155                    True                 -- Want qualified names
 156                    (not qual_only)      -- Maybe want unqualified names
 157                    as_mod
 158                    (ExportEnv filtered_avails' fixities')
 159                    hides
 160                                                         `thenRn` \ (rn_env, mod_avails) ->
 161     returnRn (rn_env, mod_avails, explicits)
 162   where
 163     set_avail_prov NotAvailable   = NotAvailable
 164     set_avail_prov (Avail n)      = Avail (set_name_prov n)
 165     set_avail_prov (AvailTC n ns) = AvailTC (set_name_prov n) (map set_name_prov ns)
 166     set_name_prov name = setNameProvenance name provenance
 167     provenance = Imported mod loc
 168 \end{code}
 169
 170
 171 \begin{code}
 172 importsFromLocalDecls rec_exp_fn (HsModule mod _ _ _ fix_decls decls _)
 173   = foldlRn getLocalDeclBinders [] decls                `thenRn` \ avails ->
 174     mapRn fixityFromFixDecl fix_decls                   `thenRn` \ fixities ->
 175     qualifyImports mod
 176                    False        -- Don't want qualified names
 177                    True         -- Want unqualified names
 178                    Nothing      -- No "as M" part
 179                    (ExportEnv avails fixities)
 180                    []           -- Hide nothing
 181                                                         `thenRn` \ (rn_env, mod_avails) ->
 182     returnRn (rn_env, mod_avails, avails)
 183   where
 184     newLocalName rdr_name loc
 185       = newLocallyDefinedGlobalName mod (rdrNameOcc rdr_name) rec_exp_fn loc
 186
 187     getLocalDeclBinders avails (ValD binds)
 188       = mapRn do_one (bagToList (collectTopBinders binds))      `thenRn` \ val_avails ->
 189         returnRn (val_avails ++ avails)
 190
 191     getLocalDeclBinders avails decl
 192       = getDeclBinders newLocalName decl        `thenRn` \ avail ->
 193         case avail of
 194            NotAvailable -> returnRn avails              -- Instance decls and suchlike
 195            other        -> returnRn (avail : avails)
 196
 197     do_one (rdr_name, loc)
 198       = newLocalName rdr_name loc       `thenRn` \ name ->
 199         returnRn (Avail name)
 200 \end{code}
 201
 202 %************************************************************************
 203 %*                                                                      *
 204 \subsection{Filtering imports}
 205 %*                                                                      *
 206 %************************************************************************
 207
 208 @filterImports@ takes the @ExportEnv@ telling what the imported module makes
 209 available, and filters it through the import spec (if any).
 210
 211 \begin{code}
 212 filterImports :: Module
 213               -> Maybe (Bool, [RdrNameIE])              -- Import spec; True => hidin
 214               -> [AvailInfo]                            -- What's available
 215               -> RnMG ([AvailInfo],                     -- What's actually imported
 216                        [AvailInfo],                     -- What's to be hidden (the unqualified version, that is)
 217                        [AvailInfo])                     -- What was imported explicitly
 218
 219         -- Complains if import spec mentions things that the module doesn't export
 220
 221 filterImports mod Nothing imports
 222   = returnRn (imports, [], [])
 223
 224 filterImports mod (Just (want_hiding, import_items)) avails
 225   = mapRn check_item import_items               `thenRn` \ item_avails ->
 226     if want_hiding
 227     then
 228         returnRn (avails, item_avails, [])      -- All imported; item_avails to be hidden
 229     else
 230         returnRn (item_avails, [], item_avails) -- Just item_avails imported; nothing to be hidden
 231
 232   where
 233     import_fm :: FiniteMap OccName AvailInfo
 234     import_fm = listToFM [ (nameOccName name, avail)
 235                          | avail <- avails,
 236                            name  <- availEntityNames avail]
 237
 238     check_item item@(IEModuleContents _)
 239       = addErrRn (badImportItemErr mod item)    `thenRn_`
 240         returnRn NotAvailable
 241
 242     check_item item
 243       | not (maybeToBool maybe_in_import_avails) ||
 244         (case filtered_avail of { NotAvailable -> True; other -> False })
 245       = addErrRn (badImportItemErr mod item)    `thenRn_`
 246         returnRn NotAvailable
 247
 248       | otherwise   = returnRn filtered_avail
 249
 250       where
 251         maybe_in_import_avails = lookupFM import_fm (ieOcc item)
 252         Just avail             = maybe_in_import_avails
 253         filtered_avail         = filterAvail item avail
 254 \end{code}
 255
 256
 257
 258 %************************************************************************
 259 %*                                                                      *
 260 \subsection{Qualifiying imports}
 261 %*                                                                      *
 262 %************************************************************************
 263
 264 @qualifyImports@ takes the @ExportEnv@ after filtering through the import spec
 265 of an import decl, and deals with producing an @RnEnv@ with the
 266 right qaulified names.  It also turns the @Names@ in the @ExportEnv@ into
 267 fully fledged @Names@.
 268
 269 \begin{code}
 270 qualifyImports :: Module                                -- Imported module
 271                -> Bool                                  -- True <=> want qualified import
 272                -> Bool                                  -- True <=> want unqualified import
 273                -> Maybe Module                          -- Optional "as M" part
 274                -> ExportEnv                             -- What's imported
 275                -> [AvailInfo]                           -- What's to be hidden
 276                -> RnMG (RnEnv, ModuleAvails)
 277
 278 qualifyImports this_mod qual_imp unqual_imp as_mod (ExportEnv avails fixities) hides
 279   = let
 280         -- Make the name environment.  Since we're talking about a single import module
 281         -- there can't be name clashes, so we don't need to be in the monad
 282         name_env1 = foldl add_avail emptyNameEnv avails
 283
 284         -- Delete things that are hidden
 285         name_env2 = foldl del_avail name_env1 hides
 286
 287         -- Create the fixity env
 288         fixity_env = foldl (add_fixity name_env2) emptyFixityEnv fixities
 289
 290         -- The "module M" syntax only applies to *unqualified* imports (1.4 Report, Section 5.1.1)
 291         mod_avail_env | unqual_imp = unitFM qual_mod avails
 292                       | otherwise  = emptyFM
 293     in
 294     returnRn (RnEnv name_env2 fixity_env, mod_avail_env)
 295   where
 296     qual_mod = case as_mod of
 297                   Nothing           -> this_mod
 298                   Just another_name -> another_name
 299
 300     add_avail env avail = foldl add_name env (availNames avail)
 301     add_name env name   = env2
 302                         where
 303                           env1 | qual_imp   = addOneToNameEnv env  (Qual qual_mod occ) name
 304                                | otherwise  = env
 305                           env2 | unqual_imp = addOneToNameEnv env1 (Unqual occ)        name
 306                                | otherwise  = env1
 307                           occ  = nameOccName name
 308
 309     del_avail env avail = foldl delOneFromNameEnv env rdr_names
 310                         where
 311                           rdr_names = map (Unqual . nameOccName) (availNames avail)
 312
 313     add_fixity name_env fix_env (occ_name, (fixity, provenance))
 314         = add qual $ add unqual $ fix_env
 315         where
 316           qual   = Qual qual_mod occ_name
 317           unqual = Unqual occ_name
 318
 319           add rdr_name fix_env | maybeToBool (lookupFM name_env rdr_name)
 320                                = addOneToFixityEnv fix_env rdr_name (fixity,provenance)
 321                                | otherwise
 322                                = fix_env
 323 \end{code}
 324
 325 unQualify adds an Unqual binding for every existing Qual binding.
 326
 327 \begin{code}
 328 unQualify :: FiniteMap RdrName elt -> FiniteMap RdrName elt
 329 unQualify fm = addListToFM fm [(Unqual occ, elt) | (Qual _ occ, elt) <- fmToList fm]
 330 \end{code}
 331
 332 %************************************************************************
 333 %*                                                                      *
 334 \subsection{Local declarations}
 335 %*                                                                      *
 336 %************************************************************************
 337
 338
 339 \begin{code}
 340 fixityFromFixDecl :: RdrNameFixityDecl -> RnMG (OccName, (Fixity, Provenance))
 341
 342 fixityFromFixDecl (FixityDecl rdr_name fixity loc)
 343   = returnRn (rdrNameOcc rdr_name, (fixity, LocalDef (panic "export-flag") loc))
 344 \end{code}
 345
 346
 347 %************************************************************************
 348 %*                                                                      *
 349 \subsection{Export list processing
 350 %*                                                                      *
 351 %************************************************************************
 352
 353 The @AvailEnv@ type is just used internally in @exportsFromAvail@.
 354 When exporting we need to combine the availabilities for a particular
 355 exported thing, and we also need to check for name clashes -- that
 356 is: two exported things must have different @OccNames@.
 357
 358 \begin{code}
 359 type AvailEnv = FiniteMap OccName (RdrNameIE, AvailInfo)
 360         -- The FM maps each OccName to the RdrNameIE that gave rise to it,
 361         -- for error reporting, as well as to its AvailInfo
 362
 363 emptyAvailEnv = emptyFM
 364
 365 unitAvailEnv :: RdrNameIE -> AvailInfo -> AvailEnv
 366 unitAvailEnv ie NotAvailable   = emptyFM
 367 unitAvailEnv ie (AvailTC _ []) = emptyFM
 368 unitAvailEnv ie avail          = unitFM (nameOccName (availName avail)) (ie,avail)
 369
 370 plusAvailEnv a1 a2
 371   = mapRn (addErrRn.availClashErr) (conflictsFM bad_avail a1 a2)        `thenRn_`
 372     returnRn (plusFM_C plus_avail a1 a2)
 373
 374 listToAvailEnv :: RdrNameIE -> [AvailInfo] -> RnM s d AvailEnv
 375 listToAvailEnv ie items
 376   = foldlRn plusAvailEnv emptyAvailEnv (map (unitAvailEnv ie) items)
 377
 378 bad_avail  (ie1,avail1) (ie2,avail2) = availName avail1 /= availName avail2     -- Same OccName, different Name
 379 plus_avail (ie1,a1) (ie2,a2) = (ie1, a1 `plusAvail` a2)
 380 \end{code}
 381
 382 Processing the export list.
 383
 384 You might think that we should record things that appear in the export list as
 385 ``occurrences'' (using addOccurrenceName), but you'd be wrong.  We do check (here)
 386 that they are in scope, but there is no need to slurp in their actual declaration
 387 (which is what addOccurrenceName forces).  Indeed, doing so would big trouble when
 388 compiling PrelBase, because it re-exports GHC, which includes takeMVar#, whose type
 389 includes ConcBase.StateAndSynchVar#, and so on...
 390
 391 \begin{code}
 392 exportsFromAvail :: Module
 393                  -> Maybe [RdrNameIE]   -- Export spec
 394                  -> ModuleAvails
 395                  -> RnEnv
 396                  -> RnMG (Name -> ExportFlag, ExportEnv)
 397         -- Complains if two distinct exports have same OccName
 398         -- Complains about exports items not in scope
 399 exportsFromAvail this_mod Nothing all_avails rn_env
 400   = exportsFromAvail this_mod (Just [IEModuleContents this_mod]) all_avails rn_env
 401
 402 exportsFromAvail this_mod (Just export_items) all_avails (RnEnv name_env fixity_env)
 403   = mapRn exports_from_item export_items                `thenRn` \ avail_envs ->
 404     foldlRn plusAvailEnv emptyAvailEnv avail_envs       `thenRn` \ export_avail_env ->
 405     let
 406         export_avails   = map snd (eltsFM export_avail_env)
 407         export_fixities = mk_exported_fixities (availsToNameSet export_avails)
 408         export_fn       = mk_export_fn export_avails
 409     in
 410     returnRn (export_fn, ExportEnv export_avails export_fixities)
 411
 412   where
 413     full_avail_env :: UniqFM AvailInfo
 414     full_avail_env = addListToUFM_C plusAvail emptyUFM
 415                            [(name, avail) | avail <- concat (eltsFM all_avails),
 416                                             name  <- availEntityNames avail
 417                            ]
 418
 419         -- NB: full_avail_env will contain bindings for class ops but not constructors
 420         -- (see defn of availEntityNames)
 421
 422     exports_from_item :: RdrNameIE -> RnMG AvailEnv
 423     exports_from_item ie@(IEModuleContents mod)
 424         = case lookupFM all_avails mod of
 425                 Nothing     -> failWithRn emptyAvailEnv (modExportErr mod)
 426                 Just avails -> listToAvailEnv ie avails
 427
 428     exports_from_item ie
 429         | not (maybeToBool maybe_in_scope)
 430         = failWithRn emptyAvailEnv (unknownNameErr (ieName ie))
 431
 432 #ifdef DEBUG
 433         -- I can't see why this should ever happen; if the thing is in scope
 434         -- at all it ought to have some availability
 435         | not (maybeToBool maybe_avail)
 436         = pprTrace "exportsFromAvail: curious Nothing:" (ppr PprDebug name)
 437           returnRn emptyAvailEnv
 438 #endif
 439
 440         | not enough_avail
 441         = failWithRn emptyAvailEnv (exportItemErr ie export_avail)
 442
 443         | otherwise     -- Phew!  It's OK!
 444         = returnRn (unitAvailEnv ie export_avail)
 445        where
 446           maybe_in_scope  = lookupNameEnv name_env (ieName ie)
 447           Just name       = maybe_in_scope
 448           maybe_avail     = lookupUFM full_avail_env name
 449           Just avail      = maybe_avail
 450           export_avail    = filterAvail ie avail
 451           enough_avail    = case export_avail of {NotAvailable -> False; other -> True}
 452
 453         -- We export a fixity iff we export a thing with the same (qualified) RdrName
 454     mk_exported_fixities :: NameSet -> [(OccName, (Fixity, Provenance))]
 455     mk_exported_fixities exports
 456         = fmToList (foldr (perhaps_add_fixity exports)
 457                           emptyFM
 458                           (fmToList fixity_env))
 459
 460     perhaps_add_fixity :: NameSet -> (RdrName, (Fixity, Provenance))
 461                        -> FiniteMap OccName (Fixity,Provenance)
 462                        -> FiniteMap OccName (Fixity,Provenance)
 463     perhaps_add_fixity exports (rdr_name, (fixity, prov)) fix_env
 464       =  let
 465             do_nothing = fix_env                -- The default is to pass on the env unchanged
 466          in
 467                 -- Step 1: check whether the rdr_name is in scope; if so find its Name
 468          case lookupFM name_env rdr_name of {
 469            Nothing          -> do_nothing;
 470            Just fixity_name ->
 471
 472                 -- Step 2: check whether the fixity thing is exported
 473          if not (fixity_name `elemNameSet` exports) then
 474                 do_nothing
 475          else
 476
 477                 -- Step 3: check whether we already have a fixity for the
 478                 -- Name's OccName in the fix_env we are building up.  This can easily
 479                 -- happen.  the original fixity_env might contain bindings for
 480                 --      M.a and N.a, if a was imported via M and N.
 481                 -- If this does happen, we expect the fixity to be the same either way.
 482         let
 483             occ_name = rdrNameOcc rdr_name
 484         in
 485         case lookupFM fix_env occ_name of {
 486           Just (fixity1, prov1) ->      -- Got it already
 487                                    ASSERT( fixity == fixity1 )
 488                                    do_nothing;
 489           Nothing ->
 490
 491                 -- Step 3: add it to the outgoing fix_env
 492         addToFM fix_env occ_name (fixity,prov)
 493         }}
 494
 495 mk_export_fn :: [AvailInfo] -> (Name -> ExportFlag)
 496 mk_export_fn avails
 497   = \name -> if name `elemNameSet` exported_names
 498              then Exported
 499              else NotExported
 500   where
 501     exported_names :: NameSet
 502     exported_names = availsToNameSet avails
 503 \end{code}
 504
 505
 506 %************************************************************************
 507 %*                                                                      *
 508 \subsection{Errors}
 509 %*                                                                      *
 510 %************************************************************************
 511
 512 \begin{code}
 513 badImportItemErr mod ie sty
 514   = sep [ptext SLIT("Module"), pprModule sty mod, ptext SLIT("does not export"), ppr sty ie]
 515
 516 modExportErr mod sty
 517   = hsep [ ptext SLIT("Unknown module in export list: module"), ptext mod]
 518
 519 exportItemErr export_item NotAvailable sty
 520   = sep [ ptext SLIT("Export item not in scope:"), ppr sty export_item ]
 521
 522 exportItemErr export_item avail sty
 523   = hang (ptext SLIT("Export item not fully in scope:"))
 524            4 (vcat [hsep [ptext SLIT("Wanted:    "), ppr sty export_item],
 525                         hsep [ptext SLIT("Available: "), ppr sty (ieOcc export_item), pprAvail sty avail]])
 526
 527 availClashErr (occ_name, ((ie1,avail1), (ie2,avail2))) sty
 528   = hang (hsep [ptext SLIT("Conflicting exports for local name: "), ppr sty occ_name])
 529         4 (vcat [ppr sty ie1, ppr sty ie2])
 530 \end{code}
 531