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 )
  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   = if not opt_SourceUnchanged then
 115         -- Source code changed; look no further
 116         returnRn False
 117     else
 118         -- Unchanged source; look further
 119         -- We check for
 120         --      (a) errors so far.  These can arise if a module imports
 121         --          something that's no longer exported by the imported module
 122         --      (b) usage information up to date
 123         checkErrsRn                             `thenRn` \ no_errs_so_far ->
 124         checkUpToDate mod                       `thenRn` \ up_to_date ->
 125         returnRn (no_errs_so_far && up_to_date)
 126 \end{code}
 127
 128
 129 \begin{code}
 130 importsFromImportDecl :: RdrNameImportDecl
 131                       -> RnMG (RnEnv, ModuleAvails)
 132
 133 importsFromImportDecl (ImportDecl mod qual_only as_mod import_spec loc)
 134   = pushSrcLocRn loc $
 135     getInterfaceExports mod                     `thenRn` \ (avails, fixities) ->
 136     filterImports mod import_spec avails        `thenRn` \ filtered_avails ->
 137     let
 138         filtered_avails' = [ Avail (set_name_prov n) (map set_name_prov ns)
 139                            | Avail n ns <- filtered_avails
 140                            ]
 141         fixities'        = [ (occ,fixity,provenance) | (occ,fixity) <- fixities ]
 142     in
 143     qualifyImports mod
 144                    True                 -- Want qualified names
 145                    (not qual_only)      -- Maybe want unqualified names
 146                    as_mod
 147                    (ExportEnv filtered_avails' fixities')
 148   where
 149     set_name_prov name = setNameProvenance name provenance
 150     provenance = Imported mod loc
 151 \end{code}
 152
 153
 154 \begin{code}
 155 importsFromLocalDecls rec_exp_fn (HsModule mod _ _ _ fix_decls decls _)
 156   = foldlRn getLocalDeclBinders [] decls                `thenRn` \ avails ->
 157     mapRn fixityFromFixDecl fix_decls                   `thenRn` \ fixities ->
 158     qualifyImports mod
 159                    False        -- Don't want qualified names
 160                    True         -- Want unqualified names
 161                    Nothing      -- No "as M" part
 162                    (ExportEnv avails fixities)
 163   where
 164     newLocalName rdr_name loc
 165       = newLocallyDefinedGlobalName mod (rdrNameOcc rdr_name) rec_exp_fn loc
 166
 167     getLocalDeclBinders avails (ValD binds)
 168       = mapRn do_one (bagToList (collectTopBinders binds))      `thenRn` \ val_avails ->
 169         returnRn (val_avails ++ avails)
 170
 171     getLocalDeclBinders avails decl
 172       = getDeclBinders newLocalName decl        `thenRn` \ avail ->
 173         returnRn (avail : avails)
 174
 175     do_one (rdr_name, loc)
 176       = newLocalName rdr_name loc       `thenRn` \ name ->
 177         returnRn (Avail name [])
 178 \end{code}
 179
 180 %************************************************************************
 181 %*                                                                      *
 182 \subsection{Filtering imports}
 183 %*                                                                      *
 184 %************************************************************************
 185
 186 @filterImports@ takes the @ExportEnv@ telling what the imported module makes
 187 available, and filters it through the import spec (if any).
 188
 189 \begin{code}
 190 filterImports :: Module
 191               -> Maybe (Bool, [RdrNameIE])              -- Import spec; True => hidin
 192               -> [AvailInfo]                            -- What's available
 193               -> RnMG [AvailInfo]                       -- What's actually imported
 194         -- Complains if import spec mentions things the
 195         -- module doesn't export
 196
 197 filterImports mod Nothing imports
 198   = returnRn imports
 199
 200 filterImports mod (Just (want_hiding, import_items)) avails
 201   =     -- Check that each import item mentions things that are actually available
 202     mapRn check_import_item import_items        `thenRn_`
 203
 204         -- Return filtered environment; no need to filter fixities
 205     returnRn (map new_avail avails)
 206
 207   where
 208     import_fm :: FiniteMap OccName RdrNameIE
 209     import_fm = listToFM [(ieOcc ie, ie) | ie <- import_items]
 210
 211     avail_fm :: FiniteMap OccName AvailInfo
 212     avail_fm = listToFM [(nameOccName name, avail) | avail@(Avail name ns) <- avails]
 213
 214     new_avail NotAvailable = NotAvailable
 215     new_avail avail@(Avail name _)
 216         | not in_import_items && want_hiding     = avail
 217         | not in_import_items && not want_hiding = NotAvailable
 218         | in_import_items     && want_hiding     = NotAvailable
 219         | in_import_items     && not want_hiding = filtered_avail
 220         where
 221           maybe_import_item = lookupFM import_fm (nameOccName name)
 222           in_import_items   = maybeToBool maybe_import_item
 223           Just import_item  = maybe_import_item
 224           filtered_avail    = filterAvail import_item avail
 225
 226     check_import_item  :: RdrNameIE -> RnMG ()
 227     check_import_item item
 228       = checkRn (maybeToBool maybe_matching_avail && sub_names_ok item avail)
 229                 (badImportItemErr mod item)
 230      where
 231        item_name            = ieOcc item
 232        maybe_matching_avail = lookupFM avail_fm item_name
 233        Just avail           = maybe_matching_avail
 234
 235     sub_names_ok (IEVar _)              _             = True
 236     sub_names_ok (IEThingAbs _)         _             = True
 237     sub_names_ok (IEThingAll _)         _             = True
 238     sub_names_ok (IEThingWith _ wanted) (Avail _ has) = all ((`elem` has_list) . rdrNameOcc) wanted
 239                                                       where
 240                                                         has_list = map nameOccName has
 241     sub_names_ok other1                 other2        = False
 242 \end{code}
 243
 244
 245
 246 %************************************************************************
 247 %*                                                                      *
 248 \subsection{Qualifiying imports}
 249 %*                                                                      *
 250 %************************************************************************
 251
 252 @qualifyImports@ takes the @ExportEnv@ after filtering through the import spec
 253 of an import decl, and deals with producing an @RnEnv@ with the
 254 right qaulified names.  It also turns the @Names@ in the @ExportEnv@ into
 255 fully fledged @Names@.
 256
 257 \begin{code}
 258 qualifyImports :: Module                                -- Imported module
 259                -> Bool                                  -- True <=> want qualified import
 260                -> Bool                                  -- True <=> want unqualified import
 261                -> Maybe Module                          -- Optional "as M" part
 262                -> ExportEnv                             -- What's imported
 263                -> RnMG (RnEnv, ModuleAvails)
 264
 265 qualifyImports this_mod qual_imp unqual_imp as_mod (ExportEnv avails fixities)
 266   =     -- Make the qualified-name environments, checking of course for clashes
 267     foldlRn add_name emptyNameEnv avails                        `thenRn` \ name_env ->
 268     foldlRn (add_fixity name_env) emptyFixityEnv fixities       `thenRn` \ fixity_env ->
 269     returnRn (RnEnv name_env fixity_env, mod_avail_env)
 270   where
 271     show_it (rdr, (fix,prov)) = ppSep [ppLbrack, ppr PprDebug rdr, ppr PprDebug fix, pprProvenance PprDebug prov, ppRbrack]
 272
 273     qual_mod = case as_mod of
 274                   Nothing           -> this_mod
 275                   Just another_name -> another_name
 276
 277     mod_avail_env  = unitFM qual_mod avails
 278
 279     add_name name_env NotAvailable = returnRn name_env
 280     add_name name_env (Avail n ns) = foldlRn add_one name_env (n : ns)
 281
 282     add_one :: NameEnv -> Name -> RnMG NameEnv
 283     add_one env name = add_to_env addOneToNameEnvRn env occ_name name
 284                      where
 285                         occ_name = nameOccName name
 286
 287     add_to_env add_fn env occ thing | qual_imp && unqual_imp = both
 288                                     | qual_imp               = qual_only
 289                                     | unqual_imp             = unqual_only
 290                                 where
 291                                   unqual_only = add_fn env  (Unqual occ)        thing
 292                                   qual_only   = add_fn env  (Qual qual_mod occ) thing
 293                                   both        = unqual_only     `thenRn` \ env' ->
 294                                                 add_fn env' (Qual qual_mod occ) thing
 295
 296     add_fixity name_env fixity_env (occ_name, fixity, provenance)
 297         | maybeToBool (lookupFM name_env rdr_name)      -- It's imported
 298         = add_to_env addOneToFixityEnvRn fixity_env occ_name (fixity,provenance)
 299         | otherwise                                     -- It ain't imported
 300         = returnRn fixity_env
 301         where
 302                 -- rdr_name is a name by which the thing is guaranteed to be known,
 303                 -- *if it is imported at all*
 304           rdr_name | qual_imp  = Qual qual_mod occ_name
 305                    | otherwise = Unqual occ_name
 306 \end{code}
 307
 308 unQualify adds an Unqual binding for every existing Qual binding.
 309
 310 \begin{code}
 311 unQualify :: FiniteMap RdrName elt -> FiniteMap RdrName elt
 312 unQualify fm = addListToFM fm [(Unqual occ, elt) | (Qual _ occ, elt) <- fmToList fm]
 313 \end{code}
 314
 315 %************************************************************************
 316 %*                                                                      *
 317 \subsection{Local declarations}
 318 %*                                                                      *
 319 %************************************************************************
 320
 321
 322 \begin{code}
 323 fixityFromFixDecl :: RdrNameFixityDecl -> RnMG (OccName, Fixity, Provenance)
 324
 325 fixityFromFixDecl (FixityDecl rdr_name fixity loc)
 326   = returnRn (rdrNameOcc rdr_name, fixity, LocalDef (panic "export-flag") loc)
 327 \end{code}
 328
 329
 330 %************************************************************************
 331 %*                                                                      *
 332 \subsection{Export list processing
 333 %*                                                                      *
 334 %************************************************************************
 335
 336 The @AvailEnv@ type is just used internally in @exportsFromAvail@.
 337 When exporting we need to combine the availabilities for a particular
 338 exported thing, and we also need to check for name clashes -- that
 339 is: two exported things must have different @OccNames@.
 340
 341 \begin{code}
 342 type AvailEnv = FiniteMap OccName (RdrNameIE, AvailInfo)
 343         -- The FM maps each OccName to the RdrNameIE that gave rise to it,
 344         -- for error reporting, as well as to its AvailInfo
 345
 346 emptyAvailEnv = emptyFM
 347
 348 unitAvailEnv :: RdrNameIE -> AvailInfo -> AvailEnv
 349 unitAvailEnv ie NotAvailable
 350   = emptyFM
 351 unitAvailEnv ie avail@(Avail n ns)
 352   = unitFM (nameOccName n) (ie,avail)
 353
 354 plusAvailEnv a1 a2
 355   = mapRn (addErrRn.availClashErr) (conflictsFM bad_avail a1 a2)        `thenRn_`
 356     returnRn (plusFM_C plus_avail a1 a2)
 357
 358 listToAvailEnv :: RdrNameIE -> [AvailInfo] -> RnM s d AvailEnv
 359 listToAvailEnv ie items
 360   = foldlRn plusAvailEnv emptyAvailEnv (map (unitAvailEnv ie) items)
 361
 362 bad_avail  (ie1,Avail n1 _) (ie2,Avail n2 _) = n1 /= n2 -- Same OccName, different Name
 363 plus_avail (ie1,a1) (ie2,a2) = (ie1, a1 `plusAvail` a2)
 364 \end{code}
 365
 366
 367 \begin{code}
 368 exportsFromAvail :: Module
 369                  -> Maybe [RdrNameIE]   -- Export spec
 370                  -> ModuleAvails
 371                  -> RnEnv
 372                  -> RnMG (Name -> ExportFlag, ExportEnv)
 373         -- Complains if two distinct exports have same OccName
 374         -- Complains about exports items not in scope
 375 exportsFromAvail this_mod Nothing all_avails rn_env
 376   = exportsFromAvail this_mod (Just [IEModuleContents this_mod]) all_avails rn_env
 377
 378 exportsFromAvail this_mod (Just export_items) all_avails (RnEnv name_env fixity_env)
 379   = mapRn exports_from_item export_items                `thenRn` \ avail_envs ->
 380     foldlRn plusAvailEnv emptyAvailEnv avail_envs       `thenRn` \ export_avail_env ->
 381     let
 382         export_avails   = map snd (eltsFM export_avail_env)
 383         export_fixities = mk_exported_fixities (availsToNameSet export_avails)
 384         export_fn       = mk_export_fn export_avails
 385     in
 386     returnRn (export_fn, ExportEnv export_avails export_fixities)
 387
 388   where
 389     full_avail_env :: UniqFM AvailInfo
 390     full_avail_env = addListToUFM_C plusAvail emptyUFM
 391                            [(name,avail) | avail@(Avail name _) <- concat (eltsFM all_avails)]
 392         -- NB: full_avail_env won't contain bindings for data constructors and class ops,
 393         -- which is right and proper; attempts to export them on their own will provoke an error
 394
 395     exports_from_item :: RdrNameIE -> RnMG AvailEnv
 396     exports_from_item ie@(IEModuleContents mod)
 397         = case lookupFM all_avails mod of
 398                 Nothing     -> failWithRn emptyAvailEnv (modExportErr mod)
 399                 Just avails -> addOccurrenceNames Compulsory [n | Avail n _ <- avails]  `thenRn_`
 400                                listToAvailEnv ie avails
 401
 402     exports_from_item ie
 403         | not (maybeToBool maybe_in_scope)
 404         = failWithRn emptyAvailEnv (unknownNameErr (ieName ie))
 405
 406 #ifdef DEBUG
 407         -- I can't see why this should ever happen; if the thing is in scope
 408         -- at all it ought to have some availability
 409         | not (maybeToBool maybe_avail)
 410         = pprTrace "exportsFromAvail: curious Nothing:" (ppr PprDebug name)
 411           returnRn emptyAvailEnv
 412 #endif
 413
 414         | not enough_avail
 415         = failWithRn emptyAvailEnv (exportItemErr ie export_avail)
 416
 417         | otherwise     -- Phew!  It's OK!
 418         = addOccurrenceName Compulsory name     `thenRn_`
 419           returnRn (unitAvailEnv ie export_avail)
 420        where
 421           maybe_in_scope  = lookupNameEnv name_env (ieName ie)
 422           Just name       = maybe_in_scope
 423           maybe_avail     = lookupUFM full_avail_env name
 424           Just avail      = maybe_avail
 425           export_avail    = filterAvail ie avail
 426           enough_avail    = case export_avail of {NotAvailable -> False; other -> True}
 427
 428         -- We export a fixity iff we export a thing with the same (qualified) RdrName
 429     mk_exported_fixities :: NameSet -> [(OccName, Fixity, Provenance)]
 430     mk_exported_fixities exports
 431         = [ (rdrNameOcc rdr_name, fixity, prov)
 432           | (rdr_name, (fixity, prov)) <- fmToList fixity_env,
 433              export_fixity name_env exports rdr_name
 434           ]
 435
 436 mk_export_fn :: [AvailInfo] -> (Name -> ExportFlag)
 437 mk_export_fn avails
 438   = \name -> if name `elemNameSet` exported_names
 439              then Exported
 440              else NotExported
 441   where
 442     exported_names :: NameSet
 443     exported_names = availsToNameSet avails
 444
 445 export_fixity :: NameEnv -> NameSet -> RdrName -> Bool
 446 export_fixity name_env exports rdr_name
 447   = case lookupFM name_env rdr_name of
 448         Just fixity_name -> fixity_name `elemNameSet` exports
 449                                 -- Check whether the exported thing is
 450                                 -- the one to which the fixity attaches
 451         other   -> False        -- Not even in scope
 452 \end{code}
 453
 454
 455 %************************************************************************
 456 %*                                                                      *
 457 \subsection{Errors}
 458 %*                                                                      *
 459 %************************************************************************
 460
 461 \begin{code}
 462 ieOcc ie = rdrNameOcc (ieName ie)
 463
 464 badImportItemErr mod ie sty
 465   = ppSep [ppStr "Module", pprModule sty mod, ppStr "does not export", ppr sty ie]
 466
 467 modExportErr mod sty
 468   = ppCat [ ppStr "Unknown module in export list: module", ppPStr mod]
 469
 470 exportItemErr export_item NotAvailable sty
 471   = ppSep [ ppStr "Export item not in scope:", ppr sty export_item ]
 472
 473 exportItemErr export_item avail sty
 474   = ppHang (ppStr "Export item not fully in scope:")
 475            4 (ppAboves [ppCat [ppStr "Wanted:    ", ppr sty export_item],
 476                         ppCat [ppStr "Available: ", ppr sty (ieOcc export_item), pprAvail sty avail]])
 477
 478 availClashErr (occ_name, ((ie1,avail1), (ie2,avail2))) sty
 479   = ppHang (ppCat [ppStr "Conflicting exports for local name: ", ppr sty occ_name])
 480         4 (ppAboves [ppr sty ie1, ppr sty ie2])
 481 \end{code}
 482