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