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