X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fiface%2FLoadIface.lhs;h=0dbb17eb4e8e78b4fc548c1f94fe91fa74606eec;hb=84f4c1dfb0c39c5b48a8b960fc82ab10aeb10c84;hp=ba72c25d528ce559bd5ded296ad8e9e416261bae;hpb=0cb269be72ffe42498c74d5be845eb27d8818423;p=ghc-hetmet.git diff --git a/compiler/iface/LoadIface.lhs b/compiler/iface/LoadIface.lhs index ba72c25..0dbb17e 100644 --- a/compiler/iface/LoadIface.lhs +++ b/compiler/iface/LoadIface.lhs @@ -8,20 +8,20 @@ module LoadIface ( 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 ) import DynFlags ( DynFlags(..), DynFlag( Opt_IgnoreInterfacePragmas ) ) import IfaceSyn ( IfaceDecl(..), IfaceConDecl(..), IfaceClassOp(..), - IfaceConDecls(..), IfaceIdInfo(..) ) -import IfaceEnv ( newGlobalBinder ) + IfaceConDecls(..), IfaceFamInst(..) ) +import IfaceEnv ( newGlobalBinder, lookupIfaceTc ) import HscTypes ( ModIface(..), TyThing, IfaceExport, Usage(..), Deprecs(..), Dependencies(..), emptyModIface, EpsStats(..), GenAvailInfo(..), @@ -36,7 +36,6 @@ import BasicTypes ( Version, initialVersion, Fixity(..), FixityDirection(..), isMarkedStrict ) import TcRnMonad import Type ( TyThing(..) ) -import Class ( classATs ) import PrelNames ( gHC_PRIM ) import PrelInfo ( ghcPrimExports ) @@ -51,7 +50,7 @@ import Module import OccName ( OccName, mkOccEnv, lookupOccEnv, mkClassTyConOcc, mkClassDataConOcc, mkSuperDictSelOcc, mkDataConWrapperOcc, mkDataConWorkerOcc, - mkNewTyCoOcc, mkInstTyTcOcc, mkInstTyCoOcc ) + mkNewTyCoOcc, mkInstTyCoOcc ) import SrcLoc ( importedSrcLoc ) import Maybes ( MaybeErr(..) ) import ErrUtils ( Message ) @@ -157,6 +156,9 @@ loadSysInterface doc mod_name 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) @@ -195,7 +197,6 @@ loadInterface doc_str mod from -- 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 @@ -208,7 +209,7 @@ loadInterface doc_str mod from ; 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... @@ -241,9 +242,7 @@ loadInterface doc_str mod from ; 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) + ; 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", @@ -262,8 +261,8 @@ loadInterface doc_str mod from 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 @@ -290,31 +289,37 @@ loadDecls ignore_prags ver_decls ; return (concat thingss) } -loadDecl :: Bool -- Don't load pragmas into the decl pool +loadDecl :: Bool -- Don't load pragmas into the decl pool -> Module -> (Version, IfaceDecl) - -> IfL [(Name,TyThing)] -- The list can be poked eagerly, but the - -- TyThings are forkM'd thunks + -> IfL [(Name,TyThing)] -- The list can be poked eagerly, but the + -- TyThings are forkM'd thunks loadDecl ignore_prags mod (_version, decl) = do { -- Populate the name cache with final versions of all -- the names associated with the decl main_name <- mk_new_bndr mod Nothing (ifName decl) - ; implicit_names <- mapM (mk_new_bndr mod (Just main_name)) + ; parent_name <- case ifFamily decl of -- make family the parent + Just famTyCon -> lookupIfaceTc famTyCon + _ -> return main_name + ; implicit_names <- mapM (mk_new_bndr mod (Just parent_name)) (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] } @@ -322,9 +327,6 @@ loadDecl ignore_prags mod (_version, decl) -- 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 @@ -335,11 +337,12 @@ loadDecl ignore_prags mod (_version, decl) (importedSrcLoc (showSDoc (ppr (moduleName mod)))) -- ToDo: qualify with the package name if necessary - doc = ptext SLIT("Declaration for") <+> ppr (ifName decl) + ifFamily (IfaceData { + ifFamInst = Just (IfaceFamInst {ifFamInstTyCon = famTyCon})}) + = Just famTyCon + ifFamily _ = Nothing -discardDeclPrags :: IfaceDecl -> IfaceDecl -discardDeclPrags decl@(IfaceId {ifIdInfo = HasInfo _}) = decl { ifIdInfo = NoInfo } -discardDeclPrags decl = decl + doc = ptext SLIT("Declaration for") <+> ppr (ifName decl) bumpDeclStats :: Name -> IfL () -- Record that one more declaration has actually been used bumpDeclStats name