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