X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fiface%2FLoadIface.lhs;h=3e42fd455aa847a2337dc82cd3f6622d701b3581;hp=7989a3fe92dd636fc24ca972118dae834e1aa972;hb=526c3af1dc98987b6949f4df73c0debccf9875bd;hpb=7284427cb6c3e0815b298f3117f91e2fd050bd43 diff --git a/compiler/iface/LoadIface.lhs b/compiler/iface/LoadIface.lhs index 7989a3f..3e42fd4 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} @@ -207,7 +199,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 +301,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 +324,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 +334,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) @@ -477,11 +470,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 +490,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 +508,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 +617,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)) @@ -647,12 +641,6 @@ pprModIface 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 +664,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 +688,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,6 +709,7 @@ 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) @@ -740,6 +725,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 +741,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 +753,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