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