loadInterface, loadInterfaceForName, loadWiredInHomeIface,
loadSrcInterface, loadSysInterface, loadOrphanModules,
findAndReadIface, readIface, -- Used when reading the module's old interface
- loadDecls, ifaceStats, discardDeclPrags,
+ loadDecls, -- Should move to TcIface and be renamed
initExternalPackageState,
- pprModIface, showIface -- Print the iface in Foo.hi
+ ifaceStats, pprModIface, showIface -- Print the iface in Foo.hi
) where
#include "HsVersions.h"
-import {-# SOURCE #-} TcIface( tcIfaceDecl, tcIfaceRule, tcIfaceInst )
+import {-# SOURCE #-} TcIface( tcIfaceDecl, tcIfaceRules, tcIfaceInst,
+ tcIfaceFamInst )
import DynFlags ( DynFlags(..), DynFlag( Opt_IgnoreInterfacePragmas ) )
import IfaceSyn ( IfaceDecl(..), IfaceConDecl(..), IfaceClassOp(..),
- IfaceConDecls(..), IfaceFamInst(..),
- IfaceIdInfo(..) )
+ IfaceConDecls(..), IfaceFamInst(..) )
import IfaceEnv ( newGlobalBinder, lookupIfaceTc )
import HscTypes ( ModIface(..), TyThing, IfaceExport, Usage(..),
Deprecs(..), Dependencies(..),
Fixity(..), FixityDirection(..), isMarkedStrict )
import TcRnMonad
import Type ( TyThing(..) )
-import Class ( classATs )
import PrelNames ( gHC_PRIM )
import PrelInfo ( ghcPrimExports )
import PrelRules ( builtinRules )
import Rules ( extendRuleBaseList, mkRuleBase )
import InstEnv ( emptyInstEnv, extendInstEnvList )
+import FamInstEnv ( emptyFamInstEnv, extendFamInstEnvList )
import Name ( Name {-instance NamedThing-}, getOccName,
nameModule, nameIsLocalOrFrom, isWiredInName )
import NameEnv
import OccName ( OccName, mkOccEnv, lookupOccEnv, mkClassTyConOcc,
mkClassDataConOcc, mkSuperDictSelOcc,
mkDataConWrapperOcc, mkDataConWorkerOcc,
- mkNewTyCoOcc, mkInstTyTcOcc, mkInstTyCoOcc )
+ mkNewTyCoOcc, mkInstTyCoOcc )
import SrcLoc ( importedSrcLoc )
import Maybes ( MaybeErr(..) )
import ErrUtils ( Message )
loadInterface :: SDoc -> Module -> WhereFrom
-> IfM lcl (MaybeErr Message ModIface)
+-- loadInterface looks in both the HPT and PIT for the required interface
+-- If not found, it loads it, and puts it in the PIT (always).
+
-- If it can't find a suitable interface file, we
-- a) modify the PackageIfaceTable to have an empty entry
-- (to avoid repeated complaints)
-- READ THE MODULE IN
; read_result <- findAndReadIface doc_str mod hi_boot_file
- ; dflags <- getDOpts
; case read_result of {
Failed err -> do
{ let fake_iface = emptyModIface mod
; returnM (Failed err) } ;
-- Found and parsed!
- Succeeded (iface, file_path) -- Sanity check:
+ Succeeded (iface, file_path) -- Sanity check:
| ImportBySystem <- from, -- system-importing...
modulePackageId (mi_module iface) == thisPackage dflags,
-- a home-package module...
-- If we do loadExport first the wrong info gets into the cache (unless we
-- explicitly tag each export which seems a bit of a bore)
- ; ignore_prags <- doptM Opt_IgnoreInterfacePragmas
- ; new_eps_decls <- loadDecls ignore_prags (mi_decls iface)
- ; new_eps_insts <- mapM tcIfaceInst (mi_insts iface)
- ; new_eps_rules <- if ignore_prags
- then return []
- else mapM tcIfaceRule (mi_rules iface)
+ ; ignore_prags <- doptM Opt_IgnoreInterfacePragmas
+ ; new_eps_decls <- loadDecls ignore_prags (mi_decls iface)
+ ; new_eps_insts <- mapM tcIfaceInst (mi_insts iface)
+ ; new_eps_fam_insts <- mapM tcIfaceFamInst (mi_fam_insts iface)
+ ; new_eps_rules <- tcIfaceRules ignore_prags (mi_rules iface)
; let { final_iface = iface { mi_decls = panic "No mi_decls in PIT",
mi_insts = panic "No mi_insts in PIT",
mi_rules = panic "No mi_rules in PIT" } }
; updateEps_ $ \ eps ->
- eps { eps_PIT = extendModuleEnv (eps_PIT eps) mod final_iface,
- eps_PTE = addDeclsToPTE (eps_PTE eps) new_eps_decls,
- eps_rule_base = extendRuleBaseList (eps_rule_base eps) new_eps_rules,
- eps_inst_env = extendInstEnvList (eps_inst_env eps) new_eps_insts,
- eps_stats = addEpsInStats (eps_stats eps) (length new_eps_decls)
- (length new_eps_insts) (length new_eps_rules) }
+ eps {
+ eps_PIT = extendModuleEnv (eps_PIT eps) mod final_iface,
+ eps_PTE = addDeclsToPTE (eps_PTE eps) new_eps_decls,
+ eps_rule_base = extendRuleBaseList (eps_rule_base eps)
+ new_eps_rules,
+ eps_inst_env = extendInstEnvList (eps_inst_env eps)
+ new_eps_insts,
+ eps_fam_inst_env = extendFamInstEnvList (eps_fam_inst_env eps)
+ new_eps_fam_insts,
+ eps_stats = addEpsInStats (eps_stats eps)
+ (length new_eps_decls)
+ (length new_eps_insts) (length new_eps_rules) }
; return (Succeeded final_iface)
}}}}
badDepMsg mod
= hang (ptext SLIT("Interface file inconsistency:"))
- 2 (sep [ptext SLIT("home-package module") <+> quotes (ppr mod) <+> ptext SLIT("is mentioned,"),
- ptext SLIT("but does not appear in the dependencies of the interface")])
+ 2 (sep [ptext SLIT("home-package module") <+> quotes (ppr mod) <+> ptext SLIT("is mentioned is needed,"),
+ ptext SLIT("but is not among the dependencies of interfaces directly imported by the module being compiled")])
-----------------------------------------------------
-- Loading type/class/value decls
(ifaceDeclSubBndrs decl)
-- Typecheck the thing, lazily
- -- NB. firstly, the laziness is there in case we never need the
+ -- NB. Firstly, the laziness is there in case we never need the
-- declaration (in one-shot mode), and secondly it is there so that
-- we don't look up the occurrence of a name before calling mk_new_bndr
-- on the binder. This is important because we must get the right name
-- which includes its nameParent.
- ; thing <- forkM doc (bumpDeclStats main_name >> tcIfaceDecl stripped_decl)
+
+ ; thing <- forkM doc $ do { bumpDeclStats main_name
+ ; tcIfaceDecl ignore_prags decl }
+
+ -- Populate the type environment with the implicitTyThings too
; let mini_env = mkOccEnv [(getOccName t, t) | t <- implicitTyThings thing]
lookup n = case lookupOccEnv mini_env (getOccName n) of
Just thing -> thing
Nothing ->
- pprPanic "loadDecl" (ppr main_name <+>
- ppr n $$ ppr (stripped_decl))
+ pprPanic "loadDecl" (ppr main_name <+> ppr n $$ ppr (decl))
; returnM $ (main_name, thing) : [(n, lookup n) | n <- implicit_names]
}
-- as the TyThings. That way we can extend the PTE without poking the
-- thunks
where
- stripped_decl | ignore_prags = discardDeclPrags decl
- | otherwise = decl
-
-- mk_new_bndr allocates in the name cache the final canonical
-- name for the thing, with the correct
-- * parent
(importedSrcLoc (showSDoc (ppr (moduleName mod))))
-- ToDo: qualify with the package name if necessary
- ifFamily (IfaceData {
- ifFamInst = Just (IfaceFamInst {ifFamInstTyCon = famTyCon})})
- = Just famTyCon
- ifFamily _ = Nothing
+ ifFamily (IfaceData {ifFamInst = Just (famTyCon, _)}) = Just famTyCon
+ ifFamily _ = Nothing
doc = ptext SLIT("Declaration for") <+> ppr (ifName decl)
-discardDeclPrags :: IfaceDecl -> IfaceDecl
-discardDeclPrags decl@(IfaceId {ifIdInfo = HasInfo _}) = decl { ifIdInfo = NoInfo }
-discardDeclPrags decl = decl
-
bumpDeclStats :: Name -> IfL () -- Record that one more declaration has actually been used
bumpDeclStats name
= do { traceIf (text "Loading decl for" <+> ppr name)
initExternalPackageState :: ExternalPackageState
initExternalPackageState
= EPS {
- eps_is_boot = emptyUFM,
- eps_PIT = emptyPackageIfaceTable,
- eps_PTE = emptyTypeEnv,
- eps_inst_env = emptyInstEnv,
- eps_rule_base = mkRuleBase builtinRules,
+ eps_is_boot = emptyUFM,
+ eps_PIT = emptyPackageIfaceTable,
+ eps_PTE = emptyTypeEnv,
+ eps_inst_env = emptyInstEnv,
+ eps_fam_inst_env = emptyFamInstEnv,
+ eps_rule_base = mkRuleBase builtinRules,
-- Initialise the EPS rule pool with the built-in rules
eps_stats = EpsStats { n_ifaces_in = 0, n_decls_in = 0, n_decls_out = 0
, n_insts_in = 0, n_insts_out = 0