X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fiface%2FLoadIface.lhs;h=50fa9335820af94e17b20cb87e390b402b589ef6;hp=3e42fd455aa847a2337dc82cd3f6622d701b3581;hb=66579ff945831c5fc9a17c58c722ff01f2268d76;hpb=526c3af1dc98987b6949f4df73c0debccf9875bd diff --git a/compiler/iface/LoadIface.lhs b/compiler/iface/LoadIface.lhs index 3e42fd4..50fa933 100644 --- a/compiler/iface/LoadIface.lhs +++ b/compiler/iface/LoadIface.lhs @@ -70,15 +70,20 @@ import Data.Maybe \begin{code} -- | Load the interface corresponding to an @import@ directive in -- source code. On a failure, fail in the monad with an error message. -loadSrcInterface :: SDoc -> ModuleName -> IsBootInterface -> RnM ModIface -loadSrcInterface doc mod want_boot = do +loadSrcInterface :: SDoc + -> ModuleName + -> IsBootInterface -- {-# SOURCE #-} ? + -> Maybe FastString -- "package", if any + -> RnM ModIface + +loadSrcInterface doc mod want_boot maybe_pkg = do -- We must first find which Module this import refers to. This involves -- calling the Finder, which as a side effect will search the filesystem -- and create a ModLocation. If successful, loadIface will read the -- interface; it will call the Finder again, but the ModLocation will be -- cached from the first search. hsc_env <- getTopEnv - res <- liftIO $ findImportedModule hsc_env mod Nothing + res <- liftIO $ findImportedModule hsc_env mod maybe_pkg case res of Found _ mod -> do mb_iface <- initIfaceTcRn $ loadInterface doc mod (ImportByUser want_boot) @@ -115,7 +120,8 @@ loadInterfaceForName doc name { this_mod <- getModule ; MASSERT2( not (nameIsLocalOrFrom this_mod name), ppr name <+> parens doc ) } - ; initIfaceTcRn $ loadSysInterface doc (nameModule name) + ; ASSERT2( isExternalName name, ppr name ) + initIfaceTcRn $ loadSysInterface doc (nameModule name) } -- | An 'IfM' function to load the home interface for a wired-in thing, @@ -408,7 +414,7 @@ loadDecl ignore_prags mod (_version, decl) -- All a bit too finely-balanced for my liking. -- This mini-env and lookup function mediates between the - -- *Name*s n and the map from *OccName*s to the implicit TyThings + --'Name's n and the map from 'OccName's to the implicit TyThings ; let mini_env = mkOccEnv [(getOccName t, t) | t <- implicitTyThings thing] lookup n = case lookupOccEnv mini_env (getOccName n) of Just thing -> thing @@ -636,7 +642,7 @@ pprModIface iface , vcat (map ppr (mi_fam_insts iface)) , vcat (map ppr (mi_rules iface)) , pprVectInfo (mi_vect_info iface) - , pprDeprecs (mi_deprecs iface) + , ppr (mi_warns iface) ] where pp_boot | mi_boot iface = ptext (sLit "[boot]") @@ -709,12 +715,15 @@ pprVectInfo (IfaceVectInfo { ifaceVectInfoVar = vars , ptext (sLit "vectorised reused tycons:") <+> hsep (map ppr tyconsReuse) ] -pprDeprecs :: Deprecations -> SDoc -pprDeprecs NoDeprecs = empty -pprDeprecs (DeprecAll txt) = ptext (sLit "Deprecate all") <+> doubleQuotes (ftext txt) -pprDeprecs (DeprecSome prs) = ptext (sLit "Deprecate") <+> vcat (map pprDeprec prs) - where - pprDeprec (name, txt) = ppr name <+> doubleQuotes (ftext txt) +instance Outputable Warnings where + ppr = pprWarns + +pprWarns :: Warnings -> SDoc +pprWarns NoWarnings = empty +pprWarns (WarnAll txt) = ptext (sLit "Warn all") <+> ppr txt +pprWarns (WarnSome prs) = ptext (sLit "Warnings") + <+> vcat (map pprWarning prs) + where pprWarning (name, txt) = ppr name <+> ppr txt \end{code}