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