ghc/compiler/rename/RnIfaces.lhs

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