X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fiface%2FLoadIface.lhs;h=50fa9335820af94e17b20cb87e390b402b589ef6;hp=7989a3fe92dd636fc24ca972118dae834e1aa972;hb=66579ff945831c5fc9a17c58c722ff01f2268d76;hpb=7284427cb6c3e0815b298f3117f91e2fd050bd43 diff --git a/compiler/iface/LoadIface.lhs b/compiler/iface/LoadIface.lhs index 7989a3f..50fa933 100644 --- a/compiler/iface/LoadIface.lhs +++ b/compiler/iface/LoadIface.lhs @@ -6,13 +6,6 @@ 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, @@ -48,7 +41,6 @@ import NameEnv import MkId import Module import OccName -import SrcLoc import Maybes import ErrUtils import Finder @@ -59,11 +51,11 @@ import BinIface import Panic import Util import FastString +import Fingerprint import Control.Monad import Data.List import Data.Maybe -import Data.IORef \end{code} @@ -78,15 +70,20 @@ import Data.IORef \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) @@ -123,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, @@ -207,7 +205,7 @@ 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 { + _ -> do { let { hi_boot_file = case from of ImportByUser usr_boot -> usr_boot @@ -309,6 +307,7 @@ loadInterface doc_str mod from ; return (Succeeded final_iface) }}}} +badDepMsg :: Module -> SDoc badDepMsg mod = hang (ptext (sLit "Interface file inconsistency:")) 2 (sep [ptext (sLit "home-package module") <+> quotes (ppr mod) <+> ptext (sLit "is needed,"), @@ -331,7 +330,7 @@ addDeclsToPTE :: PackageTypeEnv -> [(Name,TyThing)] -> PackageTypeEnv addDeclsToPTE pte things = extendNameEnvList pte things loadDecls :: Bool - -> [(Version, IfaceDecl)] + -> [(Fingerprint, IfaceDecl)] -> IfL [(Name,TyThing)] loadDecls ignore_prags ver_decls = do { mod <- getIfModule @@ -341,7 +340,7 @@ loadDecls ignore_prags ver_decls loadDecl :: Bool -- Don't load pragmas into the decl pool -> Module - -> (Version, IfaceDecl) + -> (Fingerprint, IfaceDecl) -> IfL [(Name,TyThing)] -- The list can be poked eagerly, but the -- TyThings are forkM'd thunks loadDecl ignore_prags mod (_version, decl) @@ -415,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 @@ -477,11 +476,6 @@ findAndReadIface doc_str mod hi_boot_file ; mb_found <- liftIO (findExactModule hsc_env mod) ; case mb_found of { - err | notFound err -> do - { traceIf (ptext (sLit "...not found")) - ; dflags <- getDOpts - ; return (Failed (cannotFindInterface dflags - (moduleName mod) err)) } ; Found loc mod -> do -- Found file, so read it @@ -502,10 +496,14 @@ findAndReadIface doc_str mod hi_boot_file | otherwise -> return (Succeeded (iface, file_path)) -- Don't forget to fill in the package name... - }}}} - -notFound (Found _ _) = False -notFound _ = True + }} + ; err -> do + { traceIf (ptext (sLit "...not found")) + ; dflags <- getDOpts + ; return (Failed (cannotFindInterface dflags + (moduleName mod) err)) } + } + } \end{code} @readIface@ tries just the one file. @@ -516,9 +514,8 @@ readIface :: Module -> FilePath -> IsBootInterface -- Failed err <=> file not found, or unreadable, or illegible -- Succeeded iface <=> successfully found and parsed -readIface wanted_mod file_path is_hi_boot_file - = do { dflags <- getDOpts - ; res <- tryMostM $ +readIface wanted_mod file_path _ + = do { res <- tryMostM $ readBinIface CheckHiWay QuietBinIFaceReading file_path ; case res of Right iface @@ -626,13 +623,16 @@ pprModIface :: ModIface -> SDoc -- Show a ModIface pprModIface iface = vcat [ ptext (sLit "interface") - <+> ppr (mi_module iface) <+> pp_boot - <+> ppr (mi_mod_vers iface) <+> pp_sub_vers + <+> ppr (mi_module iface) <+> pp_boot <+> (if mi_orphan iface then ptext (sLit "[orphan module]") else empty) <+> (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") + , nest 2 (text "interface hash:" <+> ppr (mi_iface_hash iface)) + , nest 2 (text "ABI hash:" <+> ppr (mi_mod_hash iface)) + , nest 2 (text "export-list hash:" <+> ppr (mi_exp_hash iface)) + , nest 2 (text "orphan hash:" <+> ppr (mi_orphan_hash iface)) + , nest 2 (ptext (sLit "where")) , vcat (map pprExport (mi_exports iface)) , pprDeps (mi_deps iface) , vcat (map pprUsage (mi_usages iface)) @@ -642,17 +642,11 @@ 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]") | otherwise = empty - - exp_vers = mi_exp_vers iface - rule_vers = mi_rule_vers iface - - pp_sub_vers | exp_vers == initialVersion && rule_vers == initialVersion = empty - | otherwise = brackets (ppr exp_vers <+> ppr rule_vers) \end{code} When printing export lists, we print like this: @@ -676,16 +670,16 @@ pprExport (mod, items) pp_export names = braces (hsep (map ppr names)) pprUsage :: Usage -> SDoc -pprUsage usage - = hsep [ptext (sLit "import"), ppr (usg_name usage), - int (usg_mod usage), - pp_export_version (usg_exports usage), - int (usg_rules usage), - pp_versions (usg_entities usage) ] - where - pp_versions nvs = hsep [ ppr n <+> int v | (n,v) <- nvs ] - pp_export_version Nothing = empty - pp_export_version (Just v) = int v +pprUsage usage@UsagePackageModule{} + = hsep [ptext (sLit "import"), ppr (usg_mod usage), + ppr (usg_mod_hash usage)] +pprUsage usage@UsageHomeModule{} + = hsep [ptext (sLit "import"), ppr (usg_mod_name usage), + ppr (usg_mod_hash usage)] $$ + nest 2 ( + maybe empty (\v -> text "exports: " <> ppr v) (usg_exports usage) $$ + vcat [ ppr n <+> ppr v | (n,v) <- usg_entities usage ] + ) pprDeps :: Dependencies -> SDoc pprDeps (Deps { dep_mods = mods, dep_pkgs = pkgs, dep_orphs = orphs, @@ -700,13 +694,9 @@ pprDeps (Deps { dep_mods = mods, dep_pkgs = pkgs, dep_orphs = orphs, ppr_boot True = text "[boot]" ppr_boot False = empty -pprIfaceDecl :: (Version, IfaceDecl) -> SDoc +pprIfaceDecl :: (Fingerprint, IfaceDecl) -> SDoc pprIfaceDecl (ver, decl) - = ppr_vers ver <+> ppr decl - where - -- Print the version for the decl - ppr_vers v | v == initialVersion = empty - | otherwise = int v + = ppr ver $$ nest 2 (ppr decl) pprFixities :: [(OccName, Fixity)] -> SDoc pprFixities [] = empty @@ -725,11 +715,15 @@ pprVectInfo (IfaceVectInfo { ifaceVectInfoVar = vars , 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) - 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} @@ -740,6 +734,7 @@ pprDeprecs (DeprecSome prs) = ptext (sLit "Deprecate") <+> vcat (map pprDeprec p %********************************************************* \begin{code} +badIfaceFile :: String -> SDoc -> SDoc badIfaceFile file err = vcat [ptext (sLit "Bad interface file:") <+> text file, nest 4 err] @@ -755,6 +750,7 @@ hiModuleNameMismatchWarn requested_mod read_mod = , ppr read_mod ] +wrongIfaceModErr :: ModIface -> Module -> String -> SDoc wrongIfaceModErr iface mod_name file_path = sep [ptext (sLit "Interface file") <+> iface_file, ptext (sLit "contains module") <+> quotes (ppr (mi_module iface)) <> comma, @@ -766,6 +762,7 @@ wrongIfaceModErr iface mod_name file_path ] where iface_file = doubleQuotes (text file_path) +homeModError :: Module -> ModLocation -> SDoc homeModError mod location = ptext (sLit "attempting to use module ") <> quotes (ppr mod) <> (case ml_hs_file location of