ghc/compiler/rename/RnIfaces.lhs

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