X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fiface%2FLoadIface.lhs;h=e4ac07506a1fb3ddd079e2038480e03370ee3e9e;hb=9636f8cd435e598132687fc1e007c181f2f221e6;hp=6b2660d9a41de54838e005a358da87257ece4e46;hpb=1e8ae3f05cd475454f086a51da845ac0318d40e8;p=ghc-hetmet.git diff --git a/compiler/iface/LoadIface.lhs b/compiler/iface/LoadIface.lhs index 6b2660d..e4ac075 100644 --- a/compiler/iface/LoadIface.lhs +++ b/compiler/iface/LoadIface.lhs @@ -6,6 +6,13 @@ Loading interface files \begin{code} +{-# OPTIONS -w #-} +-- The above warning supression flag is a temporary kludge. +-- While working on this module you are encouraged to remove it and fix +-- any warnings in the module. See +-- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings +-- for details + module LoadIface ( loadInterface, loadInterfaceForName, loadWiredInHomeIface, loadSrcInterface, loadSysInterface, loadOrphanModules, @@ -19,7 +26,7 @@ module LoadIface ( #include "HsVersions.h" import {-# SOURCE #-} TcIface( tcIfaceDecl, tcIfaceRules, tcIfaceInst, - tcIfaceFamInst ) + tcIfaceFamInst, tcIfaceVectInfo ) import DynFlags import IfaceSyn @@ -51,7 +58,6 @@ import Outputable import BinIface import Panic -import Control.Monad (when) import Data.List import Data.Maybe import Data.IORef @@ -119,6 +125,7 @@ loadInterfaceForName doc name -- | An 'IfM' function to load the home interface for a wired-in thing, -- so that we're sure that we see its instance declarations and rules +-- See Note [Loading instances] loadWiredInHomeIface :: Name -> IfM lcl () loadWiredInHomeIface name = ASSERT( isWiredInName name ) @@ -135,6 +142,27 @@ loadSysInterface doc mod_name Succeeded iface -> return iface } \end{code} +Note [Loading instances] +~~~~~~~~~~~~~~~~~~~~~~~~ +We need to make sure that we have at least *read* the interface files +for any module with an instance decl or RULE that we might want. + +* If the instance decl is an orphan, we have a whole separate mechanism + (loadOprhanModules) + +* If the instance decl not an orphan, then the act of looking at the + TyCon or Class will force in the defining module for the + TyCon/Class, and hence the instance decl + +* BUT, if the TyCon is a wired-in TyCon, we don't really need its interface; + but we must make sure we read its interface in case it has instances or + rules. That is what LoadIface.loadWiredInHomeInterface does. It's called + from TcIface.{tcImportDecl, checkWiredInTyCon, ifCHeckWiredInThing} + +All of this is done by the type checker. The renamer plays no role. +(It used to, but no longer.) + + %********************************************************* %* * @@ -225,7 +253,7 @@ loadInterface doc_str mod from -- -- The main thing is to add the ModIface to the PIT, but -- we also take the - -- IfaceDecls, IfaceInst, IfaceRules + -- IfaceDecls, IfaceInst, IfaceFamInst, IfaceRules, IfaceVectInfo -- out of the ModIface and put them into the big EPS pools -- NB: *first* we do loadDecl, so that the provenance of all the locally-defined @@ -238,13 +266,16 @@ loadInterface doc_str mod from ; 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) + ; new_eps_vect_info <- tcIfaceVectInfo mod (mkNameEnv new_eps_decls) + (mi_vect_info iface) ; let { final_iface = iface { mi_decls = panic "No mi_decls in PIT", mi_insts = panic "No mi_insts in PIT", mi_fam_insts = panic "No mi_fam_insts in PIT", mi_rules = panic "No mi_rules in PIT" - } } + } + } ; updateEps_ $ \ eps -> eps { @@ -256,6 +287,8 @@ loadInterface doc_str mod from new_eps_insts, eps_fam_inst_env = extendFamInstEnvList (eps_fam_inst_env eps) new_eps_fam_insts, + eps_vect_info = plusVectInfo (eps_vect_info eps) + new_eps_vect_info, eps_mod_fam_inst_env = let fam_inst_env = @@ -274,8 +307,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 is needed,"), - ptext SLIT("but is not among the dependencies of interfaces directly imported by the module being compiled")]) + 2 (sep [ptext SLIT("home-package module") <+> quotes (ppr mod) <+> ptext SLIT("is needed,"), + ptext SLIT("but is not listed in the dependencies of the interfaces directly imported by the module being compiled")]) ----------------------------------------------------- -- Loading type/class/value decls @@ -310,9 +343,9 @@ loadDecl :: Bool -- Don't load pragmas into the decl pool 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 (ifName decl) + main_name <- lookupOrig mod (ifName decl) -- ; traceIf (text "Loading decl for " <> ppr main_name) - ; implicit_names <- mapM (mk_new_bndr mod) (ifaceDeclSubBndrs decl) + ; implicit_names <- mapM (lookupOrig mod) (ifaceDeclSubBndrs decl) -- Typecheck the thing, lazily -- NB. Firstly, the laziness is there in case we never need the @@ -357,16 +390,6 @@ loadDecl ignore_prags mod (_version, decl) -- as the TyThings. That way we can extend the PTE without poking the -- thunks where - -- mk_new_bndr allocates in the name cache the final canonical - -- name for the thing, with the correct - -- * parent - -- * location - -- imported name, to fix the module correctly in the cache - mk_new_bndr mod occ - = newGlobalBinder mod occ - (importedSrcLoc (showSDoc (ppr (moduleName mod)))) - -- ToDo: qualify with the package name if necessary - doc = ptext SLIT("Declaration for") <+> ppr (ifName decl) bumpDeclStats :: Name -> IfL () -- Record that one more declaration has actually been used @@ -490,6 +513,7 @@ initExternalPackageState -- Initialise the EPS rule pool with the built-in rules eps_mod_fam_inst_env = emptyModuleEnv, + eps_vect_info = noVectInfo, eps_stats = EpsStats { n_ifaces_in = 0, n_decls_in = 0, n_decls_out = 0 , n_insts_in = 0, n_insts_out = 0 , n_rules_in = length builtinRules, n_rules_out = 0 } @@ -567,7 +591,8 @@ pprModIface iface <+> ppr (mi_mod_vers iface) <+> pp_sub_vers <+> (if mi_orphan iface then ptext SLIT("[orphan module]") else empty) <+> (if mi_finsts iface then ptext SLIT("[family instance module]") else empty) - <+> int opt_HiVersion + <+> (if mi_hpc iface then ptext SLIT("[hpc]") else empty) + <+> integer opt_HiVersion <+> ptext SLIT("where") , vcat (map pprExport (mi_exports iface)) , pprDeps (mi_deps iface) @@ -577,8 +602,9 @@ pprModIface iface , vcat (map ppr (mi_insts iface)) , vcat (map ppr (mi_fam_insts iface)) , vcat (map ppr (mi_rules iface)) + , pprVectInfo (mi_vect_info iface) , pprDeprecs (mi_deprecs iface) - ] + ] where pp_boot | mi_boot iface = ptext SLIT("[boot]") | otherwise = empty @@ -649,6 +675,17 @@ pprFixities fixes = ptext SLIT("fixities") <+> pprWithCommas pprFix fixes where pprFix (occ,fix) = ppr fix <+> ppr occ +pprVectInfo :: IfaceVectInfo -> SDoc +pprVectInfo (IfaceVectInfo { ifaceVectInfoVar = vars + , ifaceVectInfoTyCon = tycons + , ifaceVectInfoTyConReuse = tyconsReuse + }) = + vcat + [ ptext SLIT("vectorised variables:") <+> hsep (map ppr vars) + , ptext SLIT("vectorised tycons:") <+> hsep (map ppr tycons) + , ptext SLIT("vectorised reused tycons:") <+> hsep (map ppr tyconsReuse) + ] + pprDeprecs NoDeprecs = empty pprDeprecs (DeprecAll txt) = ptext SLIT("Deprecate all") <+> doubleQuotes (ftext txt) pprDeprecs (DeprecSome prs) = ptext SLIT("Deprecate") <+> vcat (map pprDeprec prs)