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