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
 139     )                                                                   `thenRn` \ up_to_date ->
 140     traceRn (text "Hence, compilation" <+>
 141              text (if up_to_date then "IS NOT" else "IS") <+>
 142              text "required")                                           `thenRn_`
 143     returnRn up_to_date
 144 \end{code}
 145
 146
 147 \begin{code}
 148 importsFromImportDecl :: RdrNameImportDecl
 149                       -> RnMG (RnEnv, ExportAvails, [AvailInfo])
 150
 151 importsFromImportDecl (ImportDecl mod qual_only as_source as_mod import_spec loc)
 152   = pushSrcLocRn loc $
 153     getInterfaceExports mod as_source           `thenRn` \ (avails, fixities) ->
 154     filterImports mod import_spec avails        `thenRn` \ (filtered_avails, hides, explicits) ->
 155     let
 156         filtered_avails' = map set_avail_prov filtered_avails
 157         fixities'        = [ (occ,(fixity,provenance)) | (occ,fixity) <- fixities ]
 158     in
 159     qualifyImports mod
 160                    True                 -- Want qualified names
 161                    (not qual_only)      -- Maybe want unqualified names
 162                    as_mod
 163                    (ExportEnv filtered_avails' fixities')
 164                    hides
 165                                                         `thenRn` \ (rn_env, mod_avails) ->
 166     returnRn (rn_env, mod_avails, explicits)
 167   where
 168     set_avail_prov NotAvailable   = NotAvailable
 169     set_avail_prov (Avail n)      = Avail (set_name_prov n)
 170     set_avail_prov (AvailTC n ns) = AvailTC (set_name_prov n) (map set_name_prov ns)
 171     set_name_prov name | isWiredInName name = name
 172                        | otherwise          = setNameProvenance name provenance
 173     provenance = Imported mod loc as_source
 174 \end{code}
 175
 176
 177 \begin{code}
 178 importsFromLocalDecls rec_exp_fn (HsModule mod _ _ _ fix_decls decls _)
 179   = foldlRn getLocalDeclBinders [] decls                `thenRn` \ avails ->
 180     mapRn fixityFromFixDecl fix_decls                   `thenRn` \ fixities ->
 181     qualifyImports mod
 182                    False        -- Don't want qualified names
 183                    True         -- Want unqualified names
 184                    Nothing      -- No "as M" part
 185                    (ExportEnv avails fixities)
 186                    []           -- Hide nothing
 187                                                         `thenRn` \ (rn_env, mod_avails) ->
 188     returnRn (rn_env, mod_avails, avails)
 189   where
 190     newLocalName rdr_name loc
 191       = newLocallyDefinedGlobalName mod (rdrNameOcc rdr_name) rec_exp_fn loc
 192
 193     getLocalDeclBinders avails (ValD binds)
 194       = mapRn do_one (bagToList (collectTopBinders binds))      `thenRn` \ val_avails ->
 195         returnRn (val_avails ++ avails)
 196
 197     getLocalDeclBinders avails decl
 198       = getDeclBinders newLocalName decl        `thenRn` \ avail ->
 199         case avail of
 200            NotAvailable -> returnRn avails              -- Instance decls and suchlike
 201            other        -> returnRn (avail : avails)
 202
 203     do_one (rdr_name, loc)
 204       = newLocalName rdr_name loc       `thenRn` \ name ->
 205         returnRn (Avail name)
 206 \end{code}
 207
 208 %************************************************************************
 209 %*                                                                      *
 210 \subsection{Filtering imports}
 211 %*                                                                      *
 212 %************************************************************************
 213
 214 @filterImports@ takes the @ExportEnv@ telling what the imported module makes
 215 available, and filters it through the import spec (if any).
 216
 217 \begin{code}
 218 filterImports :: Module
 219               -> Maybe (Bool, [RdrNameIE])              -- Import spec; True => hidin
 220               -> [AvailInfo]                            -- What's available
 221               -> RnMG ([AvailInfo],                     -- What's actually imported
 222                        [AvailInfo],                     -- What's to be hidden (the unqualified version, that is)
 223                        [AvailInfo])                     -- What was imported explicitly
 224
 225         -- Complains if import spec mentions things that the module doesn't export
 226
 227 filterImports mod Nothing imports
 228   = returnRn (imports, [], [])
 229
 230 filterImports mod (Just (want_hiding, import_items)) avails
 231   = mapRn check_item import_items               `thenRn` \ item_avails ->
 232     if want_hiding
 233     then
 234         returnRn (avails, item_avails, [])      -- All imported; item_avails to be hidden
 235     else
 236         returnRn (item_avails, [], item_avails) -- Just item_avails imported; nothing to be hidden
 237
 238   where
 239     import_fm :: FiniteMap OccName AvailInfo
 240     import_fm = listToFM [ (nameOccName name, avail)
 241                          | avail <- avails,
 242                            name  <- availEntityNames avail]
 243
 244     check_item item@(IEModuleContents _)
 245       = addErrRn (badImportItemErr mod item)    `thenRn_`
 246         returnRn NotAvailable
 247
 248     check_item item
 249       | not (maybeToBool maybe_in_import_avails) ||
 250         (case filtered_avail of { NotAvailable -> True; other -> False })
 251       = addErrRn (badImportItemErr mod item)    `thenRn_`
 252         returnRn NotAvailable
 253
 254       | otherwise   = returnRn filtered_avail
 255
 256       where
 257         maybe_in_import_avails = lookupFM import_fm (ieOcc item)
 258         Just avail             = maybe_in_import_avails
 259         filtered_avail         = filterAvail item avail
 260 \end{code}
 261
 262
 263
 264 %************************************************************************
 265 %*                                                                      *
 266 \subsection{Qualifiying imports}
 267 %*                                                                      *
 268 %************************************************************************
 269
 270 @qualifyImports@ takes the @ExportEnv@ after filtering through the import spec
 271 of an import decl, and deals with producing an @RnEnv@ with the
 272 right qualified names.  It also turns the @Names@ in the @ExportEnv@ into
 273 fully fledged @Names@.
 274
 275 \begin{code}
 276 qualifyImports :: Module                                -- Imported module
 277                -> Bool                                  -- True <=> want qualified import
 278                -> Bool                                  -- True <=> want unqualified import
 279                -> Maybe Module                          -- Optional "as M" part
 280                -> ExportEnv                             -- What's imported
 281                -> [AvailInfo]                           -- What's to be hidden
 282                -> RnMG (RnEnv, ExportAvails)
 283
 284 qualifyImports this_mod qual_imp unqual_imp as_mod (ExportEnv avails fixities) hides
 285   =
 286         -- Make the name environment.  Even though we're talking about a
 287         -- single import module there might still be name clashes,
 288         -- because it might be the module being compiled.
 289     foldlRn add_avail emptyNameEnv avails       `thenRn` \ name_env1 ->
 290     let
 291         -- Delete things that are hidden
 292         name_env2 = foldl del_avail name_env1 hides
 293
 294         -- Create the fixity env
 295         fixity_env = foldl (add_fixity name_env2) emptyFixityEnv fixities
 296
 297         -- Create the export-availability info
 298         export_avails = mkExportAvails unqual_imp qual_mod avails
 299     in
 300     returnRn (RnEnv name_env2 fixity_env, export_avails)
 301   where
 302     qual_mod = case as_mod of
 303                   Nothing           -> this_mod
 304                   Just another_name -> another_name
 305
 306     add_avail env avail = foldlRn add_name env (availNames avail)
 307     add_name env name   = add qual_imp   env  (Qual qual_mod occ err_hif) `thenRn` \ env1 ->
 308                           add unqual_imp env1 (Unqual occ)
 309                         where
 310                           add False env rdr_name = returnRn env
 311                           add True  env rdr_name = addOneToNameEnv env rdr_name name
 312                           occ  = nameOccName name
 313
 314     del_avail env avail = foldl delOneFromNameEnv env rdr_names
 315                         where
 316                           rdr_names = map (Unqual . nameOccName) (availNames avail)
 317
 318     add_fixity name_env fix_env (occ_name, (fixity, provenance))
 319         = add qual $ add unqual $ fix_env
 320         where
 321           qual   = Qual qual_mod occ_name err_hif
 322           unqual = Unqual occ_name
 323
 324           add rdr_name fix_env | maybeToBool (lookupFM name_env rdr_name)
 325                                = addOneToFixityEnv fix_env rdr_name (fixity,provenance)
 326                                | otherwise
 327                                = fix_env
 328
 329 err_hif = error "qualifyImports: hif"   -- Not needed in key to mapping
 330 \end{code}
 331
 332 unQualify adds an Unqual binding for every existing Qual binding.
 333
 334 \begin{code}
 335 unQualify :: FiniteMap RdrName elt -> FiniteMap RdrName elt
 336 unQualify fm = addListToFM fm [(Unqual occ, elt) | (Qual _ occ _, elt) <- fmToList fm]
 337 \end{code}
 338
 339 %************************************************************************
 340 %*                                                                      *
 341 \subsection{Local declarations}
 342 %*                                                                      *
 343 %************************************************************************
 344
 345
 346 \begin{code}
 347 fixityFromFixDecl :: RdrNameFixityDecl -> RnMG (OccName, (Fixity, Provenance))
 348
 349 fixityFromFixDecl (FixityDecl rdr_name fixity loc)
 350   = returnRn (rdrNameOcc rdr_name, (fixity, LocalDef (panic "export-flag") loc))
 351 \end{code}
 352
 353
 354 %************************************************************************
 355 %*                                                                      *
 356 \subsection{Export list processing
 357 %*                                                                      *
 358 %************************************************************************
 359
 360 The @AvailEnv@ type is just used internally in @exportsFromAvail@.
 361 When exporting we need to combine the availabilities for a particular
 362 exported thing, and we also need to check for name clashes -- that
 363 is: two exported things must have different @OccNames@.
 364
 365 \begin{code}
 366 type AvailEnv = FiniteMap OccName (RdrNameIE, AvailInfo)
 367         -- The FM maps each OccName to the RdrNameIE that gave rise to it,
 368         -- for error reporting, as well as to its AvailInfo
 369
 370 emptyAvailEnv = emptyFM
 371
 372 unitAvailEnv :: RdrNameIE -> AvailInfo -> AvailEnv
 373 unitAvailEnv ie NotAvailable   = emptyFM
 374 unitAvailEnv ie (AvailTC _ []) = emptyFM
 375 unitAvailEnv ie avail          = unitFM (nameOccName (availName avail)) (ie,avail)
 376
 377 plusAvailEnv a1 a2
 378   = mapRn (addErrRn.availClashErr) (conflictsFM bad_avail a1 a2)        `thenRn_`
 379     returnRn (plusFM_C plus_avail a1 a2)
 380
 381 listToAvailEnv :: RdrNameIE -> [AvailInfo] -> RnM s d AvailEnv
 382 listToAvailEnv ie items
 383   = foldlRn plusAvailEnv emptyAvailEnv (map (unitAvailEnv ie) items)
 384
 385 bad_avail  (ie1,avail1) (ie2,avail2) = availName avail1 /= availName avail2     -- Same OccName, different Name
 386 plus_avail (ie1,a1) (ie2,a2) = (ie1, a1 `plusAvail` a2)
 387 \end{code}
 388
 389 Processing the export list.
 390
 391 You might think that we should record things that appear in the export list as
 392 ``occurrences'' (using addOccurrenceName), but you'd be wrong.  We do check (here)
 393 that they are in scope, but there is no need to slurp in their actual declaration
 394 (which is what addOccurrenceName forces).  Indeed, doing so would big trouble when
 395 compiling PrelBase, because it re-exports GHC, which includes takeMVar#, whose type
 396 includes ConcBase.StateAndSynchVar#, and so on...
 397
 398 \begin{code}
 399 exportsFromAvail :: Module
 400                  -> Maybe [RdrNameIE]   -- Export spec
 401                  -> ExportAvails
 402                  -> RnEnv
 403                  -> RnMG (Name -> ExportFlag, ExportEnv)
 404         -- Complains if two distinct exports have same OccName
 405         -- Complains about exports items not in scope
 406 exportsFromAvail this_mod Nothing export_avails rn_env
 407   = exportsFromAvail this_mod (Just [IEModuleContents this_mod]) export_avails rn_env
 408
 409 exportsFromAvail this_mod (Just export_items)
 410                  (mod_avail_env, entity_avail_env)
 411                  (RnEnv name_env fixity_env)
 412   = mapRn exports_from_item export_items                `thenRn` \ avail_envs ->
 413     foldlRn plusAvailEnv emptyAvailEnv avail_envs       `thenRn` \ export_avail_env ->
 414     let
 415         export_avails   = map snd (eltsFM export_avail_env)
 416         export_fixities = mk_exported_fixities (availsToNameSet export_avails)
 417         export_fn       = mk_export_fn export_avails
 418     in
 419     returnRn (export_fn, ExportEnv export_avails export_fixities)
 420
 421   where
 422     exports_from_item :: RdrNameIE -> RnMG AvailEnv
 423     exports_from_item ie@(IEModuleContents mod)
 424         = case lookupFM mod_avail_env 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 entity_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   = hsep [ptext SLIT("The export items"), ppr sty ie1, ptext SLIT("and"), ppr sty ie2,
 529           ptext SLIT("create conflicting exports for"), ppr sty occ_name]
 530 \end{code}
 531