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