ghc/compiler/rename/RnNames.lhs

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