ghc/compiler/rename/RnIfaces.lhs

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