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