X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fiface%2FLoadIface.lhs;h=97acc5226ac75bb8154a9fa5c81ce91d4f282e82;hp=8cd88efa5dd5902f4650cd4d0fc3d4de0979ff9b;hb=c5b178be60a5a44abd2f4ddf8c399857678326e2;hpb=9bcd95bad83ee937c178970e8b729732e680fe1e diff --git a/compiler/iface/LoadIface.lhs b/compiler/iface/LoadIface.lhs index 8cd88ef..97acc52 100644 --- a/compiler/iface/LoadIface.lhs +++ b/compiler/iface/LoadIface.lhs @@ -28,24 +28,21 @@ import HscTypes import BasicTypes hiding (SuccessFlag(..)) import TcRnMonad -import Type import PrelNames import PrelInfo -import PrelRules +import MkId ( seqId ) import Rules import Annotations import InstEnv import FamInstEnv import Name import NameEnv -import MkId import Module -import OccName import Maybes import ErrUtils import Finder -import LazyUniqFM +import UniqFM import StaticFlags import Outputable import BinIface @@ -55,8 +52,6 @@ import FastString import Fingerprint import Control.Monad -import Data.List -import Data.Maybe \end{code} @@ -127,11 +122,11 @@ 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] +-- See Note [Loading instances for wired-in things] in TcIface loadWiredInHomeIface :: Name -> IfM lcl () loadWiredInHomeIface name = ASSERT( isWiredInName name ) - do loadSysInterface doc (nameModule name); return () + do _ <- loadSysInterface doc (nameModule name); return () where doc = ptext (sLit "Need home interface for wired-in thing") <+> ppr name @@ -153,27 +148,6 @@ loadInterfaceWithException doc mod_name where_from 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.) - - %********************************************************* %* * @@ -217,19 +191,10 @@ loadInterface doc_str mod from -- if an earlier import had a before we got to real imports. I think. _ -> do { - let { hi_boot_file = case from of - ImportByUser usr_boot -> usr_boot - ImportBySystem -> sys_boot - - ; mb_dep = lookupUFM (eps_is_boot eps) (moduleName mod) - ; sys_boot = case mb_dep of - Just (_, is_boot) -> is_boot - Nothing -> False - -- The boot-ness of the requested interface, - } -- based on the dependencies in directly-imported modules - -- READ THE MODULE IN - ; read_result <- findAndReadIface doc_str mod hi_boot_file + ; read_result <- case (wantHiBootFile dflags eps mod from) of + Failed err -> return (Failed err) + Succeeded hi_boot_file -> findAndReadIface doc_str mod hi_boot_file ; case read_result of { Failed err -> do { let fake_iface = emptyModIface mod @@ -292,6 +257,7 @@ loadInterface doc_str mod from } ; updateEps_ $ \ eps -> + if elemModuleEnv mod (eps_PIT eps) then eps else eps { eps_PIT = extendModuleEnv (eps_PIT eps) mod final_iface, eps_PTE = addDeclsToPTE (eps_PTE eps) new_eps_decls, @@ -322,6 +288,38 @@ loadInterface doc_str mod from ; return (Succeeded final_iface) }}}} +wantHiBootFile :: DynFlags -> ExternalPackageState -> Module -> WhereFrom + -> MaybeErr Message IsBootInterface +-- Figure out whether we want Foo.hi or Foo.hi-boot +wantHiBootFile dflags eps mod from + = case from of + ImportByUser usr_boot + | usr_boot && not this_package + -> Failed (badSourceImport mod) + | otherwise -> Succeeded usr_boot + + ImportBySystem + | not this_package -- If the module to be imported is not from this package + -> Succeeded False -- don't look it up in eps_is_boot, because that is keyed + -- on the ModuleName of *home-package* modules only. + -- We never import boot modules from other packages! + + | otherwise + -> case lookupUFM (eps_is_boot eps) (moduleName mod) of + Just (_, is_boot) -> Succeeded is_boot + Nothing -> Succeeded False + -- The boot-ness of the requested interface, + -- based on the dependencies in directly-imported modules + where + this_package = thisPackage dflags == modulePackageId mod + +badSourceImport :: Module -> SDoc +badSourceImport mod + = hang (ptext (sLit "You cannot {-# SOURCE #-} import a module from another package")) + 2 (ptext (sLit "but") <+> quotes (ppr mod) <+> ptext (sLit "is from package") + <+> quotes (ppr (modulePackageId mod))) +\end{code} + {- Used to be used for the loadInterface sanity check on system imports. That has been removed, but I'm leaving this in pending review of this decision by SPJ - MCB 10/2008 @@ -333,6 +331,7 @@ badDepMsg mod ptext (sLit "but is not listed in the dependencies of the interfaces directly imported by the module being compiled")]) -} +\begin{code} ----------------------------------------------------- -- Loading type/class/value decls -- We pass the full Module name here, replete with @@ -730,14 +729,18 @@ pprFixities fixes = ptext (sLit "fixities") <+> pprWithCommas pprFix fixes pprFix (occ,fix) = ppr fix <+> ppr occ pprVectInfo :: IfaceVectInfo -> SDoc -pprVectInfo (IfaceVectInfo { ifaceVectInfoVar = vars - , ifaceVectInfoTyCon = tycons - , ifaceVectInfoTyConReuse = tyconsReuse +pprVectInfo (IfaceVectInfo { ifaceVectInfoVar = vars + , ifaceVectInfoTyCon = tycons + , ifaceVectInfoTyConReuse = tyconsReuse + , ifaceVectInfoScalarVars = scalarVars + , ifaceVectInfoScalarTyCons = scalarTyCons }) = 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) + , ptext (sLit "scalar variables:") <+> hsep (map ppr scalarVars) + , ptext (sLit "scalar tycons:") <+> hsep (map ppr scalarTyCons) ] instance Outputable Warnings where