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