ghc/compiler/rename/RnIfaces.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
   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-}, Provenance, OccName(..),
  46                           nameModule, moduleString, pprModule, isLocallyDefined,
  47                           NameSet(..), emptyNameSet, unionNameSets, nameSetToList,
  48                           minusNameSet, mkNameSet, elemNameSet, nameUnique, addOneToNameSet,
  49                           isWiredInName, maybeWiredInTyConName, maybeWiredInIdName,
  50                           NamedThing(..)
  51                          )
  52 import Id               ( GenId, Id(..), idType, dataConTyCon, isAlgCon )
  53 import TyCon            ( TyCon, tyConDataCons, isSynTyCon, getSynTyConDefn )
  54 import Type             ( namesOfType )
  55 import TyVar            ( GenTyVar )
  56 import SrcLoc           ( mkSrcLoc, SrcLoc )
  57 import PrelMods         ( pREL_GHC )
  58 import PrelInfo         ( cCallishTyKeys )
  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 \end{code}
  71
  72
  73
  74 %*********************************************************
  75 %*                                                      *
  76 \subsection{Statistics}
  77 %*                                                      *
  78 %*********************************************************
  79
  80 \begin{code}
  81 getRnStats :: [RenamedHsDecl] -> RnMG SDoc
  82 getRnStats all_decls
  83   = getIfacesRn                 `thenRn` \ ifaces ->
  84     let
  85         Ifaces this_mod mod_map decls_fm all_names imp_names (unslurped_insts,_) deferred_data_decls inst_mods = ifaces
  86         n_mods      = sizeFM mod_map
  87
  88         decls_imported = filter is_imported_decl all_decls
  89         decls_read     = [decl | (name, (_, avail, decl)) <- fmToList decls_fm,
  90                                  name == availName avail,
  91                                         -- Data, newtype, and class decls are in the decls_fm
  92                                         -- under multiple names; the tycon/class, and each
  93                                         -- constructor/class op too.
  94                                  not (isLocallyDefined name)
  95                              ]
  96
  97         (cd_rd, dd_rd, add_rd, nd_rd, and_rd, sd_rd, vd_rd,     _) = count_decls decls_read
  98         (cd_sp, dd_sp, add_sp, nd_sp, and_sp, sd_sp, vd_sp, id_sp) = count_decls decls_imported
  99
 100         inst_decls_unslurped  = length (bagToList unslurped_insts)
 101         inst_decls_read       = id_sp + inst_decls_unslurped
 102
 103         stats = vcat
 104                 [int n_mods <> text " interfaces read",
 105                  hsep [int cd_sp, text "class decls imported, out of",
 106                         int cd_rd, text "read"],
 107                  hsep [int dd_sp, text "data decls imported (of which", int add_sp, text "abstractly), out of",
 108                         int dd_rd, text "read"],
 109                  hsep [int nd_sp, text "newtype decls imported (of which", int and_sp, text "abstractly), out of",
 110                         int nd_rd, text "read"],
 111                  hsep [int sd_sp, text "type synonym decls imported, out of",
 112                         int sd_rd, text "read"],
 113                  hsep [int vd_sp, text "value signatures imported, out of",
 114                         int vd_rd, text "read"],
 115                  hsep [int id_sp, text "instance decls imported, out of",
 116                         int inst_decls_read, text "read"]
 117                 ]
 118     in
 119     returnRn (hcat [text "Renamer stats: ", stats])
 120
 121 is_imported_decl (DefD _) = False
 122 is_imported_decl (ValD _) = False
 123 is_imported_decl decl     = not (isLocallyDefined (hsDeclName decl))
 124
 125 count_decls decls
 126   = -- pprTrace "count_decls" (ppr  decls
 127     --
 128     --                      $$
 129     --                      text "========="
 130     --                      $$
 131     --                      ppr imported_decls
 132     --  ) $
 133     (class_decls,
 134      data_decls,    abstract_data_decls,
 135      newtype_decls, abstract_newtype_decls,
 136      syn_decls,
 137      val_decls,
 138      inst_decls)
 139   where
 140     class_decls   = length [() | ClD _                      <- decls]
 141     data_decls    = length [() | TyD (TyData DataType _ _ _ _ _ _ _) <- decls]
 142     newtype_decls = length [() | TyD (TyData NewType  _ _ _ _ _ _ _) <- decls]
 143     abstract_data_decls    = length [() | TyD (TyData DataType _ _ _ [] _ _ _) <- decls]
 144     abstract_newtype_decls = length [() | TyD (TyData NewType  _ _ _ [] _ _ _) <- decls]
 145     syn_decls     = length [() | TyD (TySynonym _ _ _ _)    <- decls]
 146     val_decls     = length [() | SigD _                     <- decls]
 147     inst_decls    = length [() | InstD _                    <- decls]
 148
 149 \end{code}
 150
 151 %*********************************************************
 152 %*                                                      *
 153 \subsection{Loading a new interface file}
 154 %*                                                      *
 155 %*********************************************************
 156
 157 \begin{code}
 158 loadInterface :: SDoc -> Module -> IfaceFlavour -> RnMG Ifaces
 159 loadInterface doc_str load_mod as_source
 160  = getIfacesRn          `thenRn` \ ifaces ->
 161    let
 162         Ifaces this_mod mod_map decls
 163                all_names imp_names (insts, tycls_names)
 164                deferred_data_decls inst_mods = ifaces
 165    in
 166         -- CHECK WHETHER WE HAVE IT ALREADY
 167    case lookupFM mod_map load_mod of {
 168         Just (hif, _, _, _) | hif `as_good_as` as_source
 169                             ->  -- Already in the cache; don't re-read it
 170                                 returnRn ifaces ;
 171         other ->
 172
 173         -- READ THE MODULE IN
 174    findAndReadIface doc_str load_mod as_source  `thenRn` \ read_result ->
 175    case read_result of {
 176         -- Check for not found
 177         Nothing ->      -- Not found, so add an empty export env to the Ifaces map
 178                         -- so that we don't look again
 179                    let
 180                         new_mod_map = addToFM mod_map load_mod (HiFile, 0, [],[])
 181                         new_ifaces = Ifaces this_mod new_mod_map
 182                                             decls all_names imp_names (insts, tycls_names)
 183                                             deferred_data_decls inst_mods
 184                    in
 185                    setIfacesRn new_ifaces               `thenRn_`
 186                    failWithRn new_ifaces (noIfaceErr load_mod) ;
 187
 188         -- Found and parsed!
 189         Just (ParsedIface _ mod_vers usages exports rd_inst_mods fixs rd_decls rd_insts) ->
 190
 191         -- LOAD IT INTO Ifaces
 192         -- NB: *first* we do loadDecl, so that the provenance of all the locally-defined
 193         ---    names is done correctly (notably, whether this is an .hi file or .hi-boot file).
 194         --     If we do loadExport first the wrong info gets into the cache (unless we
 195         --      explicitly tag each export which seems a bit of a bore)
 196     foldlRn (loadDecl load_mod as_source) decls rd_decls `thenRn` \ new_decls ->
 197     mapRn loadExport exports                             `thenRn` \ avails_s ->
 198     foldlRn (loadInstDecl load_mod) insts rd_insts       `thenRn` \ new_insts ->
 199     let
 200          mod_details = (as_source, mod_vers, concat avails_s, fixs)
 201
 202                         -- Exclude this module from the "special-inst" modules
 203          new_inst_mods = inst_mods `unionLists` (filter (/= this_mod) rd_inst_mods)
 204
 205          new_ifaces = Ifaces this_mod
 206                              (addToFM mod_map load_mod mod_details)
 207                              new_decls
 208                              all_names imp_names
 209                              (new_insts, tycls_names)
 210                              deferred_data_decls
 211                              new_inst_mods
 212     in
 213     setIfacesRn new_ifaces              `thenRn_`
 214     returnRn new_ifaces
 215     }}
 216
 217 as_good_as HiFile any        = True
 218 as_good_as any    HiBootFile = True
 219 as_good_as _      _          = False
 220
 221
 222 loadExport :: ExportItem -> RnMG [AvailInfo]
 223 loadExport (mod, hif, entities)
 224   = mapRn load_entity entities
 225   where
 226     new_name occ = newImportedGlobalName mod occ hif
 227
 228     load_entity (Avail occ)
 229       = new_name occ            `thenRn` \ name ->
 230         returnRn (Avail name)
 231     load_entity (AvailTC occ occs)
 232       = new_name occ            `thenRn` \ name ->
 233         mapRn new_name occs     `thenRn` \ names ->
 234         returnRn (AvailTC name names)
 235
 236 loadDecl :: Module
 237          -> IfaceFlavour
 238          -> DeclsMap
 239          -> (Version, RdrNameHsDecl)
 240          -> RnMG DeclsMap
 241 loadDecl mod as_source decls_map (version, decl)
 242   = getDeclBinders new_implicit_name decl       `thenRn` \ avail ->
 243     returnRn (addListToFM decls_map
 244                           [(name,(version,avail,decl')) | name <- availNames avail]
 245     )
 246   where
 247     {-
 248       If a signature decl is being loaded and we're ignoring interface pragmas,
 249       toss away unfolding information.
 250
 251       Also, if the signature is loaded from a module we're importing from source,
 252       we do the same. This is to avoid situations when compiling a pair of mutually
 253       recursive modules, peering at unfolding info in the interface file of the other,
 254       e.g., you compile A, it looks at B's interface file and may as a result change
 255       it's interface file. Hence, B is recompiled, maybe changing it's interface file,
 256       which will the ufolding info used in A to become invalid. Simple way out is to
 257       just ignore unfolding info.
 258     -}
 259     decl' =
 260      case decl of
 261        SigD (IfaceSig name tp ls loc) | from_hi_boot || opt_IgnoreIfacePragmas ->
 262             SigD (IfaceSig name tp [] loc)
 263        _ -> decl
 264
 265     new_implicit_name rdr_name loc = newImportedGlobalName mod (rdrNameOcc rdr_name) as_source
 266
 267     from_hi_boot = case as_source of
 268                         HiBootFile -> True
 269                         other      -> False
 270
 271 loadInstDecl :: Module
 272              -> Bag IfaceInst
 273              -> RdrNameInstDecl
 274              -> RnMG (Bag IfaceInst)
 275 loadInstDecl mod_name insts decl@(InstDecl inst_ty binds uprags dfun_name src_loc)
 276   =
 277         -- Find out what type constructors and classes are "gates" for the
 278         -- instance declaration.  If all these "gates" are slurped in then
 279         -- we should slurp the instance decl too.
 280         --
 281         -- We *don't* want to count names in the context part as gates, though.
 282         -- For example:
 283         --              instance Foo a => Baz (T a) where ...
 284         --
 285         -- Here the gates are Baz and T, but *not* Foo.
 286     let
 287         munged_inst_ty = case inst_ty of
 288                                 HsForAllTy tvs cxt ty -> HsForAllTy tvs [] ty
 289                                 HsPreForAllTy cxt ty  -> HsPreForAllTy [] 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           pprTrace "importDecl wierdness:" (ppr name) $
 423           returnRn Nothing         -- the renamed module's own interface file
 424                                    --
 425        else
 426        getNonWiredInDecl name loc mode
 427 \end{code}
 428
 429 \begin{code}
 430 getNonWiredInDecl :: Name -> SrcLoc -> RnSMode -> RnMG (Maybe RdrNameHsDecl)
 431 getNonWiredInDecl needed_name loc mode
 432   = traceRn doc_str                                      `thenRn_`
 433     loadInterface doc_str mod (ifaceFlavour needed_name) `thenRn` \ (Ifaces _ _ decls _ _ _ _ _) ->
 434     case lookupFM decls needed_name of
 435
 436         -- Special case for data/newtype type declarations
 437       Just (version, avail, TyD ty_decl) | is_data_or_newtype ty_decl
 438               -> getNonWiredDataDecl needed_name version avail ty_decl  `thenRn` \ (avail', maybe_decl) ->
 439                  recordSlurp (Just version) necessity avail'    `thenRn_`
 440                  returnRn maybe_decl
 441
 442       Just (version,avail,decl)
 443               -> recordSlurp (Just version) necessity avail     `thenRn_`
 444                  returnRn (Just decl)
 445
 446       Nothing ->        -- Can happen legitimately for "Optional" occurrences
 447                    case necessity of {
 448                                 Optional -> addWarnRn (getDeclWarn needed_name loc);
 449                                 other    -> addErrRn  (getDeclErr  needed_name loc)
 450                    }                                            `thenRn_`
 451                    returnRn Nothing
 452   where
 453      necessity = modeToNecessity mode
 454      doc_str = sep [ptext SLIT("need decl for"), ppr needed_name, ptext SLIT("needed at"), ppr loc]
 455      mod = nameModule needed_name
 456
 457      is_data_or_newtype (TyData _ _ _ _ _ _ _ _) = True
 458      is_data_or_newtype other                    = False
 459
 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               | (isAlgCon the_id)               -- ... a wired-in data constructor
 529               = get_wired_tycon (dataConTyCon the_id)
 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
 541
 542 get_wired_id id
 543   = addImplicitOccsRn id_mentions       `thenRn_`
 544     returnRn (Avail (getName id))
 545   where
 546     id_mentions = nameSetToList (namesOfType ty)
 547     ty = idType id
 548
 549 get_wired_tycon tycon
 550   | isSynTyCon tycon
 551   = addImplicitOccsRn (nameSetToList mentioned)         `thenRn_`
 552     returnRn (AvailTC tc_name [tc_name])
 553   where
 554     tc_name     = getName tycon
 555     (tyvars,ty) = getSynTyConDefn tycon
 556     mentioned   = namesOfType ty `minusNameSet` mkNameSet (map getName tyvars)
 557
 558 get_wired_tycon tycon
 559   | otherwise           -- data or newtype
 560   = addImplicitOccsRn (nameSetToList mentioned)         `thenRn_`
 561     returnRn (AvailTC tycon_name (tycon_name : map getName data_cons))
 562   where
 563     tycon_name = getName tycon
 564     data_cons  = tyConDataCons tycon
 565     mentioned  = foldr (unionNameSets . namesOfType . idType) emptyNameSet data_cons
 566 \end{code}
 567
 568
 569
 570 %*********************************************************
 571 %*                                                      *
 572 \subsection{Getting what a module exports}
 573 %*                                                      *
 574 %*********************************************************
 575
 576 \begin{code}
 577 getInterfaceExports :: Module -> IfaceFlavour -> RnMG (Avails, [(OccName,Fixity)])
 578 getInterfaceExports mod as_source
 579   = loadInterface doc_str mod as_source `thenRn` \ (Ifaces _ mod_map _ _ _ _ _ _) ->
 580     case lookupFM mod_map mod of
 581         Nothing ->      -- Not there; it must be that the interface file wasn't found;
 582                         -- the error will have been reported already.
 583                         -- (Actually loadInterface should put the empty export env in there
 584                         --  anyway, but this does no harm.)
 585                       returnRn ([],[])
 586
 587         Just (_, _, avails, fixities) -> returnRn (avails, fixities)
 588   where
 589     doc_str = sep [pprModule mod, ptext SLIT("is directly imported")]
 590 \end{code}
 591
 592
 593 %*********************************************************
 594 %*                                                      *
 595 \subsection{Data type declarations are handled specially}
 596 %*                                                      *
 597 %*********************************************************
 598
 599 Data type declarations get special treatment.  If we import a data type decl
 600 with all its constructors, we end up importing all the types mentioned in
 601 the constructors' signatures, and hence {\em their} data type decls, and so on.
 602 In effect, we get the transitive closure of data type decls.  Worse, this drags
 603 in tons on instance decls, and their unfoldings, and so on.
 604
 605 If only the type constructor is mentioned, then all this is a waste of time.
 606 If any of the data constructors are mentioned then we really have to
 607 drag in the whole declaration.
 608
 609 So when we import the type constructor for a @data@ or @newtype@ decl, we
 610 put it in the "deferred data/newtype decl" pile in Ifaces.  Right at the end
 611 we slurp these decls, if they havn't already been dragged in by an occurrence
 612 of a constructor.
 613
 614 \begin{code}
 615 getNonWiredDataDecl needed_name
 616                     version
 617                     avail@(AvailTC tycon_name _)
 618                     ty_decl@(TyData new_or_data context tycon tyvars condecls derivings pragmas src_loc)
 619   |  needed_name == tycon_name
 620   && opt_PruneTyDecls
 621   && not (nameUnique needed_name `elem` cCallishTyKeys)
 622         -- Hack!  Don't prune these tycons whose constructors
 623         -- the desugarer must be able to see when desugaring
 624         -- a CCall.  Ugh!
 625
 626   =     -- Need the type constructor; so put it in the deferred set for now
 627     getIfacesRn                 `thenRn` \ ifaces ->
 628     let
 629         Ifaces this_mod mod_map decls_fm slurped_names imp_names
 630                unslurped_insts deferred_data_decls inst_mods = ifaces
 631
 632         new_ifaces = Ifaces this_mod mod_map decls_fm slurped_names imp_names
 633                             unslurped_insts new_deferred_data_decls inst_mods
 634
 635         no_constr_ty_decl       = TyData new_or_data [] tycon tyvars [] derivings pragmas src_loc
 636         new_deferred_data_decls = addToFM deferred_data_decls tycon_name no_constr_ty_decl
 637                 -- Nota bene: we nuke both the constructors and the context in the deferred decl.
 638                 -- If we don't nuke the context then renaming the deferred data decls can give
 639                 -- new unresolved names (for the classes).  This could be handled, but there's
 640                 -- no point.  If the data type is completely abstract then we aren't interested
 641                 -- its context.
 642     in
 643     setIfacesRn new_ifaces      `thenRn_`
 644     returnRn (AvailTC tycon_name [tycon_name], Nothing)
 645
 646   | otherwise
 647   =     -- Need a data constructor, so delete the data decl from the deferred set if it's there
 648     getIfacesRn                 `thenRn` \ ifaces ->
 649     let
 650         Ifaces this_mod mod_map decls_fm slurped_names imp_names
 651                unslurped_insts deferred_data_decls inst_mods = ifaces
 652
 653         new_ifaces = Ifaces this_mod mod_map decls_fm slurped_names imp_names
 654                             unslurped_insts new_deferred_data_decls inst_mods
 655
 656         new_deferred_data_decls = delFromFM deferred_data_decls tycon_name
 657     in
 658     setIfacesRn new_ifaces      `thenRn_`
 659     returnRn (avail, Just (TyD ty_decl))
 660 \end{code}
 661
 662 \begin{code}
 663 getDeferredDataDecls :: RnMG [(Name, RdrNameTyDecl)]
 664 getDeferredDataDecls
 665   = getIfacesRn                 `thenRn` \ (Ifaces _ _ _ _ _ _ deferred_data_decls _) ->
 666     let
 667         deferred_list = fmToList deferred_data_decls
 668         trace_msg = hang (text "Slurping abstract data/newtype decls for: ")
 669                         4 (ppr (map fst deferred_list))
 670     in
 671     traceRn trace_msg                   `thenRn_`
 672     returnRn deferred_list
 673 \end{code}
 674
 675
 676 %*********************************************************
 677 %*                                                      *
 678 \subsection{Instance declarations are handled specially}
 679 %*                                                      *
 680 %*********************************************************
 681
 682 \begin{code}
 683 getImportedInstDecls :: RnMG [(Module,RdrNameInstDecl)]
 684 getImportedInstDecls
 685   =     -- First load any special-instance modules that aren't aready loaded
 686     getSpecialInstModules                       `thenRn` \ inst_mods ->
 687     mapRn load_it inst_mods                     `thenRn_`
 688
 689         -- Now we're ready to grab the instance declarations
 690         -- Find the un-gated ones and return them,
 691         -- removing them from the bag kept in Ifaces
 692     getIfacesRn         `thenRn` \ ifaces ->
 693     let
 694         Ifaces this_mod mod_map decls slurped_names imp_names (insts, tycls_names) deferred_data_decls inst_mods = ifaces
 695
 696                 -- An instance decl is ungated if all its gates have been slurped
 697         select_ungated :: IfaceInst                                     -- A gated inst decl
 698
 699                        -> ([(Module, RdrNameInstDecl)], [IfaceInst])    -- Accumulator
 700
 701                        -> ([(Module, RdrNameInstDecl)],                 -- The ungated ones
 702                            [IfaceInst])                                 -- Still gated, but with
 703                                                                         -- depeleted gates
 704         select_ungated (decl,gates) (ungated_decls, gated_decls)
 705           | null remaining_gates
 706           = (decl : ungated_decls, gated_decls)
 707           | otherwise
 708           = (ungated_decls, (decl, remaining_gates) : gated_decls)
 709           where
 710             remaining_gates = filter (not . (`elemNameSet` tycls_names)) gates
 711
 712         (un_gated_insts, still_gated_insts) = foldrBag select_ungated ([], []) insts
 713
 714         new_ifaces = Ifaces this_mod mod_map decls slurped_names imp_names
 715                             ((listToBag still_gated_insts), tycls_names)
 716                                 -- NB: don't throw away tycls_names; we may comre across more instance decls
 717                             deferred_data_decls
 718                             inst_mods
 719     in
 720     traceRn (sep [text "getInstDecls:", fsep (map ppr (nameSetToList tycls_names))])    `thenRn_`
 721     setIfacesRn new_ifaces      `thenRn_`
 722     returnRn un_gated_insts
 723   where
 724     load_it mod = loadInterface (doc_str mod) mod HiFile
 725     doc_str mod = sep [pprModule mod, ptext SLIT("is a special-instance module")]
 726
 727
 728 getSpecialInstModules :: RnMG [Module]
 729 getSpecialInstModules
 730   = getIfacesRn                                         `thenRn` \ ifaces ->
 731     let
 732          Ifaces _ _ _ _ _ _ _ inst_mods = ifaces
 733     in
 734     returnRn inst_mods
 735 \end{code}
 736
 737
 738 %*********************************************************
 739 %*                                                      *
 740 \subsection{Keeping track of what we've slurped, and version numbers}
 741 %*                                                      *
 742 %*********************************************************
 743
 744 getImportVersions figures out what the "usage information" for this moudule is;
 745 that is, what it must record in its interface file as the things it uses.
 746 It records:
 747         - anything reachable from its body code
 748         - any module exported with a "module Foo".
 749
 750 Why the latter?  Because if Foo changes then this module's export list
 751 will change, so we must recompile this module at least as far as
 752 making a new interface file --- but in practice that means complete
 753 recompilation.
 754
 755 What about this?
 756         module A( f, g ) where          module B( f ) where
 757           import B( f )                   f = h 3
 758           g = ...                         h = ...
 759
 760 Should we record B.f in A's usages?  In fact we don't.  Certainly, if
 761 anything about B.f changes than anyone who imports A should be recompiled;
 762 they'll get an early exit if they don't use B.f.  However, even if B.f
 763 doesn't change at all, B.h may do so, and this change may not be reflected
 764 in f's version number.  So there are two things going on when compiling module A:
 765
 766 1.  Are A.o and A.hi correct?  Then we can bale out early.
 767 2.  Should modules that import A be recompiled?
 768
 769 For (1) it is slightly harmful to record B.f in A's usages, because a change in
 770 B.f's version will provoke full recompilation of A, producing an identical A.o,
 771 and A.hi differing only in its usage-version of B.f (which isn't used by any importer).
 772
 773 For (2), because of the tricky B.h question above, we ensure that A.hi is touched
 774 (even if identical to its previous version) if A's recompilation was triggered by
 775 an imported .hi file date change.  Given that, there's no need to record B.f in
 776 A's usages.
 777
 778 On the other hand, if A exports "module B" then we *do* count module B among
 779 A's usages, because we must recompile A to ensure that A.hi changes appropriately.
 780
 781 \begin{code}
 782 getImportVersions :: Module                     -- Name of this module
 783                   -> Maybe [IE any]             -- Export list for this module
 784                   -> RnMG (VersionInfo Name)    -- Version info for these names
 785
 786 getImportVersions this_mod exports
 787   = getIfacesRn                                 `thenRn` \ ifaces ->
 788     let
 789          Ifaces _ mod_map _ _ imp_names _ _ _ = ifaces
 790
 791          -- mv_map groups together all the things imported from a particular module.
 792          mv_map, mv_map_mod :: FiniteMap Module (WhatsImported Name)
 793
 794          mv_map_mod = foldl add_mod emptyFM export_mods
 795                 -- mv_map_mod records all the modules that have a "module M"
 796                 -- in this module's export list with an "Everything"
 797
 798          mv_map = foldl add_mv mv_map_mod imp_names
 799                 -- mv_map adds the version numbers of things exported individually
 800
 801          mk_version_info (mod, local_versions)
 802            = case lookupFM mod_map mod of
 803                 Just (hif, version, _, _) -> (mod, hif, version, local_versions)
 804     in
 805     returnRn (map mk_version_info (fmToList mv_map))
 806   where
 807      export_mods = case exports of
 808                         Nothing -> []
 809                         Just es -> [mod | IEModuleContents mod <- es, mod /= this_mod]
 810
 811      add_mv mv_map v@(name, version)
 812       = addToFM_C add_item mv_map mod (Specifically [v])
 813         where
 814          mod = nameModule name
 815
 816          add_item Everything        _ = Everything
 817          add_item (Specifically xs) _ = Specifically (v:xs)
 818
 819      add_mod mv_map mod = addToFM mv_map mod Everything
 820 \end{code}
 821
 822 \begin{code}
 823 checkSlurped name
 824   = getIfacesRn         `thenRn` \ (Ifaces _ _ _ slurped_names _ _ _ _) ->
 825     returnRn (name `elemNameSet` slurped_names)
 826
 827 getSlurpedNames :: RnMG NameSet
 828 getSlurpedNames
 829   = getIfacesRn         `thenRn` \ ifaces ->
 830     let
 831          Ifaces _ _ _ slurped_names _ _ _ _ = ifaces
 832     in
 833     returnRn slurped_names
 834
 835 recordSlurp maybe_version necessity avail
 836   = {- traceRn (hsep [text "Record slurp:", pprAvail avail,
 837                                         -- NB PprForDebug prints export flag, which is too
 838                                         -- strict; it's a knot-tied thing in RnNames
 839                   case necessity of {Compulsory -> text "comp"; Optional -> text "opt" } ])     `thenRn_`
 840     -}
 841     getIfacesRn         `thenRn` \ ifaces ->
 842     let
 843         Ifaces this_mod mod_map decls slurped_names imp_names
 844                (insts, tycls_names) deferred_data_decls inst_mods = ifaces
 845
 846         new_slurped_names = addAvailToNameSet slurped_names avail
 847
 848         new_imp_names = case maybe_version of
 849                            Just version -> (availName avail, version) : imp_names
 850                            Nothing      -> imp_names
 851
 852                 -- Add to the names that will let in instance declarations;
 853                 -- but only (a) if it's a type/class
 854                 --          (b) if it's compulsory (unless the test flag opt_PruneInstDecls is off)
 855         new_tycls_names = case avail of
 856                                 AvailTC tc _  | not opt_PruneInstDecls ||
 857                                                 case necessity of {Optional -> False; Compulsory -> True }
 858                                               -> tycls_names `addOneToNameSet` tc
 859                                 otherwise     -> tycls_names
 860
 861         new_ifaces = Ifaces this_mod mod_map decls
 862                             new_slurped_names
 863                             new_imp_names
 864                             (insts, new_tycls_names)
 865                             deferred_data_decls
 866                             inst_mods
 867     in
 868     setIfacesRn new_ifaces
 869 \end{code}
 870
 871
 872 %*********************************************************
 873 %*                                                      *
 874 \subsection{Getting binders out of a declaration}
 875 %*                                                      *
 876 %*********************************************************
 877
 878 @getDeclBinders@ returns the names for a @RdrNameHsDecl@.
 879 It's used for both source code (from @availsFromDecl@) and interface files
 880 (from @loadDecl@).
 881
 882 It doesn't deal with source-code specific things: ValD, DefD.  They
 883 are handled by the sourc-code specific stuff in RnNames.
 884
 885 \begin{code}
 886 getDeclBinders :: (RdrName -> SrcLoc -> RnMG Name)      -- New-name function
 887                 -> RdrNameHsDecl
 888                 -> RnMG AvailInfo
 889
 890 getDeclBinders new_name (TyD (TyData _ _ tycon _ condecls _ _ src_loc))
 891   = new_name tycon src_loc                      `thenRn` \ tycon_name ->
 892     getConFieldNames new_name condecls          `thenRn` \ sub_names ->
 893     returnRn (AvailTC tycon_name (tycon_name : nub sub_names))
 894         -- The "nub" is because getConFieldNames can legitimately return duplicates,
 895         -- when a record declaration has the same field in multiple constructors
 896
 897 getDeclBinders new_name (TyD (TySynonym tycon _ _ src_loc))
 898   = new_name tycon src_loc              `thenRn` \ tycon_name ->
 899     returnRn (AvailTC tycon_name [tycon_name])
 900
 901 getDeclBinders new_name (ClD (ClassDecl _ cname _ sigs _ _ tname dname src_loc))
 902   = new_name cname src_loc                      `thenRn` \ class_name ->
 903     new_name dname src_loc                      `thenRn` \ datacon_name ->
 904     new_name tname src_loc                      `thenRn` \ tycon_name ->
 905
 906         -- Record the names for the class ops
 907     mapRn (getClassOpNames new_name) sigs       `thenRn` \ sub_names ->
 908
 909     returnRn (AvailTC class_name (class_name : datacon_name : tycon_name : sub_names))
 910
 911 getDeclBinders new_name (SigD (IfaceSig var ty prags src_loc))
 912   = new_name var src_loc                        `thenRn` \ var_name ->
 913     returnRn (Avail var_name)
 914
 915 getDeclBinders new_name (DefD _)  = returnRn NotAvailable
 916 getDeclBinders new_name (InstD _) = returnRn NotAvailable
 917
 918 ----------------
 919 getConFieldNames new_name (ConDecl con _ (RecCon fielddecls) src_loc : rest)
 920   = mapRn (\n -> new_name n src_loc) (con:fields)       `thenRn` \ cfs ->
 921     getConFieldNames new_name rest                      `thenRn` \ ns  ->
 922     returnRn (cfs ++ ns)
 923   where
 924     fields = concat (map fst fielddecls)
 925
 926 getConFieldNames new_name (ConDecl con _ _ src_loc : rest)
 927   = new_name con src_loc                `thenRn` \ n ->
 928     getConFieldNames new_name rest      `thenRn` \ ns ->
 929     returnRn (n:ns)
 930
 931 getConFieldNames new_name [] = returnRn []
 932
 933 getClassOpNames new_name (ClassOpSig op _ _ src_loc) = new_name op src_loc
 934 \end{code}
 935
 936
 937 %*********************************************************
 938 %*                                                      *
 939 \subsection{Reading an interface file}
 940 %*                                                      *
 941 %*********************************************************
 942
 943 \begin{code}
 944 findAndReadIface :: SDoc -> Module
 945                  -> IfaceFlavour
 946                  -> RnMG (Maybe ParsedIface)
 947         -- Nothing <=> file not found, or unreadable, or illegible
 948         -- Just x  <=> successfully found and parsed
 949 findAndReadIface doc_str mod_name as_source
 950   = traceRn trace_msg                   `thenRn_`
 951     getSearchPathRn                     `thenRn` \ dirs ->
 952     try dirs dirs
 953   where
 954     trace_msg = sep [hsep [ptext SLIT("Reading"),
 955                            case as_source of { HiBootFile -> ptext SLIT("[boot]"); other -> empty},
 956                            ptext SLIT("interface for"),
 957                            ptext mod_name <> semi],
 958                      nest 4 (ptext SLIT("reason:") <+> doc_str)]
 959
 960         -- For import {-# SOURCE #-} Foo, "as_source" will be True
 961         -- and we read Foo.hi-boot, not Foo.hi.  This is used to break
 962         -- loops among modules.
 963     mod_suffix hi = case as_source of
 964                         HiBootFile -> ".hi-boot" -- Ignore `ways' for boot files.
 965                         HiFile     -> hi
 966
 967     try all_dirs [] = traceRn (ptext SLIT("...failed")) `thenRn_`
 968                       returnRn Nothing
 969
 970     try all_dirs ((dir,hisuf):dirs)
 971         = readIface file_path   `thenRn` \ read_result ->
 972           case read_result of
 973               Nothing    -> try all_dirs dirs
 974               Just iface -> traceRn (ptext SLIT("...done"))     `thenRn_`
 975                             returnRn (Just iface)
 976         where
 977           file_path = dir ++ '/' : moduleString mod_name ++ (mod_suffix hisuf)
 978 \end{code}
 979
 980 @readIface@ tries just the one file.
 981
 982 \begin{code}
 983 readIface :: String -> RnMG (Maybe ParsedIface)
 984         -- Nothing <=> file not found, or unreadable, or illegible
 985         -- Just x  <=> successfully found and parsed
 986 readIface file_path
 987   = ioToRnMG (hGetStringBuffer file_path)       `thenRn` \ read_result ->
 988     case read_result of
 989         Right contents    ->
 990              case parseIface contents (mkSrcLoc (mkFastString file_path) 1) of
 991                   Failed err      -> failWithRn Nothing err
 992                   Succeeded (PIface iface) ->
 993                         if opt_D_show_rn_imports then
 994                            putDocRn (hcat[ptext SLIT("Read "), text file_path]) `thenRn_`
 995                            returnRn (Just iface)
 996                         else
 997                            returnRn (Just iface)
 998
 999         Left err ->
1000           if isDoesNotExistError err then
1001              returnRn Nothing
1002           else
1003              failWithRn Nothing (cannaeReadFile file_path err)
1004 \end{code}
1005
1006 %*********************************************************
1007 %*                                                       *
1008 \subsection{Utils}
1009 %*                                                       *
1010 %*********************************************************
1011
1012 @mkSearchPath@ takes a string consisting of a colon-separated list
1013 of directories and corresponding suffixes, and turns it into a list
1014 of (directory, suffix) pairs.  For example:
1015
1016 \begin{verbatim}
1017  mkSearchPath "foo%.hi:.%.p_hi:baz%.mc_hi"
1018    = [("foo",".hi"),( ".", ".p_hi"), ("baz",".mc_hi")]
1019 \begin{verbatim}
1020
1021 \begin{code}
1022 mkSearchPath :: Maybe String -> SearchPath
1023 mkSearchPath Nothing = [(".",".hi")]
1024 mkSearchPath (Just s)
1025   = go s
1026   where
1027     go "" = []
1028     go s  =
1029       case span (/= '%') s of
1030        (dir,'%':rs) ->
1031          case span (/= ':') rs of
1032           (hisuf,_:rest) -> (dir,hisuf):go rest
1033           (hisuf,[])     -> [(dir,hisuf)]
1034 \end{code}
1035
1036 %*********************************************************
1037 %*                                                       *
1038 \subsection{Errors}
1039 %*                                                       *
1040 %*********************************************************
1041
1042 \begin{code}
1043 noIfaceErr filename
1044   = hcat [ptext SLIT("Could not find valid interface file "),
1045           quotes (pprModule filename)]
1046
1047 cannaeReadFile file err
1048   = hcat [ptext SLIT("Failed in reading file: "),
1049            text file,
1050           ptext SLIT("; error="),
1051            text (show err)]
1052
1053 getDeclErr name loc
1054   = sep [ptext SLIT("Failed to find interface decl for"),
1055          quotes (ppr name), ptext SLIT("needed at"), ppr loc]
1056
1057 getDeclWarn name loc
1058   = sep [ptext SLIT("Warning: failed to find (optional) interface decl for"),
1059          quotes (ppr name), ptext SLIT("desired at"), ppr loc]
1060 \end{code}