diff options
Diffstat (limited to 'ghc/compiler/iface')
| -rw-r--r-- | ghc/compiler/iface/BinIface.hs | 6 | ||||
| -rw-r--r-- | ghc/compiler/iface/IfaceType.lhs | 7 | ||||
| -rw-r--r-- | ghc/compiler/iface/LoadIface.lhs | 93 | ||||
| -rw-r--r-- | ghc/compiler/iface/MkIface.lhs | 34 | ||||
| -rw-r--r-- | ghc/compiler/iface/TcIface.lhs-boot | 9 |
5 files changed, 64 insertions, 85 deletions
diff --git a/ghc/compiler/iface/BinIface.hs b/ghc/compiler/iface/BinIface.hs index 8570f6bb09..b246be2f6c 100644 --- a/ghc/compiler/iface/BinIface.hs +++ b/ghc/compiler/iface/BinIface.hs @@ -94,6 +94,7 @@ readBinIface hi_path = getBinFileWithDict hi_path instance Binary ModIface where put_ bh (ModIface { mi_module = mod, + mi_boot = is_boot, mi_mod_vers = mod_vers, mi_package = _, -- we ignore the package on output mi_orphan = orphan, @@ -111,6 +112,7 @@ instance Binary ModIface where build_tag <- readIORef v_Build_tag put bh build_tag put_ bh mod + put_ bh is_boot put_ bh mod_vers put_ bh orphan lazyPut bh deps @@ -145,7 +147,7 @@ instance Binary ModIface where ++ build_tag ++ ", found " ++ check_way)) mod_name <- get bh - + is_boot <- get bh mod_vers <- get bh orphan <- get bh deps <- lazyGet bh @@ -161,8 +163,8 @@ instance Binary ModIface where return (ModIface { mi_package = HomePackage, -- to be filled in properly later mi_module = mod_name, + mi_boot = is_boot, mi_mod_vers = mod_vers, - mi_boot = False, -- Binary interfaces are never .hi-boot files! mi_orphan = orphan, mi_deps = deps, mi_usages = usages, diff --git a/ghc/compiler/iface/IfaceType.lhs b/ghc/compiler/iface/IfaceType.lhs index 40cae9d272..0ebfa0d88f 100644 --- a/ghc/compiler/iface/IfaceType.lhs +++ b/ghc/compiler/iface/IfaceType.lhs @@ -9,7 +9,7 @@ module IfaceType ( IfaceType(..), IfaceKind, IfacePredType(..), IfaceTyCon(..), IfaceContext, IfaceBndr(..), IfaceTvBndr, IfaceIdBndr, - IfaceExtName(..), mkIfaceExtName, ifaceTyConName, + IfaceExtName(..), mkIfaceExtName, ifaceTyConName, ifPrintUnqual, -- Conversion from Type -> IfaceType toIfaceType, toIfacePred, toIfaceContext, @@ -65,6 +65,11 @@ data IfaceExtName mkIfaceExtName name = ExtPkg (nameModule name) (nameOccName name) -- Local helper for wired-in names + +ifPrintUnqual :: PrintUnqualified -> IfaceExtName -> Bool +ifPrintUnqual print_unqual (ExtPkg mod occ) = print_unqual mod occ +ifPrintUnqual print_unqual (HomePkg mod occ _) = print_unqual mod occ +ifPrintUnqual print_unqual other = True \end{code} diff --git a/ghc/compiler/iface/LoadIface.lhs b/ghc/compiler/iface/LoadIface.lhs index 142d86f93d..c33fae0177 100644 --- a/ghc/compiler/iface/LoadIface.lhs +++ b/ghc/compiler/iface/LoadIface.lhs @@ -9,8 +9,7 @@ module LoadIface ( loadSrcInterface, loadOrphanModules, loadHiBootInterface, readIface, -- Used when reading the module's old interface predInstGates, ifaceInstGates, ifaceStats, discardDeclPrags, - initExternalPackageState, - noIfaceErr, -- used by CompManager too + initExternalPackageState ) where #include "HsVersions.h" @@ -19,10 +18,7 @@ import {-# SOURCE #-} TcIface( tcIfaceDecl ) import Packages ( PackageState(..), PackageIdH(..), isHomePackage ) import DriverState ( v_GhcMode, isCompManagerMode ) -import DriverUtil ( replaceFilenameSuffix ) import CmdLineOpts ( DynFlags(..), DynFlag( Opt_IgnoreInterfacePragmas ) ) -import Parser ( parseIface ) - import IfaceSyn ( IfaceDecl(..), IfaceConDecl(..), IfaceClassOp(..), IfaceConDecls(..), IfaceInst(..), IfaceRule(..), IfaceExpr(..), IfaceTyCon(..), IfaceIdInfo(..), @@ -55,28 +51,24 @@ import Name ( Name {-instance NamedThing-}, getOccName, import NameEnv import MkId ( seqId ) import Module ( Module, ModLocation(ml_hi_file), emptyModuleEnv, + addBootSuffix_maybe, extendModuleEnv, lookupModuleEnv, moduleUserString ) import OccName ( OccName, mkOccEnv, lookupOccEnv, mkClassTyConOcc, mkClassDataConOcc, mkSuperDictSelOcc, mkDataConWrapperOcc, mkDataConWorkerOcc ) import Class ( Class, className ) import TyCon ( tyConName ) -import SrcLoc ( mkSrcLoc, importedSrcLoc ) +import SrcLoc ( importedSrcLoc ) import Maybes ( mapCatMaybes, MaybeErr(..) ) -import StringBuffer ( hGetStringBuffer ) import FastString ( mkFastString ) -import ErrUtils ( Message, mkLocMessage ) -import Finder ( findModule, findPackageModule, FindResult(..), - hiBootFilePath ) -import Lexer +import ErrUtils ( Message ) +import Finder ( findModule, findPackageModule, FindResult(..), cantFindError ) import Outputable import BinIface ( readBinIface ) import Panic ( ghcError, tryMost, showException, GhcException(..) ) import List ( nub ) import DATA_IOREF ( readIORef ) - -import Directory \end{code} @@ -576,7 +568,7 @@ findAndReadIface explicit doc_str mod_name hi_boot_file Failed err -> do { traceIf (ptext SLIT("...not found")) ; dflags <- getDOpts - ; returnM (Failed (noIfaceErr dflags mod_name err)) } ; + ; returnM (Failed (cantFindError dflags mod_name err)) } ; Succeeded (file_path, pkg) -> do @@ -603,18 +595,17 @@ findHiFile dflags explicit mod_name hi_boot_file -- and start up GHCi - it won't complain that all the modules it tries -- to load are found in the home location. ghci_mode <- readIORef v_GhcMode ; - let { home_allowed = hi_boot_file || - not (isCompManagerMode ghci_mode) } ; + let { home_allowed = not (isCompManagerMode ghci_mode) } ; maybe_found <- if home_allowed - then findModule dflags mod_name explicit + then findModule dflags mod_name explicit else findPackageModule dflags mod_name explicit; case maybe_found of - Found loc pkg - | hi_boot_file -> do { hi_boot_path <- hiBootFilePath loc - ; return (Succeeded (hi_boot_path, pkg)) } - | otherwise -> return (Succeeded (ml_hi_file loc, pkg)) ; - err -> return (Failed err) + Found loc pkg -> return (Succeeded (path, pkg)) + where + path = addBootSuffix_maybe hi_boot_file (ml_hi_file loc) + + err -> return (Failed err) } \end{code} @@ -626,33 +617,20 @@ readIface :: Module -> String -> IsBootInterface -- Failed err <=> file not found, or unreadable, or illegible -- Succeeded iface <=> successfully found and parsed -readIface wanted_mod_name file_path is_hi_boot_file +readIface wanted_mod file_path is_hi_boot_file = do { dflags <- getDOpts - ; ioToIOEnv (read_iface dflags wanted_mod_name file_path is_hi_boot_file) } - -read_iface dflags wanted_mod file_path is_hi_boot_file - | is_hi_boot_file -- Read ascii - = do { res <- tryMost (hGetStringBuffer file_path) ; - case res of { - Left exn -> return (Failed (text (showException exn))) ; - Right buffer -> - case unP parseIface (mkPState buffer loc dflags) of - PFailed span err -> return (Failed (mkLocMessage span err)) - POk _ iface - | wanted_mod == actual_mod -> return (Succeeded iface) - | otherwise -> return (Failed err) - where - actual_mod = mi_module iface - err = hiModuleNameMismatchWarn wanted_mod actual_mod - }} - - | otherwise -- Read binary - = do { res <- tryMost (readBinIface file_path) + ; ioToIOEnv $ do + { res <- tryMost (readBinIface file_path) ; case res of - Right iface -> return (Succeeded iface) - Left exn -> return (Failed (text (showException exn))) } - where - loc = mkSrcLoc (mkFastString file_path) 1 0 + Right iface + | wanted_mod == actual_mod -> return (Succeeded iface) + | otherwise -> return (Failed err) + where + actual_mod = mi_module iface + err = hiModuleNameMismatchWarn wanted_mod actual_mod + + Left exn -> return (Failed (text (showException exn))) + }} \end{code} @@ -748,27 +726,6 @@ hiModuleNameMismatchWarn requested_mod read_mod = , ppr read_mod ] -noIfaceErr :: DynFlags -> Module -> FindResult -> SDoc -noIfaceErr dflags mod_name (PackageHidden pkg) - = ptext SLIT("Could not import") <+> quotes (ppr mod_name) <> colon - $$ ptext SLIT("it is a member of package") <+> ppr pkg <> comma - <+> ptext SLIT("which is hidden") - -noIfaceErr dflags mod_name (ModuleHidden pkg) - = ptext SLIT("Could not import") <+> quotes (ppr mod_name) <> colon - $$ ptext SLIT("it is hidden") - <+> parens (ptext SLIT("in package") <+> ppr pkg) - -noIfaceErr dflags mod_name (NotFound files) - = ptext SLIT("Could not find interface file for") <+> quotes (ppr mod_name) - $$ extra files - where - extra files - | verbosity dflags < 3 = - text "(use -v to see a list of the files searched for)" - | otherwise = - hang (ptext SLIT("locations searched:")) 4 (vcat (map text files)) - wrongIfaceModErr iface mod_name file_path = sep [ptext SLIT("Interface file") <+> iface_file, ptext SLIT("contains module") <+> quotes (ppr (mi_module iface)) <> comma, diff --git a/ghc/compiler/iface/MkIface.lhs b/ghc/compiler/iface/MkIface.lhs index 8fa008f82a..a27335e241 100644 --- a/ghc/compiler/iface/MkIface.lhs +++ b/ghc/compiler/iface/MkIface.lhs @@ -4,7 +4,7 @@ \begin{code} module MkIface ( - showIface, -- Print the iface in Foo.hi + pprModIface, showIface, -- Print the iface in Foo.hi mkUsageInfo, -- Construct the usage info for a module @@ -189,6 +189,7 @@ import HscTypes ( ModIface(..), TyThing(..), ModGuts(..), ModGuts, IfaceExport, GhciMode(..), HscEnv(..), hscEPS, Dependencies(..), FixItem(..), + ModSummary(..), msHiFilePath, mkIfaceDepCache, mkIfaceFixCache, mkIfaceVerCache, typeEnvElts, GenAvailInfo(..), availName, @@ -258,6 +259,7 @@ mkIface :: HscEnv mkIface hsc_env location maybe_old_iface guts@ModGuts{ mg_module = this_mod, + mg_boot = is_boot, mg_usages = usages, mg_deps = deps, mg_exports = exports, @@ -295,7 +297,7 @@ mkIface hsc_env location maybe_old_iface ; intermediate_iface = ModIface { mi_module = this_mod, mi_package = HomePackage, - mi_boot = False, + mi_boot = is_boot, mi_deps = deps, mi_usages = usages, mi_exports = mkIfaceExports exports, @@ -340,10 +342,10 @@ mkIface hsc_env location maybe_old_iface r1 `le_rule` r2 = ifRuleName r1 <= ifRuleName r2 i1 `le_inst` i2 = ifDFun i1 <= ifDFun i2 - dflags = hsc_dflags hsc_env - ghci_mode = hsc_mode hsc_env + dflags = hsc_dflags hsc_env + ghci_mode = hsc_mode hsc_env + omit_prags = dopt Opt_OmitInterfacePragmas dflags hi_file_path = ml_hi_file location - omit_prags = dopt Opt_OmitInterfacePragmas dflags mustExposeThing :: NameSet -> TyThing -> Bool @@ -799,21 +801,20 @@ mkIfaceExports exports \begin{code} checkOldIface :: HscEnv - -> Module - -> FilePath -- Where the interface file is + -> ModSummary -> Bool -- Source unchanged -> Maybe ModIface -- Old interface from compilation manager, if any -> IO (RecompileRequired, Maybe ModIface) -checkOldIface hsc_env mod iface_path source_unchanged maybe_iface +checkOldIface hsc_env mod_summary source_unchanged maybe_iface = do { showPass (hsc_dflags hsc_env) - ("Checking old interface for " ++ moduleUserString mod) ; + ("Checking old interface for " ++ moduleUserString (ms_mod mod_summary)) ; ; initIfaceCheck hsc_env $ - check_old_iface mod iface_path source_unchanged maybe_iface + check_old_iface mod_summary source_unchanged maybe_iface } -check_old_iface this_mod iface_path source_unchanged maybe_iface +check_old_iface mod_summary source_unchanged maybe_iface = -- CHECK WHETHER THE SOURCE HAS CHANGED ifM (not source_unchanged) (traceHiDiffs (nest 4 (text "Source file changed or recompilation check turned off"))) @@ -835,7 +836,10 @@ check_old_iface this_mod iface_path source_unchanged maybe_iface -- Try and read the old interface for the current module -- from the .hi file left from the last time we compiled it - readIface this_mod iface_path False `thenM` \ read_result -> + let + iface_path = msHiFilePath mod_summary + in + readIface (ms_mod mod_summary) iface_path False `thenM` \ read_result -> case read_result of { Failed err -> -- Old interface file not found, or garbled; give up traceIf (text "FYI: cannot read old interface file:" @@ -1016,8 +1020,8 @@ pprModIface :: ModIface -> SDoc pprModIface iface = vcat [ ptext SLIT("interface") <+> ppr_package (mi_package iface) - <+> ppr (mi_module iface) <+> ppr (mi_mod_vers iface) - <+> pp_sub_vers + <+> 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 <+> ptext SLIT("where") @@ -1031,6 +1035,8 @@ pprModIface iface , pprDeprecs (mi_deprecs iface) ] where + pp_boot | mi_boot iface = ptext SLIT("[boot]") + | otherwise = empty ppr_package HomePackage = empty ppr_package (ExtPackage id) = doubleQuotes (ppr id) diff --git a/ghc/compiler/iface/TcIface.lhs-boot b/ghc/compiler/iface/TcIface.lhs-boot new file mode 100644 index 0000000000..51a5f9f569 --- /dev/null +++ b/ghc/compiler/iface/TcIface.lhs-boot @@ -0,0 +1,9 @@ +\begin{code} +module TcIface where +import IfaceSyn ( IfaceDecl ) +import TypeRep ( TyThing ) +import TcRnTypes ( IfL ) + +tcIfaceDecl :: IfaceDecl -> IfL TyThing +\end{code} + |