X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fiface%2FLoadIface.lhs;h=5c7d816ef1c5b18512bb0908e44afd813d5aa531;hp=c91aa63e1adf744e132be5c622646a018e338c29;hb=c1681a73fa4ca4cf8758264ae387ac09a9e900d8;hpb=d76c18e05f6366c23144624b696a02fbaa6d26e8 diff --git a/compiler/iface/LoadIface.lhs b/compiler/iface/LoadIface.lhs index c91aa63..5c7d816 100644 --- a/compiler/iface/LoadIface.lhs +++ b/compiler/iface/LoadIface.lhs @@ -1,71 +1,59 @@ - +% +% (c) The University of Glasgow 2006 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998 % -\section{Dealing with interface files} + +Loading interface files \begin{code} 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 ) where #include "HsVersions.h" -import {-# SOURCE #-} TcIface( tcIfaceDecl, tcIfaceRule, tcIfaceInst ) - -import DynFlags ( DynFlags(..), DynFlag( Opt_IgnoreInterfacePragmas ) ) -import IfaceSyn ( IfaceDecl(..), IfaceConDecl(..), IfaceClassOp(..), - IfaceConDecls(..), IfaceIdInfo(..) ) -import IfaceEnv ( newGlobalBinder ) -import HscTypes ( ModIface(..), TyThing, IfaceExport, Usage(..), - Deprecs(..), Dependencies(..), - emptyModIface, EpsStats(..), GenAvailInfo(..), - addEpsInStats, ExternalPackageState(..), - PackageTypeEnv, emptyTypeEnv, HscEnv(..), - lookupIfaceByModule, emptyPackageIfaceTable, - IsBootInterface, mkIfaceFixCache, - implicitTyThings - ) - -import BasicTypes ( Version, initialVersion, - Fixity(..), FixityDirection(..), isMarkedStrict ) +import {-# SOURCE #-} TcIface( tcIfaceDecl, tcIfaceRules, tcIfaceInst, + tcIfaceFamInst, tcIfaceVectInfo ) + +import DynFlags +import IfaceSyn +import IfaceEnv +import HscTypes + +import BasicTypes hiding (SuccessFlag(..)) 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 Name ( Name {-instance NamedThing-}, getOccName, - nameModule, nameIsLocalOrFrom, isWiredInName ) +import Type + +import PrelNames +import PrelInfo +import PrelRules +import Rules +import InstEnv +import FamInstEnv +import Name import NameEnv -import MkId ( seqId ) +import MkId import Module -import OccName ( OccName, mkOccEnv, lookupOccEnv, mkClassTyConOcc, - mkClassDataConOcc, mkSuperDictSelOcc, - mkDataConWrapperOcc, mkDataConWorkerOcc, - mkNewTyCoOcc, mkInstTyTcOcc, mkInstTyCoOcc ) -import SrcLoc ( importedSrcLoc ) -import Maybes ( MaybeErr(..) ) -import ErrUtils ( Message ) -import Finder ( findImportedModule, findExactModule, - FindResult(..), cannotFindInterface ) +import OccName +import SrcLoc +import Maybes +import ErrUtils +import Finder import UniqFM -import StaticFlags ( opt_HiVersion ) +import StaticFlags import Outputable -import BinIface ( readBinIface, v_IgnoreHiWay ) -import Binary ( getBinFileWithDict ) -import Panic ( ghcError, tryMost, showException, GhcException(..) ) -import List ( nub ) -import Maybe ( isJust ) -import DATA_IOREF ( writeIORef ) +import BinIface +import Panic + +import Data.List +import Data.Maybe +import Data.IORef \end{code} @@ -100,8 +88,10 @@ loadSrcInterface doc mod want_boot = do failWithTc (cannotFindInterface dflags mod err) -- | Load interfaces for a collection of orphan modules. -loadOrphanModules :: [Module] -> TcM () -loadOrphanModules mods +loadOrphanModules :: [Module] -- the modules + -> Bool -- these are family instance-modules + -> TcM () +loadOrphanModules mods isFamInstMod | null mods = returnM () | otherwise = initIfaceTcRn $ do { traceIf (text "Loading orphan modules:" <+> @@ -110,7 +100,9 @@ loadOrphanModules mods ; returnM () } where load mod = loadSysInterface (mk_doc mod) mod - mk_doc mod = ppr mod <+> ptext SLIT("is a orphan-instance module") + mk_doc mod + | isFamInstMod = ppr mod <+> ptext SLIT("is a family-instance module") + | otherwise = ppr mod <+> ptext SLIT("is a orphan-instance module") -- | Loads the interface for a given Name. loadInterfaceForName :: SDoc -> Name -> TcRn ModIface @@ -126,6 +118,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 ) @@ -142,6 +135,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.) + + %********************************************************* %* * @@ -157,6 +171,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) @@ -180,9 +197,9 @@ loadInterface doc_str mod from -- The (src_imp == mi_boot iface) test checks that the already-loaded -- interface isn't a boot iface. This can conceivably happen, -- if an earlier import had a before we got to real imports. I think. - other -> do + other -> do { - { let { hi_boot_file = case from of + let { hi_boot_file = case from of ImportByUser usr_boot -> usr_boot ImportBySystem -> sys_boot @@ -195,7 +212,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 +224,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... @@ -230,7 +246,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,32 +254,54 @@ loadInterface doc_str mod from -- 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) - - ; 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" } } + ; 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) + ; 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 { 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_vect_info = plusVectInfo (eps_vect_info eps) + new_eps_vect_info, + eps_mod_fam_inst_env + = let + fam_inst_env = + extendFamInstEnvList emptyFamInstEnv + new_eps_fam_insts + in + extendModuleEnv (eps_mod_fam_inst_env eps) + mod + fam_inst_env, + 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 @@ -290,136 +328,78 @@ 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)) - (ifaceDeclSubBndrs decl) - ; at_names <- mapM (mk_new_bndr mod (Just main_name)) (atNames decl) + main_name <- mk_new_bndr mod (ifName decl) +-- ; traceIf (text "Loading decl for " <> ppr main_name) + ; implicit_names <- mapM (mk_new_bndr mod) (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. + -- + -- Note [Tricky iface loop] + -- ~~~~~~~~~~~~~~~~~~~~~~~~ + -- The delicate point here is that 'mini-env' should be + -- buildable from 'thing' without demanding any of the things 'forkM'd + -- by tcIfaceDecl. For example + -- class C a where { data T a; op :: T a -> Int } + -- We return the bindings + -- [("C", ), ("T", lookup env "T"), ("op", lookup env "op")] + -- The call (lookup env "T") must return the tycon T without first demanding + -- op; because getting the latter will look up T, hence loop. + -- + -- Of course, there is no reason in principle why (lookup env "T") should demand + -- anything do to with op, but take care: + -- (a) implicitTyThings, and + -- (b) getOccName of all the things returned by implicitThings, + -- must not depend on any of the nested type-checks + -- + -- All a bit too finely-balanced for my liking. + ; 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] - ++ zip at_names (atThings thing) } -- We build a list from the *known* names, with (lookup n) thunks -- 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 -- * location -- imported name, to fix the module correctly in the cache - mk_new_bndr mod mb_parent occ - = newGlobalBinder mod occ mb_parent - (importedSrcLoc (showSDoc (ppr (moduleName mod)))) + mk_new_bndr mod occ + = newGlobalBinder mod occ (importedSrcSpan (moduleNameFS (moduleName mod))) -- ToDo: qualify with the package name if necessary - atNames (IfaceClass {ifATs = ats}) = [ifName at | at <- ats] - atNames _ = [] - - atThings (AClass cla) = [ATyCon at | at <- classATs cla] - atThings _ = [] - 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) ; updateEps_ (\eps -> let stats = eps_stats eps in eps { eps_stats = stats { n_decls_out = n_decls_out stats + 1 } }) } - ------------------ -ifaceDeclSubBndrs :: IfaceDecl -> [OccName] --- *Excludes* the 'main' name, but *includes* the implicitly-bound names --- Deeply revolting, because it has to predict what gets bound, --- especially the question of whether there's a wrapper for a datacon --- --- If you change this, make sure you change HscTypes.implicitTyThings in sync - -ifaceDeclSubBndrs IfaceClass { ifCtxt = sc_ctxt, - ifName = cls_occ, - ifSigs = sigs } - = co_occs ++ - [tc_occ, dc_occ, dcww_occ] ++ - [op | IfaceClassOp op _ _ <- sigs] ++ - [mkSuperDictSelOcc n cls_occ | n <- [1..n_ctxt]] - where - n_ctxt = length sc_ctxt - n_sigs = length sigs - tc_occ = mkClassTyConOcc cls_occ - dc_occ = mkClassDataConOcc cls_occ - co_occs | is_newtype = [mkNewTyCoOcc tc_occ] - | otherwise = [] - dcww_occ -- | is_newtype = mkDataConWrapperOcc dc_occ -- Newtypes have wrapper but no worker - | otherwise = mkDataConWorkerOcc dc_occ -- Otherwise worker but no wrapper - is_newtype = n_sigs + n_ctxt == 1 -- Sigh - -ifaceDeclSubBndrs IfaceData {ifCons = IfAbstractTyCon} - = [] --- Newtype -ifaceDeclSubBndrs (IfaceData {ifName = tc_occ, - ifCons = IfNewTyCon ( - IfCon { ifConOcc = con_occ, - ifConFields = fields - }), - ifFamInst = famInst}) - = fields ++ [con_occ, mkDataConWorkerOcc con_occ, mkNewTyCoOcc tc_occ] - ++ famInstCo famInst tc_occ - -ifaceDeclSubBndrs (IfaceData {ifName = tc_occ, - ifCons = IfDataTyCon cons, - ifFamInst = famInst}) - = nub (concatMap ifConFields cons) -- Eliminate duplicate fields - ++ concatMap dc_occs cons - ++ famInstCo famInst tc_occ - where - dc_occs con_decl - | has_wrapper = [con_occ, work_occ, wrap_occ] - | otherwise = [con_occ, work_occ] - where - con_occ = ifConOcc con_decl - strs = ifConStricts con_decl - wrap_occ = mkDataConWrapperOcc con_occ - work_occ = mkDataConWorkerOcc con_occ - has_wrapper = any isMarkedStrict strs -- See MkId.mkDataConIds (sigh) - || not (null . ifConEqSpec $ con_decl) - || isJust famInst - -- ToDo: may miss strictness in existential dicts - -ifaceDeclSubBndrs _other = [] - --- coercion for data/newtype family instances -famInstCo Nothing baseOcc = [] -famInstCo (Just (_, _, index)) baseOcc = [mkInstTyTcOcc index baseOcc, - mkInstTyCoOcc index baseOcc] \end{code} @@ -458,18 +438,25 @@ findAndReadIface doc_str mod hi_boot_file -- Look for the file ; hsc_env <- getTopEnv - ; mb_found <- ioToIOEnv (findHiFile hsc_env mod hi_boot_file) + ; mb_found <- ioToIOEnv (findExactModule hsc_env mod) ; case mb_found of { - Failed err -> do + + err | notFound err -> do { traceIf (ptext SLIT("...not found")) ; dflags <- getDOpts ; returnM (Failed (cannotFindInterface dflags (moduleName mod) err)) } ; - - Succeeded file_path -> do + Found loc mod -> do -- Found file, so read it - { traceIf (ptext SLIT("readIFace") <+> text file_path) + { let { file_path = addBootSuffix_maybe hi_boot_file (ml_hi_file loc) } + + ; if thisPackage dflags == modulePackageId mod + && not (isOneShot (ghcMode dflags)) + then returnM (Failed (homeModError mod loc)) + else do { + + ; traceIf (ptext SLIT("readIFace") <+> text file_path) ; read_result <- readIface mod file_path hi_boot_file ; case read_result of Failed err -> returnM (Failed (badIfaceFile file_path err)) @@ -479,18 +466,10 @@ findAndReadIface doc_str mod hi_boot_file | otherwise -> returnM (Succeeded (iface, file_path)) -- Don't forget to fill in the package name... - }}} - -findHiFile :: HscEnv -> Module -> IsBootInterface - -> IO (MaybeErr FindResult FilePath) -findHiFile hsc_env mod hi_boot_file - = do - maybe_found <- findExactModule hsc_env mod - case maybe_found of - Found loc mod -> return (Succeeded path) - where - path = addBootSuffix_maybe hi_boot_file (ml_hi_file loc) - err -> return (Failed err) + }}}} + +notFound (Found _ _) = False +notFound _ = True \end{code} @readIface@ tries just the one file. @@ -503,8 +482,7 @@ readIface :: Module -> FilePath -> IsBootInterface readIface wanted_mod file_path is_hi_boot_file = do { dflags <- getDOpts - ; ioToIOEnv $ do - { res <- tryMost (readBinIface file_path) + ; res <- tryMostM $ readBinIface file_path ; case res of Right iface | wanted_mod == actual_mod -> return (Succeeded iface) @@ -514,7 +492,7 @@ readIface wanted_mod file_path is_hi_boot_file err = hiModuleNameMismatchWarn wanted_mod actual_mod Left exn -> return (Failed (text (showException exn))) - }} + } \end{code} @@ -528,12 +506,16 @@ readIface wanted_mod file_path is_hi_boot_file 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_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 } @@ -582,7 +564,7 @@ ifaceStats eps hsep [ int (n_rules_out stats), text "rule decls imported, out of", int (n_rules_in stats), text "read"] ] -\end{code} +\end{code} %************************************************************************ @@ -592,18 +574,16 @@ ifaceStats eps %************************************************************************ \begin{code} -showIface :: FilePath -> IO () --- Read binary interface, and print it out -showIface filename = do +-- | Read binary interface, and print it out +showIface :: HscEnv -> FilePath -> IO () +showIface hsc_env filename = do -- skip the version check; we don't want to worry about profiled vs. -- non-profiled interfaces, for example. writeIORef v_IgnoreHiWay True - iface <- Binary.getBinFileWithDict filename + iface <- initTcRnIf 's' hsc_env () () $ readBinIface filename printDump (pprModIface iface) - where \end{code} - \begin{code} pprModIface :: ModIface -> SDoc -- Show a ModIface @@ -612,7 +592,9 @@ pprModIface iface <+> ppr (mi_module iface) <+> pp_boot <+> ppr (mi_mod_vers iface) <+> pp_sub_vers <+> (if mi_orphan iface then ptext SLIT("[orphan module]") else empty) - <+> int opt_HiVersion + <+> (if mi_finsts iface then ptext SLIT("[family instance module]") else empty) + <+> (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) @@ -620,9 +602,11 @@ pprModIface iface , pprFixities (mi_fixities iface) , vcat (map pprIfaceDecl (mi_decls 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 @@ -667,10 +651,12 @@ pprUsage usage pp_export_version (Just v) = int v pprDeps :: Dependencies -> SDoc -pprDeps (Deps { dep_mods = mods, dep_pkgs = pkgs, dep_orphs = orphs}) +pprDeps (Deps { dep_mods = mods, dep_pkgs = pkgs, dep_orphs = orphs, + dep_finsts = finsts }) = vcat [ptext SLIT("module dependencies:") <+> fsep (map ppr_mod mods), ptext SLIT("package dependencies:") <+> fsep (map ppr pkgs), - ptext SLIT("orphans:") <+> fsep (map ppr orphs) + ptext SLIT("orphans:") <+> fsep (map ppr orphs), + ptext SLIT("family instance modules:") <+> fsep (map ppr finsts) ] where ppr_mod (mod_name, boot) = ppr mod_name <+> ppr_boot boot @@ -691,6 +677,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) @@ -731,5 +728,12 @@ wrongIfaceModErr iface mod_name file_path ] ] where iface_file = doubleQuotes (text file_path) + +homeModError mod location + = ptext SLIT("attempting to use module ") <> quotes (ppr mod) + <> (case ml_hs_file location of + Just file -> space <> parens (text file) + Nothing -> empty) + <+> ptext SLIT("which is not loaded") \end{code}