ghc/compiler/rename/RnIfaces.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
   3 %
   4 \section[RnIfaces]{Cacheing and Renaming of Interfaces}
   5
   6 \begin{code}
   7 module RnIfaces (
   8         getInterfaceExports,
   9         getImportedInstDecls,
  10         getSpecialInstModules, getDeferredDataDecls,
  11         importDecl, recordSlurp,
  12         getImportVersions, getSlurpedNames, getRnStats, getImportedFixities,
  13
  14         checkUpToDate, loadHomeInterface,
  15
  16         getDeclBinders,
  17         mkSearchPath
  18     ) where
  19
  20 #include "HsVersions.h"
  21
  22 import CmdLineOpts      ( opt_PruneTyDecls,  opt_PruneInstDecls,
  23                           opt_D_show_rn_imports, opt_IgnoreIfacePragmas
  24                         )
  25 import HsSyn            ( HsDecl(..), TyClDecl(..), InstDecl(..), IfaceSig(..),
  26                           HsType(..), ConDecl(..), IE(..), ConDetails(..), Sig(..),
  27                           FixitySig(..),
  28                           hsDeclName, countTyClDecls, isDataDecl, nonFixitySigs
  29                         )
  30 import BasicTypes       ( Version, NewOrData(..) )
  31 import RdrHsSyn         ( RdrNameHsDecl, RdrNameInstDecl, RdrNameTyClDecl,
  32                         )
  33 import RnEnv            ( newImportedGlobalName, newImportedGlobalFromRdrName,
  34                           addImplicitOccsRn, pprAvail,
  35                           availName, availNames, addAvailToNameSet
  36                         )
  37 import RnSource         ( rnHsSigType )
  38 import RnMonad
  39 import RnHsSyn          ( RenamedHsDecl )
  40 import ParseIface       ( parseIface, IfaceStuff(..) )
  41
  42 import FiniteMap        ( FiniteMap, sizeFM, emptyFM, delFromFM,
  43                           lookupFM, addToFM, addToFM_C, addListToFM,
  44                           fmToList
  45                         )
  46 import Name             ( Name {-instance NamedThing-},
  47                           nameModule, moduleString, pprModule, isLocallyDefined,
  48                           isWiredInName, maybeWiredInTyConName,  pprModule,
  49                           maybeWiredInIdName, nameUnique, NamedThing(..)
  50                          )
  51 import OccName          ( Module, mkBootModule,
  52                           moduleIfaceFlavour, bootFlavour, hiFile
  53                         )
  54 import RdrName          ( RdrName, rdrNameOcc )
  55 import NameSet
  56 import Id               ( idType, isDataConId_maybe )
  57 import DataCon          ( dataConTyCon, dataConType )
  58 import TyCon            ( TyCon, tyConDataCons, isSynTyCon, getSynTyConDefn )
  59 import Type             ( namesOfType )
  60 import Var              ( Id )
  61 import SrcLoc           ( mkSrcLoc, SrcLoc )
  62 import PrelMods         ( pREL_GHC )
  63 import PrelInfo         ( cCallishTyKeys, thinAirModules )
  64 import Bag
  65 import Maybes           ( MaybeErr(..), maybeToBool )
  66 import ListSetOps       ( unionLists )
  67 import Outputable
  68 import Unique           ( Unique )
  69 import StringBuffer     ( StringBuffer, hGetStringBuffer )
  70 import FastString       ( mkFastString )
  71 import Outputable
  72
  73 import IO       ( isDoesNotExistError )
  74 import List     ( nub )
  75
  76 \end{code}
  77
  78
  79
  80 %*********************************************************
  81 %*                                                      *
  82 \subsection{Statistics}
  83 %*                                                      *
  84 %*********************************************************
  85
  86 \begin{code}
  87 getRnStats :: [RenamedHsDecl] -> RnMG SDoc
  88 getRnStats all_decls
  89   = getIfacesRn                 `thenRn` \ ifaces ->
  90     let
  91         n_mods      = sizeFM (iModMap ifaces)
  92
  93         decls_imported = filter is_imported_decl all_decls
  94
  95         decls_read     = [decl | (_, avail, decl, True) <- nameEnvElts (iDecls ifaces),
  96                                         -- Data, newtype, and class decls are in the decls_fm
  97                                         -- under multiple names; the tycon/class, and each
  98                                         -- constructor/class op too.
  99                                         -- The 'True' selects just the 'main' decl
 100                                  not (isLocallyDefined (availName avail))
 101                              ]
 102
 103         (cd_rd, dd_rd, add_rd, nd_rd, and_rd, sd_rd, vd_rd,     _) = count_decls decls_read
 104         (cd_sp, dd_sp, add_sp, nd_sp, and_sp, sd_sp, vd_sp, id_sp) = count_decls decls_imported
 105
 106         (unslurped_insts, _)  = iDefInsts ifaces
 107         inst_decls_unslurped  = length (bagToList unslurped_insts)
 108         inst_decls_read       = id_sp + inst_decls_unslurped
 109
 110         stats = vcat
 111                 [int n_mods <> text " interfaces read",
 112                  hsep [ int cd_sp, text "class decls imported, out of",
 113                         int cd_rd, text "read"],
 114                  hsep [ int dd_sp, text "data decls imported (of which", int add_sp,
 115                         text "abstractly), out of",
 116                         int dd_rd, text "read"],
 117                  hsep [ int nd_sp, text "newtype decls imported (of which", int and_sp,
 118                         text "abstractly), out of",
 119                         int nd_rd, text "read"],
 120                  hsep [int sd_sp, text "type synonym decls imported, out of",
 121                         int sd_rd, text "read"],
 122                  hsep [int vd_sp, text "value signatures imported, out of",
 123                         int vd_rd, text "read"],
 124                  hsep [int id_sp, text "instance decls imported, out of",
 125                         int inst_decls_read, text "read"]
 126                 ]
 127     in
 128     returnRn (hcat [text "Renamer stats: ", stats])
 129
 130 is_imported_decl (DefD _) = False
 131 is_imported_decl (ValD _) = False
 132 is_imported_decl decl     = not (isLocallyDefined (hsDeclName decl))
 133
 134 count_decls decls
 135   = -- pprTrace "count_decls" (ppr  decls
 136     --
 137     --                      $$
 138     --                      text "========="
 139     --                      $$
 140     --                      ppr imported_decls
 141     --  ) $
 142     (class_decls,
 143      data_decls,    abstract_data_decls,
 144      newtype_decls, abstract_newtype_decls,
 145      syn_decls,
 146      val_decls,
 147      inst_decls)
 148   where
 149     tycl_decls = [d | TyClD d <- decls]
 150     (class_decls, data_decls, newtype_decls, syn_decls) = countTyClDecls tycl_decls
 151     abstract_data_decls    = length [() | TyData DataType _ _ _ [] _ _ _ <- tycl_decls]
 152     abstract_newtype_decls = length [() | TyData NewType  _ _ _ [] _ _ _ <- tycl_decls]
 153
 154     val_decls     = length [() | SigD _   <- decls]
 155     inst_decls    = length [() | InstD _  <- decls]
 156
 157 \end{code}
 158
 159 %*********************************************************
 160 %*                                                      *
 161 \subsection{Loading a new interface file}
 162 %*                                                      *
 163 %*********************************************************
 164
 165 \begin{code}
 166 loadHomeInterface :: SDoc -> Name -> RnMG Ifaces
 167 loadHomeInterface doc_str name
 168   = loadInterface doc_str (nameModule name)
 169
 170 loadInterface :: SDoc -> Module -> RnMG Ifaces
 171 loadInterface doc_str load_mod
 172  = getIfacesRn          `thenRn` \ ifaces ->
 173    let
 174         new_hif              = moduleIfaceFlavour load_mod
 175         this_mod             = iMod ifaces
 176         mod_map              = iModMap ifaces
 177         (insts, tycls_names) = iDefInsts ifaces
 178    in
 179         -- CHECK WHETHER WE HAVE IT ALREADY
 180    case lookupFM mod_map load_mod of {
 181         Just (existing_hif, _, _)
 182                 | bootFlavour new_hif || not (bootFlavour existing_hif)
 183                 ->      -- Already in the cache, and new version is no better than old,
 184                         -- so don't re-read it
 185                     returnRn ifaces ;
 186         other ->
 187
 188         -- READ THE MODULE IN
 189    findAndReadIface doc_str load_mod            `thenRn` \ read_result ->
 190    case read_result of {
 191         -- Check for not found
 192         Nothing ->      -- Not found, so add an empty export env to the Ifaces map
 193                         -- so that we don't look again
 194                    let
 195                         new_mod_map = addToFM mod_map load_mod (hiFile, 0, [])
 196                         new_ifaces = ifaces { iModMap = new_mod_map }
 197                    in
 198                    setIfacesRn new_ifaces               `thenRn_`
 199                    failWithRn new_ifaces (noIfaceErr load_mod) ;
 200
 201         -- Found and parsed!
 202         Just (ParsedIface _ mod_vers usages exports rd_inst_mods rd_decls rd_insts) ->
 203
 204         -- LOAD IT INTO Ifaces
 205         -- First set the module
 206     setModuleRn load_mod        $
 207
 208         -- NB: *first* we do loadDecl, so that the provenance of all the locally-defined
 209         ---    names is done correctly (notably, whether this is an .hi file or .hi-boot file).
 210         --     If we do loadExport first the wrong info gets into the cache (unless we
 211         --      explicitly tag each export which seems a bit of a bore)
 212     foldlRn loadDecl (iDecls ifaces) rd_decls           `thenRn` \ new_decls ->
 213     foldlRn loadFixDecl (iFixes ifaces) rd_decls        `thenRn` \ new_fixities ->
 214     mapRn   loadExport exports                          `thenRn` \ avails_s ->
 215     foldlRn loadInstDecl insts rd_insts                 `thenRn` \ new_insts ->
 216     let
 217          mod_details = (new_hif, mod_vers, concat avails_s)
 218
 219                         -- Exclude this module from the "special-inst" modules
 220          new_inst_mods = iInstMods ifaces `unionLists` (filter (/= this_mod) rd_inst_mods)
 221
 222          new_ifaces = ifaces { iModMap   = addToFM mod_map load_mod mod_details,
 223                                iDecls    = new_decls,
 224                                iFixes    = new_fixities,
 225                                iDefInsts = (new_insts, tycls_names),
 226                                iInstMods = new_inst_mods  }
 227     in
 228     setIfacesRn new_ifaces              `thenRn_`
 229     returnRn new_ifaces
 230     }}
 231
 232 loadExport :: ExportItem -> RnMG [AvailInfo]
 233 loadExport (mod, entities)
 234   = mapRn load_entity entities
 235   where
 236     new_name occ = newImportedGlobalName mod occ
 237
 238     load_entity (Avail occ)
 239       = new_name occ            `thenRn` \ name ->
 240         returnRn (Avail name)
 241     load_entity (AvailTC occ occs)
 242       = new_name occ            `thenRn` \ name ->
 243         mapRn new_name occs     `thenRn` \ names ->
 244         returnRn (AvailTC name names)
 245
 246
 247 loadFixDecl :: FixityEnv
 248             -> (Version, RdrNameHsDecl)
 249             -> RnMG FixityEnv
 250 loadFixDecl fixity_env (version, FixD (FixitySig rdr_name fixity loc))
 251   =     -- Ignore the version; when the fixity changes the version of
 252         -- its 'host' entity changes, so we don't need a separate version
 253         -- number for fixities
 254     newImportedGlobalFromRdrName rdr_name       `thenRn` \ name ->
 255     let
 256         new_fixity_env = addToNameEnv fixity_env name (FixitySig name fixity loc)
 257     in
 258     returnRn new_fixity_env
 259
 260         -- Ignore the other sorts of decl
 261 loadFixDecl fixity_env other_decl = returnRn fixity_env
 262
 263 loadDecl :: DeclsMap
 264          -> (Version, RdrNameHsDecl)
 265          -> RnMG DeclsMap
 266
 267 loadDecl decls_map (version, decl)
 268   = getDeclBinders new_name decl        `thenRn` \ maybe_avail ->
 269     case maybe_avail of {
 270         Nothing -> returnRn decls_map;  -- No bindings
 271         Just avail ->
 272
 273     getDeclSysBinders new_name decl     `thenRn` \ sys_bndrs ->
 274     let
 275         main_name     = availName avail
 276         new_decls_map = foldl add_decl decls_map
 277                                        [ (name, (version,avail,decl',name==main_name))
 278                                        | name <- sys_bndrs ++ availNames avail]
 279         add_decl decls_map (name, stuff)
 280           = WARN( name `elemNameEnv` decls_map, ppr name )
 281             addToNameEnv decls_map name stuff
 282     in
 283     returnRn new_decls_map
 284     }
 285   where
 286     new_name rdr_name loc = newImportedGlobalFromRdrName rdr_name
 287     {-
 288       If a signature decl is being loaded, and optIgnoreIfacePragmas is on,
 289       we toss away unfolding information.
 290
 291       Also, if the signature is loaded from a module we're importing from source,
 292       we do the same. This is to avoid situations when compiling a pair of mutually
 293       recursive modules, peering at unfolding info in the interface file of the other,
 294       e.g., you compile A, it looks at B's interface file and may as a result change
 295       its interface file. Hence, B is recompiled, maybe changing its interface file,
 296       which will the unfolding info used in A to become invalid. Simple way out is to
 297       just ignore unfolding info.
 298
 299       [Jan 99: I junked the second test above.  If we're importing from an hi-boot
 300        file there isn't going to *be* any pragma info.  Maybe the above comment
 301        dates from a time where we picked up a .hi file first if it existed?]
 302     -}
 303     decl' =
 304      case decl of
 305        SigD (IfaceSig name tp ls loc) | opt_IgnoreIfacePragmas ->
 306             SigD (IfaceSig name tp [] loc)
 307        _ -> decl
 308
 309 loadInstDecl :: Bag IfaceInst
 310              -> RdrNameInstDecl
 311              -> RnMG (Bag IfaceInst)
 312 loadInstDecl insts decl@(InstDecl inst_ty binds uprags dfun_name src_loc)
 313   =
 314         -- Find out what type constructors and classes are "gates" for the
 315         -- instance declaration.  If all these "gates" are slurped in then
 316         -- we should slurp the instance decl too.
 317         --
 318         -- We *don't* want to count names in the context part as gates, though.
 319         -- For example:
 320         --              instance Foo a => Baz (T a) where ...
 321         --
 322         -- Here the gates are Baz and T, but *not* Foo.
 323     let
 324         munged_inst_ty = case inst_ty of
 325                                 HsForAllTy tvs cxt ty -> HsForAllTy tvs [] ty
 326                                 other                 -> inst_ty
 327     in
 328         -- We find the gates by renaming the instance type with in a
 329         -- and returning the free variables of the type
 330     initRnMS emptyRnEnv vanillaInterfaceMode (
 331         discardOccurrencesRn (rnHsSigType (text "an instance decl") munged_inst_ty)
 332     )                                           `thenRn` \ (_, gate_names) ->
 333     getModuleRn                                 `thenRn` \ mod_name ->
 334     returnRn (((mod_name, decl), gate_names) `consBag` insts)
 335
 336 vanillaInterfaceMode = InterfaceMode Compulsory
 337 \end{code}
 338
 339
 340 %********************************************************
 341 %*                                                      *
 342 \subsection{Loading usage information}
 343 %*                                                      *
 344 %********************************************************
 345
 346 \begin{code}
 347 checkUpToDate :: Module -> RnMG Bool            -- True <=> no need to recompile
 348 checkUpToDate mod_name
 349   = findAndReadIface doc_str mod_name           `thenRn` \ read_result ->
 350
 351         -- CHECK WHETHER WE HAVE IT ALREADY
 352     case read_result of
 353         Nothing ->      -- Old interface file not found, so we'd better bail out
 354                     traceRn (sep [ptext SLIT("Didnt find old iface"),
 355                                     pprModule mod_name])        `thenRn_`
 356                     returnRn False
 357
 358         Just (ParsedIface _ _ usages _ _ _ _)
 359                 ->      -- Found it, so now check it
 360                     checkModUsage usages
 361   where
 362         -- Only look in current directory, with suffix .hi
 363     doc_str = sep [ptext SLIT("need usage info from"), pprModule mod_name]
 364
 365 checkModUsage [] = returnRn True                -- Yes!  Everything is up to date!
 366
 367 checkModUsage ((mod, old_mod_vers, whats_imported) : rest)
 368   = loadInterface doc_str mod           `thenRn` \ ifaces ->
 369     let
 370         maybe_new_mod_vers        = lookupFM (iModMap ifaces) mod
 371         Just (_, new_mod_vers, _) = maybe_new_mod_vers
 372     in
 373         -- If we can't find a version number for the old module then
 374         -- bail out saying things aren't up to date
 375     if not (maybeToBool maybe_new_mod_vers) then
 376         traceRn (sep [ptext SLIT("Can't find version number for module"), pprModule mod]) `thenRn_`
 377         returnRn False
 378     else
 379
 380         -- If the module version hasn't changed, just move on
 381     if new_mod_vers == old_mod_vers then
 382         traceRn (sep [ptext SLIT("Module version unchanged:"), pprModule mod])  `thenRn_`
 383         checkModUsage rest
 384     else
 385     traceRn (sep [ptext SLIT("Module version has changed:"), pprModule mod])    `thenRn_`
 386
 387         -- Module version changed, so check entities inside
 388
 389         -- If the usage info wants to say "I imported everything from this module"
 390         --     it does so by making whats_imported equal to Everything
 391         -- In that case, we must recompile
 392     case whats_imported of {
 393       Everything -> traceRn (ptext SLIT("...and I needed the whole module"))    `thenRn_`
 394                     returnRn False;                -- Bale out
 395
 396       Specifically old_local_vers ->
 397
 398         -- Non-empty usage list, so check item by item
 399     checkEntityUsage mod (iDecls ifaces) old_local_vers `thenRn` \ up_to_date ->
 400     if up_to_date then
 401         traceRn (ptext SLIT("...but the bits I use haven't."))  `thenRn_`
 402         checkModUsage rest      -- This one's ok, so check the rest
 403     else
 404         returnRn False          -- This one failed, so just bail out now
 405     }
 406   where
 407     doc_str = sep [ptext SLIT("need version info for"), pprModule mod]
 408
 409
 410 checkEntityUsage mod decls []
 411   = returnRn True       -- Yes!  All up to date!
 412
 413 checkEntityUsage mod decls ((occ_name,old_vers) : rest)
 414   = newImportedGlobalName mod occ_name          `thenRn` \ name ->
 415     case lookupNameEnv decls name of
 416
 417         Nothing       ->        -- We used it before, but it ain't there now
 418                           putDocRn (sep [ptext SLIT("No longer exported:"), ppr name])  `thenRn_`
 419                           returnRn False
 420
 421         Just (new_vers,_,_,_)   -- It's there, but is it up to date?
 422                 | new_vers == old_vers
 423                         -- Up to date, so check the rest
 424                 -> checkEntityUsage mod decls rest
 425
 426                 | otherwise
 427                         -- Out of date, so bale out
 428                 -> putDocRn (sep [ptext SLIT("Out of date:"), ppr name])  `thenRn_`
 429                    returnRn False
 430 \end{code}
 431
 432
 433 %*********************************************************
 434 %*                                                      *
 435 \subsection{Getting in a declaration}
 436 %*                                                      *
 437 %*********************************************************
 438
 439 \begin{code}
 440 importDecl :: Occurrence -> RnMode -> RnMG (Maybe RdrNameHsDecl)
 441         -- Returns Nothing for a wired-in or already-slurped decl
 442
 443 importDecl (name, loc) mode
 444   = checkSlurped name                   `thenRn` \ already_slurped ->
 445     if already_slurped then
 446 --      traceRn (sep [text "Already slurped:", ppr name])       `thenRn_`
 447         returnRn Nothing        -- Already dealt with
 448     else
 449     if isWiredInName name then
 450         getWiredInDecl name mode
 451     else
 452        getIfacesRn              `thenRn` \ ifaces ->
 453        let
 454          mod = nameModule name
 455        in
 456        if mod == iMod ifaces then    -- Don't bring in decls from
 457           addWarnRn (importDeclWarn mod name loc) `thenRn_`
 458 --        pprTrace "importDecl wierdness:" (ppr name) $
 459           returnRn Nothing         -- the renamed module's own interface file
 460                                    --
 461        else
 462        getNonWiredInDecl name loc mode
 463 \end{code}
 464
 465 \begin{code}
 466 getNonWiredInDecl :: Name -> SrcLoc -> RnMode -> RnMG (Maybe RdrNameHsDecl)
 467 getNonWiredInDecl needed_name loc mode
 468   = traceRn doc_str                             `thenRn_`
 469     loadHomeInterface doc_str needed_name       `thenRn` \ ifaces ->
 470     case lookupNameEnv (iDecls ifaces) needed_name of
 471
 472         -- Special case for data/newtype type declarations
 473       Just (version, avail, TyClD tycl_decl, _) | isDataDecl tycl_decl
 474         -> getNonWiredDataDecl needed_name version avail tycl_decl      `thenRn` \ (avail', maybe_decl) ->
 475            recordSlurp (Just version) necessity avail'                  `thenRn_`
 476            returnRn maybe_decl
 477
 478       Just (version,avail,decl,_)
 479         -> recordSlurp (Just version) necessity avail   `thenRn_`
 480            returnRn (Just decl)
 481
 482       Nothing ->        -- Can happen legitimately for "Optional" occurrences
 483                    case necessity of {
 484                         Optional -> addWarnRn (getDeclWarn needed_name loc);
 485                         other    -> addErrRn  (getDeclErr  needed_name loc)
 486                    }                                            `thenRn_`
 487                    returnRn Nothing
 488   where
 489      necessity = modeToNecessity mode
 490      doc_str = sep [ptext SLIT("need decl for"), ppr needed_name, ptext SLIT("needed at"), ppr loc]
 491 \end{code}
 492
 493 @getWiredInDecl@ maps a wired-in @Name@ to what it makes available.
 494 It behaves exactly as if the wired in decl were actually in an interface file.
 495 Specifically,
 496
 497   *     if the wired-in name is a data type constructor or a data constructor,
 498         it brings in the type constructor and all the data constructors; and
 499         marks as "occurrences" any free vars of the data con.
 500
 501   *     similarly for synonum type constructor
 502
 503   *     if the wired-in name is another wired-in Id, it marks as "occurrences"
 504         the free vars of the Id's type.
 505
 506   *     it loads the interface file for the wired-in thing for the
 507         sole purpose of making sure that its instance declarations are available
 508
 509 All this is necessary so that we know all types that are "in play", so
 510 that we know just what instances to bring into scope.
 511
 512 \begin{code}
 513 getWiredInDecl name mode
 514   = setModuleRn mod_name (
 515         initRnMS emptyRnEnv new_mode get_wired
 516     )                                           `thenRn` \ avail ->
 517     recordSlurp Nothing necessity avail         `thenRn_`
 518
 519         -- Force in the home module in case it has instance decls for
 520         -- the thing we are interested in.
 521         --
 522         -- Mini hack 1: no point for non-tycons/class; and if we
 523         -- do this we find PrelNum trying to import PackedString,
 524         -- because PrelBase's .hi file mentions PackedString.unpackString
 525         -- But PackedString.hi isn't built by that point!
 526         --
 527         -- Mini hack 2; GHC is guaranteed not to have
 528         -- instance decls, so it's a waste of time to read it
 529         --
 530         -- NB: We *must* look at the availName of the slurped avail,
 531         -- not the name passed to getWiredInDecl!  Why?  Because if a data constructor
 532         -- or class op is passed to getWiredInDecl we'll pull in the whole data/class
 533         -- decl, and recordSlurp will record that fact.  But since the data constructor
 534         -- isn't a tycon/class we won't force in the home module.  And even if the
 535         -- type constructor/class comes along later, loadDecl will say that it's already
 536         -- been slurped, so getWiredInDecl won't even be called.  Pretty obscure bug, this was.
 537     let
 538         main_name  = availName avail
 539         main_is_tc = case avail of { AvailTC _ _ -> True; Avail _ -> False }
 540         mod        = nameModule main_name
 541         doc_str    = sep [ptext SLIT("need home module for wired in thing"), ppr name]
 542     in
 543     (if not main_is_tc || mod == pREL_GHC then
 544         returnRn ()
 545     else
 546         loadHomeInterface doc_str main_name     `thenRn_`
 547         returnRn ()
 548     )                                           `thenRn_`
 549
 550     returnRn Nothing            -- No declaration to process further
 551   where
 552     necessity = modeToNecessity mode
 553     new_mode = case mode of
 554                         InterfaceMode _ -> mode
 555                         SourceMode      -> vanillaInterfaceMode
 556
 557     get_wired | is_tycon                        -- ... a type constructor
 558               = get_wired_tycon the_tycon
 559
 560               | maybeToBool maybe_data_con              -- ... a wired-in data constructor
 561               = get_wired_tycon (dataConTyCon data_con)
 562
 563               | otherwise                       -- ... a wired-in non data-constructor
 564               = get_wired_id the_id
 565
 566     mod_name             = nameModule name
 567     maybe_wired_in_tycon = maybeWiredInTyConName name
 568     is_tycon             = maybeToBool maybe_wired_in_tycon
 569     maybe_wired_in_id    = maybeWiredInIdName    name
 570     Just the_tycon       = maybe_wired_in_tycon
 571     Just the_id          = maybe_wired_in_id
 572     maybe_data_con       = isDataConId_maybe the_id
 573     Just data_con        = maybe_data_con
 574
 575
 576 get_wired_id id
 577   = addImplicitOccsRn id_mentions       `thenRn_`
 578     returnRn (Avail (getName id))
 579   where
 580     id_mentions = nameSetToList (namesOfType ty)
 581     ty = idType id
 582
 583 get_wired_tycon tycon
 584   | isSynTyCon tycon
 585   = addImplicitOccsRn (nameSetToList mentioned)         `thenRn_`
 586     returnRn (AvailTC tc_name [tc_name])
 587   where
 588     tc_name     = getName tycon
 589     (tyvars,ty) = getSynTyConDefn tycon
 590     mentioned   = namesOfType ty `minusNameSet` mkNameSet (map getName tyvars)
 591
 592 get_wired_tycon tycon
 593   | otherwise           -- data or newtype
 594   = addImplicitOccsRn (nameSetToList mentioned)         `thenRn_`
 595     returnRn (AvailTC tycon_name (tycon_name : map getName data_cons))
 596   where
 597     tycon_name = getName tycon
 598     data_cons  = tyConDataCons tycon
 599     mentioned  = foldr (unionNameSets . namesOfType . dataConType) emptyNameSet data_cons
 600 \end{code}
 601
 602
 603
 604 %*********************************************************
 605 %*                                                      *
 606 \subsection{Getting what a module exports}
 607 %*                                                      *
 608 %*********************************************************
 609
 610 \begin{code}
 611 getInterfaceExports :: Module -> RnMG Avails
 612 getInterfaceExports mod
 613   = loadInterface doc_str mod   `thenRn` \ ifaces ->
 614     case lookupFM (iModMap ifaces) mod of
 615         Nothing ->      -- Not there; it must be that the interface file wasn't found;
 616                         -- the error will have been reported already.
 617                         -- (Actually loadInterface should put the empty export env in there
 618                         --  anyway, but this does no harm.)
 619                       returnRn []
 620
 621         Just (_, _, avails) -> returnRn avails
 622   where
 623     doc_str = sep [pprModule mod, ptext SLIT("is directly imported")]
 624 \end{code}
 625
 626
 627 %*********************************************************
 628 %*                                                      *
 629 \subsection{Data type declarations are handled specially}
 630 %*                                                      *
 631 %*********************************************************
 632
 633 Data type declarations get special treatment.  If we import a data type decl
 634 with all its constructors, we end up importing all the types mentioned in
 635 the constructors' signatures, and hence {\em their} data type decls, and so on.
 636 In effect, we get the transitive closure of data type decls.  Worse, this drags
 637 in tons on instance decls, and their unfoldings, and so on.
 638
 639 If only the type constructor is mentioned, then all this is a waste of time.
 640 If any of the data constructors are mentioned then we really have to
 641 drag in the whole declaration.
 642
 643 So when we import the type constructor for a @data@ or @newtype@ decl, we
 644 put it in the "deferred data/newtype decl" pile in Ifaces.  Right at the end
 645 we slurp these decls, if they havn't already been dragged in by an occurrence
 646 of a constructor.
 647
 648 \begin{code}
 649 getNonWiredDataDecl needed_name
 650                     version
 651                     avail@(AvailTC tycon_name _)
 652                     ty_decl@(TyData new_or_data context tycon tyvars condecls derivings pragmas src_loc)
 653   |  needed_name == tycon_name
 654   && opt_PruneTyDecls
 655         -- don't prune newtypes, as the code generator may
 656         -- want to peer inside a newtype type constructor
 657         -- (ClosureInfo.fun_result_ty is the culprit.)
 658   && not (new_or_data == NewType)
 659   && not (nameUnique needed_name `elem` cCallishTyKeys)
 660         -- Hack!  Don't prune these tycons whose constructors
 661         -- the desugarer must be able to see when desugaring
 662         -- a CCall.  Ugh!
 663
 664   =     -- Need the type constructor; so put it in the deferred set for now
 665     getIfacesRn                 `thenRn` \ ifaces ->
 666     let
 667         deferred_data_decls = iDefData ifaces
 668         new_ifaces          = ifaces {iDefData = new_deferred_data_decls}
 669
 670         no_constr_ty_decl       = TyData new_or_data [] tycon tyvars [] derivings pragmas src_loc
 671         new_deferred_data_decls = addToNameEnv deferred_data_decls tycon_name
 672                                                (nameModule tycon_name, no_constr_ty_decl)
 673                 -- Nota bene: we nuke both the constructors and the context in the deferred decl.
 674                 -- If we don't nuke the context then renaming the deferred data decls can give
 675                 -- new unresolved names (for the classes).  This could be handled, but there's
 676                 -- no point.  If the data type is completely abstract then we aren't interested
 677                 -- its context.
 678     in
 679     setIfacesRn new_ifaces      `thenRn_`
 680     returnRn (AvailTC tycon_name [tycon_name], Nothing)
 681
 682   | otherwise
 683   =     -- Need a data constructor, so delete the data decl from the deferred set if it's there
 684     getIfacesRn                 `thenRn` \ ifaces ->
 685     let
 686         deferred_data_decls = iDefData ifaces
 687         new_ifaces          = ifaces {iDefData = new_deferred_data_decls}
 688
 689         new_deferred_data_decls = delFromNameEnv deferred_data_decls tycon_name
 690     in
 691     setIfacesRn new_ifaces      `thenRn_`
 692     returnRn (avail, Just (TyClD ty_decl))
 693 \end{code}
 694
 695 \begin{code}
 696 getDeferredDataDecls :: RnMG [(Module, RdrNameTyClDecl)]
 697 getDeferredDataDecls
 698   = getIfacesRn                 `thenRn` \ ifaces ->
 699     let
 700         deferred_list = nameEnvElts (iDefData ifaces)
 701         trace_msg = hang (text "Slurping abstract data/newtype decls for: ")
 702                         4 (ppr (map fst deferred_list))
 703     in
 704     traceRn trace_msg                   `thenRn_`
 705     returnRn deferred_list
 706 \end{code}
 707
 708
 709 %*********************************************************
 710 %*                                                      *
 711 \subsection{Instance declarations are handled specially}
 712 %*                                                      *
 713 %*********************************************************
 714
 715 \begin{code}
 716 getImportedInstDecls :: RnMG [(Module,RdrNameInstDecl)]
 717 getImportedInstDecls
 718   =     -- First load any special-instance modules that aren't aready loaded
 719     getSpecialInstModules                       `thenRn` \ inst_mods ->
 720     mapRn load_it inst_mods                     `thenRn_`
 721
 722         -- Now we're ready to grab the instance declarations
 723         -- Find the un-gated ones and return them,
 724         -- removing them from the bag kept in Ifaces
 725     getIfacesRn         `thenRn` \ ifaces ->
 726     let
 727         (insts, tycls_names) = iDefInsts ifaces
 728
 729                 -- An instance decl is ungated if all its gates have been slurped
 730         select_ungated :: IfaceInst                                     -- A gated inst decl
 731
 732                        -> ([(Module, RdrNameInstDecl)], [IfaceInst])    -- Accumulator
 733
 734                        -> ([(Module, RdrNameInstDecl)],                 -- The ungated ones
 735                            [IfaceInst])                                 -- Still gated, but with
 736                                                                         -- depeleted gates
 737         select_ungated (decl,gates) (ungated_decls, gated_decls)
 738           | isEmptyNameSet remaining_gates
 739           = (decl : ungated_decls, gated_decls)
 740           | otherwise
 741           = (ungated_decls, (decl, remaining_gates) : gated_decls)
 742           where
 743             remaining_gates = gates `minusNameSet` tycls_names
 744
 745         (un_gated_insts, still_gated_insts) = foldrBag select_ungated ([], []) insts
 746
 747         new_ifaces = ifaces {iDefInsts = (listToBag still_gated_insts, tycls_names)}
 748                                 -- NB: don't throw away tycls_names;
 749                                 -- we may comre across more instance decls
 750     in
 751     traceRn (sep [text "getInstDecls:", fsep (map ppr (nameSetToList tycls_names))])    `thenRn_`
 752     setIfacesRn new_ifaces      `thenRn_`
 753     returnRn un_gated_insts
 754   where
 755     load_it mod = loadInterface (doc_str mod) mod
 756     doc_str mod = sep [pprModule mod, ptext SLIT("is a special-instance module")]
 757
 758
 759 getSpecialInstModules :: RnMG [Module]
 760 getSpecialInstModules
 761   = getIfacesRn                                         `thenRn` \ ifaces ->
 762     returnRn (iInstMods ifaces)
 763
 764 getImportedFixities :: RnMG FixityEnv
 765 getImportedFixities
 766   = getIfacesRn                                         `thenRn` \ ifaces ->
 767     returnRn (iFixes ifaces)
 768 \end{code}
 769
 770
 771 %*********************************************************
 772 %*                                                      *
 773 \subsection{Keeping track of what we've slurped, and version numbers}
 774 %*                                                      *
 775 %*********************************************************
 776
 777 getImportVersions figures out what the "usage information" for this moudule is;
 778 that is, what it must record in its interface file as the things it uses.
 779 It records:
 780         - anything reachable from its body code
 781         - any module exported with a "module Foo".
 782
 783 Why the latter?  Because if Foo changes then this module's export list
 784 will change, so we must recompile this module at least as far as
 785 making a new interface file --- but in practice that means complete
 786 recompilation.
 787
 788 What about this?
 789         module A( f, g ) where          module B( f ) where
 790           import B( f )                   f = h 3
 791           g = ...                         h = ...
 792
 793 Should we record B.f in A's usages?  In fact we don't.  Certainly, if
 794 anything about B.f changes than anyone who imports A should be recompiled;
 795 they'll get an early exit if they don't use B.f.  However, even if B.f
 796 doesn't change at all, B.h may do so, and this change may not be reflected
 797 in f's version number.  So there are two things going on when compiling module A:
 798
 799 1.  Are A.o and A.hi correct?  Then we can bale out early.
 800 2.  Should modules that import A be recompiled?
 801
 802 For (1) it is slightly harmful to record B.f in A's usages, because a change in
 803 B.f's version will provoke full recompilation of A, producing an identical A.o,
 804 and A.hi differing only in its usage-version of B.f (which isn't used by any importer).
 805
 806 For (2), because of the tricky B.h question above, we ensure that A.hi is touched
 807 (even if identical to its previous version) if A's recompilation was triggered by
 808 an imported .hi file date change.  Given that, there's no need to record B.f in
 809 A's usages.
 810
 811 On the other hand, if A exports "module B" then we *do* count module B among
 812 A's usages, because we must recompile A to ensure that A.hi changes appropriately.
 813
 814 \begin{code}
 815 getImportVersions :: Module                     -- Name of this module
 816                   -> Maybe [IE any]             -- Export list for this module
 817                   -> RnMG (VersionInfo Name)    -- Version info for these names
 818
 819 getImportVersions this_mod exports
 820   = getIfacesRn                                 `thenRn` \ ifaces ->
 821     let
 822         mod_map   = iModMap ifaces
 823         imp_names = iVSlurp ifaces
 824
 825         -- mv_map groups together all the things imported from a particular module.
 826         mv_map, mv_map_mod :: FiniteMap Module (WhatsImported Name)
 827
 828         mv_map_mod = foldl add_mod emptyFM export_mods
 829                 -- mv_map_mod records all the modules that have a "module M"
 830                 -- in this module's export list with an "Everything"
 831
 832         mv_map = foldl add_mv mv_map_mod imp_names
 833                 -- mv_map adds the version numbers of things exported individually
 834
 835         mk_version_info (mod, local_versions)
 836            = case lookupFM mod_map mod of
 837                 Just (hif, version, _) -> (mod, version, local_versions)
 838     in
 839     returnRn (map mk_version_info (fmToList mv_map))
 840   where
 841      export_mods = case exports of
 842                         Nothing -> []
 843                         Just es -> [mod | IEModuleContents mod <- es, mod /= this_mod]
 844
 845      add_mv mv_map v@(name, version)
 846       = addToFM_C add_item mv_map mod (Specifically [v])
 847         where
 848          mod = nameModule name
 849
 850          add_item Everything        _ = Everything
 851          add_item (Specifically xs) _ = Specifically (v:xs)
 852
 853      add_mod mv_map mod = addToFM mv_map mod Everything
 854 \end{code}
 855
 856 \begin{code}
 857 checkSlurped name
 858   = getIfacesRn         `thenRn` \ ifaces ->
 859     returnRn (name `elemNameSet` iSlurp ifaces)
 860
 861 getSlurpedNames :: RnMG NameSet
 862 getSlurpedNames
 863   = getIfacesRn         `thenRn` \ ifaces ->
 864     returnRn (iSlurp ifaces)
 865
 866 recordSlurp maybe_version necessity avail
 867   = {- traceRn (hsep [text "Record slurp:", pprAvail avail,
 868                                         -- NB PprForDebug prints export flag, which is too
 869                                         -- strict; it's a knot-tied thing in RnNames
 870                   case necessity of {Compulsory -> text "comp"; Optional -> text "opt" } ])     `thenRn_`
 871     -}
 872     getIfacesRn         `thenRn` \ ifaces ->
 873     let
 874         Ifaces { iSlurp    = slurped_names,
 875                  iVSlurp   = imp_names,
 876                  iDefInsts = (insts, tycls_names) } = ifaces
 877
 878         new_slurped_names = addAvailToNameSet slurped_names avail
 879
 880         new_imp_names = case maybe_version of
 881                            Just version -> (availName avail, version) : imp_names
 882                            Nothing      -> imp_names
 883
 884                 -- Add to the names that will let in instance declarations;
 885                 -- but only (a) if it's a type/class
 886                 --          (b) if it's compulsory (unless the test flag opt_PruneInstDecls is off)
 887         new_tycls_names = case avail of
 888                                 AvailTC tc _  | not opt_PruneInstDecls ||
 889                                                 case necessity of {Optional -> False; Compulsory -> True }
 890                                               -> tycls_names `addOneToNameSet` tc
 891                                 otherwise     -> tycls_names
 892
 893         new_ifaces = ifaces { iSlurp    = new_slurped_names,
 894                               iVSlurp   = new_imp_names,
 895                               iDefInsts = (insts, new_tycls_names) }
 896     in
 897     setIfacesRn new_ifaces
 898 \end{code}
 899
 900
 901 %*********************************************************
 902 %*                                                      *
 903 \subsection{Getting binders out of a declaration}
 904 %*                                                      *
 905 %*********************************************************
 906
 907 @getDeclBinders@ returns the names for a @RdrNameHsDecl@.
 908 It's used for both source code (from @availsFromDecl@) and interface files
 909 (from @loadDecl@).
 910
 911 It doesn't deal with source-code specific things: ValD, DefD.  They
 912 are handled by the sourc-code specific stuff in RnNames.
 913
 914 \begin{code}
 915 getDeclBinders :: (RdrName -> SrcLoc -> RnMG Name)      -- New-name function
 916                 -> RdrNameHsDecl
 917                 -> RnMG (Maybe AvailInfo)
 918
 919 getDeclBinders new_name (TyClD (TyData _ _ tycon _ condecls _ _ src_loc))
 920   = new_name tycon src_loc                      `thenRn` \ tycon_name ->
 921     getConFieldNames new_name condecls          `thenRn` \ sub_names ->
 922     returnRn (Just (AvailTC tycon_name (tycon_name : nub sub_names)))
 923         -- The "nub" is because getConFieldNames can legitimately return duplicates,
 924         -- when a record declaration has the same field in multiple constructors
 925
 926 getDeclBinders new_name (TyClD (TySynonym tycon _ _ src_loc))
 927   = new_name tycon src_loc              `thenRn` \ tycon_name ->
 928     returnRn (Just (AvailTC tycon_name [tycon_name]))
 929
 930 getDeclBinders new_name (TyClD (ClassDecl _ cname _ sigs _ _ tname dname src_loc))
 931   = new_name cname src_loc                      `thenRn` \ class_name ->
 932
 933         -- Record the names for the class ops
 934     let
 935         -- ignoring fixity declarations
 936         nonfix_sigs = nonFixitySigs sigs
 937     in
 938     mapRn (getClassOpNames new_name) nonfix_sigs        `thenRn` \ sub_names ->
 939
 940     returnRn (Just (AvailTC class_name (class_name : sub_names)))
 941
 942 getDeclBinders new_name (SigD (IfaceSig var ty prags src_loc))
 943   = new_name var src_loc                        `thenRn` \ var_name ->
 944     returnRn (Just (Avail var_name))
 945
 946 getDeclBinders new_name (FixD _)  = returnRn Nothing
 947 getDeclBinders new_name (ForD _)  = returnRn Nothing
 948 getDeclBinders new_name (DefD _)  = returnRn Nothing
 949 getDeclBinders new_name (InstD _) = returnRn Nothing
 950
 951 ----------------
 952 getConFieldNames new_name (ConDecl con _ _ (RecCon fielddecls) src_loc : rest)
 953   = mapRn (\n -> new_name n src_loc) (con:fields)       `thenRn` \ cfs ->
 954     getConFieldNames new_name rest                      `thenRn` \ ns  ->
 955     returnRn (cfs ++ ns)
 956   where
 957     fields = concat (map fst fielddecls)
 958
 959 getConFieldNames new_name (ConDecl con _ _ condecl src_loc : rest)
 960   = new_name con src_loc                `thenRn` \ n ->
 961     (case condecl of
 962       NewCon _ (Just f) ->
 963         new_name f src_loc `thenRn` \ new_f ->
 964         returnRn [n,new_f]
 965       _ -> returnRn [n])                `thenRn` \ nn ->
 966     getConFieldNames new_name rest      `thenRn` \ ns ->
 967     returnRn (nn ++ ns)
 968
 969 getConFieldNames new_name [] = returnRn []
 970
 971 getClassOpNames new_name (ClassOpSig op _ _ src_loc) = new_name op src_loc
 972 \end{code}
 973
 974 @getDeclSysBinders@ gets the implicit binders introduced by a decl.
 975 A the moment that's just the tycon and datacon that come with a class decl.
 976 They aren'te returned by getDeclBinders because they aren't in scope;
 977 but they *should* be put into the DeclsMap of this module.
 978
 979 \begin{code}
 980 getDeclSysBinders new_name (TyClD (ClassDecl _ cname _ sigs _ _ tname dname src_loc))
 981   = new_name dname src_loc                      `thenRn` \ datacon_name ->
 982     new_name tname src_loc                      `thenRn` \ tycon_name ->
 983     returnRn [tycon_name, datacon_name]
 984
 985 getDeclSysBinders new_name other_decl
 986   = returnRn []
 987 \end{code}
 988
 989 %*********************************************************
 990 %*                                                      *
 991 \subsection{Reading an interface file}
 992 %*                                                      *
 993 %*********************************************************
 994
 995 \begin{code}
 996 findAndReadIface :: SDoc -> Module -> RnMG (Maybe ParsedIface)
 997         -- Nothing <=> file not found, or unreadable, or illegible
 998         -- Just x  <=> successfully found and parsed
 999
1000 findAndReadIface doc_str mod_name
1001   = traceRn trace_msg                   `thenRn_`
1002       -- we keep two maps for interface files,
1003       -- one for 'normal' ones, the other for .hi-boot files,
1004       -- hence the need to signal which kind we're interested.
1005     getModuleHiMap from_hi_boot         `thenRn` \ himap ->
1006     case (lookupFM himap (moduleString mod_name)) of
1007          -- Found the file
1008        Just fpath -> readIface fpath
1009          -- Hack alert!  When compiling PrelBase we have to load the
1010          -- decls for packCString# and friends; they are 'thin-air' Ids
1011          -- (see PrelInfo.lhs).  So if we don't find the HiFile we quietly
1012          -- look for a .hi-boot file instead, and use that
1013        Nothing |  not from_hi_boot && mod_name `elem` thinAirModules
1014                -> findAndReadIface doc_str (mkBootModule mod_name)
1015                | otherwise
1016                -> traceRn (ptext SLIT("...failed"))     `thenRn_`
1017                   returnRn Nothing
1018   where
1019     hif          = moduleIfaceFlavour mod_name
1020     from_hi_boot = bootFlavour hif
1021
1022     trace_msg = sep [hsep [ptext SLIT("Reading"),
1023                            if from_hi_boot then ptext SLIT("[boot]") else empty,
1024                            ptext SLIT("interface for"),
1025                            pprModule mod_name <> semi],
1026                      nest 4 (ptext SLIT("reason:") <+> doc_str)]
1027 \end{code}
1028
1029 @readIface@ tries just the one file.
1030
1031 \begin{code}
1032 readIface :: String -> RnMG (Maybe ParsedIface)
1033         -- Nothing <=> file not found, or unreadable, or illegible
1034         -- Just x  <=> successfully found and parsed
1035 readIface file_path
1036   = ioToRnMG (hGetStringBuffer file_path)       `thenRn` \ read_result ->
1037     case read_result of
1038         Right contents    ->
1039              case parseIface contents (mkSrcLoc (mkFastString file_path) 1) of
1040                   Failed err      -> failWithRn Nothing err
1041                   Succeeded (PIface iface) ->
1042                         if opt_D_show_rn_imports then
1043                            putDocRn (hcat[ptext SLIT("Read "), text file_path]) `thenRn_`
1044                            returnRn (Just iface)
1045                         else
1046                            returnRn (Just iface)
1047
1048         Left err ->
1049           if isDoesNotExistError err then
1050              returnRn Nothing
1051           else
1052              failWithRn Nothing (cannaeReadFile file_path err)
1053 \end{code}
1054
1055 %*********************************************************
1056 %*                                                       *
1057 \subsection{Utils}
1058 %*                                                       *
1059 %*********************************************************
1060
1061 @mkSearchPath@ takes a string consisting of a colon-separated list
1062 of directories and corresponding suffixes, and turns it into a list
1063 of (directory, suffix) pairs.  For example:
1064
1065 \begin{verbatim}
1066  mkSearchPath "foo%.hi:.%.p_hi:baz%.mc_hi"
1067    = [("foo",".hi"),( ".", ".p_hi"), ("baz",".mc_hi")]
1068 \begin{verbatim}
1069
1070 \begin{code}
1071 mkSearchPath :: Maybe String -> SearchPath
1072 mkSearchPath Nothing = [(".",".hi")]
1073 mkSearchPath (Just s)
1074   = go s
1075   where
1076     go "" = []
1077     go s  =
1078       case span (/= '%') s of
1079        (dir,'%':rs) ->
1080          case span (/= ':') rs of
1081           (hisuf,_:rest) -> (dir,hisuf):go rest
1082           (hisuf,[])     -> [(dir,hisuf)]
1083 \end{code}
1084
1085 %*********************************************************
1086 %*                                                       *
1087 \subsection{Errors}
1088 %*                                                       *
1089 %*********************************************************
1090
1091 \begin{code}
1092 noIfaceErr filename
1093   = hcat [ptext SLIT("Could not find valid interface file "),
1094           quotes (pprModule filename)]
1095
1096 cannaeReadFile file err
1097   = hcat [ptext SLIT("Failed in reading file: "),
1098           text file,
1099           ptext SLIT("; error="),
1100           text (show err)]
1101
1102 getDeclErr name loc
1103   = sep [ptext SLIT("Failed to find interface decl for") <+> quotes (ppr name),
1104          ptext SLIT("needed at") <+> ppr loc]
1105
1106 getDeclWarn name loc
1107   = sep [ptext SLIT("Failed to find (optional) interface decl for") <+> quotes (ppr name),
1108          ptext SLIT("desired at") <+> ppr loc]
1109
1110 importDeclWarn mod name loc
1111   = sep [ptext SLIT("Compiler tried to import decl from interface file with same name as module."),
1112          ptext SLIT("(possible cause: module name clashes with interface file already in scope.)")
1113         ] $$
1114     hsep [ptext SLIT("Interface:"), quotes (pprModule mod), comma, ptext SLIT("name:"), quotes (ppr name),
1115           comma, ptext SLIT("desired at:"), ppr loc
1116          ]
1117
1118 \end{code}