\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
mkIface, -- Build a ModIface from a ModGuts,
-- including computing version information
+ writeIfaceFile, -- Write the interface file
+
checkOldIface -- See if recompilation is required, by
-- comparing version information
) where
#include "HsVersions.h"
import HsSyn
-import Packages ( isHomeModule )
+import Packages ( isHomeModule, PackageIdH(..) )
import IfaceSyn ( IfaceDecl(..), IfaceClassOp(..), IfaceConDecl(..),
- IfaceRule(..), IfaceInst(..), IfaceExtName(..), IfaceTyCon(..),
+ IfaceRule(..), IfaceInst(..), IfaceExtName(..),
eqIfDecl, eqIfRule, eqIfInst, IfaceEq(..), (&&&), bool,
eqMaybeBy, eqListBy, visibleIfConDecls,
- tyThingToIfaceDecl, dfunToIfaceInst, coreRuleToIfaceRule )
-import LoadIface ( readIface, loadInterface, ifaceInstGates )
+ tyThingToIfaceDecl, instanceToIfaceInst, coreRuleToIfaceRule )
+import LoadIface ( readIface, loadInterface )
import BasicTypes ( Version, initialVersion, bumpVersion )
import TcRnMonad
-import TcRnTypes ( mkModDeps )
-import TcType ( isFFITy )
-import HscTypes ( ModIface(..), TyThing(..), IfacePackage(..),
- ModGuts(..), ModGuts, IfaceExport,
- GhciMode(..), HscEnv(..), hscEPS,
- Dependencies(..), FixItem(..),
+import HscTypes ( ModIface(..), ModDetails(..),
+ ModGuts(..), IfaceExport,
+ HscEnv(..), hscEPS, Dependencies(..), FixItem(..),
+ ModSummary(..), msHiFilePath,
mkIfaceDepCache, mkIfaceFixCache, mkIfaceVerCache,
typeEnvElts,
GenAvailInfo(..), availName,
)
-import CmdLineOpts
+import Packages ( HomeModules )
+import DynFlags ( GhcMode(..), DynFlags(..), DynFlag(..), dopt )
+import StaticFlags ( opt_HiVersion )
import Name ( Name, nameModule, nameOccName, nameParent,
- isExternalName, nameParent_maybe, isWiredInName,
- NamedThing(..) )
+ isExternalName, isInternalName, nameParent_maybe, isWiredInName,
+ isImplicitName, NamedThing(..) )
import NameEnv
import NameSet
import OccName ( OccName, OccEnv, mkOccEnv, lookupOccEnv, emptyOccEnv,
extendOccSet, extendOccSetList,
isEmptyOccSet, intersectOccSet, intersectsOccSet,
occNameFS, isTcOcc )
-import TyCon ( tyConDataCons, isNewTyCon, newTyConRep )
-import Class ( classSelIds )
-import DataCon ( dataConName, dataConFieldLabels )
import Module ( Module, moduleFS,
- ModLocation(..), mkSysModuleFS, moduleUserString,
+ ModLocation(..), mkModuleFS, moduleString,
ModuleEnv, emptyModuleEnv, lookupModuleEnv,
extendModuleEnv_C
)
import Outputable
-import DriverUtil ( createDirectoryHierarchy, directoryOf )
+import Util ( createDirectoryHierarchy, directoryOf )
import Util ( sortLe, seqList )
import Binary ( getBinFileWithDict )
import BinIface ( writeBinIface, v_IgnoreHiWay )
import DATA_IOREF ( writeIORef )
import Monad ( when )
import List ( insert )
-import Maybes ( orElse, mapCatMaybes, isNothing, fromJust, expectJust )
+import Maybes ( orElse, mapCatMaybes, isNothing, isJust,
+ fromJust, expectJust, MaybeErr(..) )
\end{code}
\begin{code}
mkIface :: HscEnv
- -> ModLocation
-> Maybe ModIface -- The old interface, if we have it
- -> ModGuts -- The compiled, tidied module
- -> IO ModIface -- The new one, complete with decls and versions
--- mkFinalIface
--- a) completes the interface
--- b) writes it out to a file if necessary
-
-mkIface hsc_env location maybe_old_iface
- guts@ModGuts{ mg_module = this_mod,
- mg_usages = usages,
- mg_deps = deps,
- mg_exports = exports,
+ -> ModGuts -- Usages, deprecations, etc
+ -> ModDetails -- The trimmed, tidied interface
+ -> IO (ModIface, -- The new one, complete with decls and versions
+ Bool) -- True <=> there was an old Iface, and the new one
+ -- is identical, so no need to write it
+
+mkIface hsc_env maybe_old_iface
+ (ModGuts{ mg_module = this_mod,
+ mg_boot = is_boot,
+ mg_usages = usages,
+ mg_deps = deps,
+ mg_home_mods = home_mods,
+ mg_rdr_env = rdr_env,
mg_fix_env = fix_env,
- mg_deprecs = src_deprecs,
- mg_insts = insts,
- mg_rules = rules,
- mg_types = type_env }
+ mg_deprecs = src_deprecs })
+ (ModDetails{ md_insts = insts,
+ md_rules = rules,
+ md_types = type_env,
+ md_exports = exports })
+
+-- NB: notice that mkIface does not look at the bindings
+-- only at the TypeEnv. The previous Tidy phase has
+-- put exactly the info into the TypeEnv that we want
+-- to expose in the interface
+
= do { eps <- hscEPS hsc_env
- ; let { ext_nm = mkExtNameFn hsc_env eps this_mod
- ; local_things = [thing | thing <- typeEnvElts type_env,
- not (isWiredInName (getName thing)) ]
- -- Do not export anything about wired-in things
- -- (GHC knows about them already)
-
- ; abstract_tcs :: NameSet -- TyCons and Classes whose representation is not exposed
- ; abstract_tcs
- | not omit_prags = emptyNameSet -- In the -O case, nothing is abstract
- | otherwise = mkNameSet [ getName thing
- | thing <- local_things
- , not (mustExposeThing exports thing)]
-
- ; decls = [ tyThingToIfaceDecl omit_prags abstract_tcs ext_nm thing
- | thing <- local_things, wantDeclFor exports abstract_tcs thing ]
- -- Don't put implicit Ids and class tycons in the interface file
-
- ; fixities = [(occ,fix) | FixItem occ fix _ <- nameEnvElts fix_env]
- ; deprecs = mkIfaceDeprec src_deprecs
- ; iface_rules
- | omit_prags = []
- | otherwise = sortLe le_rule $
- map (coreRuleToIfaceRule this_mod ext_nm) rules
- ; iface_insts = sortLe le_inst (map dfunToIfaceInst insts)
+ ; let { ext_nm_rhs = mkExtNameFn hsc_env home_mods eps this_mod
+ ; ext_nm_lhs = mkLhsNameFn this_mod
+
+ ; decls = [ tyThingToIfaceDecl ext_nm_rhs thing
+ | thing <- typeEnvElts type_env,
+ not (isImplicitName (getName thing)) ]
+ -- Don't put implicit Ids and class tycons in the interface file
+
+ ; fixities = [(occ,fix) | FixItem occ fix _ <- nameEnvElts fix_env]
+ ; deprecs = mkIfaceDeprec src_deprecs
+ ; iface_rules = map (coreRuleToIfaceRule ext_nm_lhs ext_nm_rhs) rules
+ ; iface_insts = map (instanceToIfaceInst ext_nm_lhs) insts
; intermediate_iface = ModIface {
mi_module = this_mod,
- mi_package = ThisPackage,
- mi_boot = False,
+ mi_package = HomePackage,
+ mi_boot = is_boot,
mi_deps = deps,
mi_usages = usages,
mi_exports = mkIfaceExports exports,
- mi_insts = iface_insts,
- mi_rules = iface_rules,
+ mi_insts = sortLe le_inst iface_insts,
+ mi_rules = sortLe le_rule iface_rules,
mi_fixities = fixities,
mi_deprecs = deprecs,
-
+ mi_globals = Just rdr_env,
+
-- Left out deliberately: filled in by addVersionInfo
mi_mod_vers = initialVersion,
mi_exp_vers = initialVersion,
mi_fix_fn = mkIfaceFixCache fixities }
-- Add version information
- ; (new_iface, no_change_at_all, pp_diffs)
+ ; (new_iface, no_change_at_all, pp_diffs, pp_orphs)
= _scc_ "versioninfo"
addVersionInfo maybe_old_iface intermediate_iface decls
}
- -- Write the interface file, if necessary
- ; when (not no_change_at_all && ghci_mode /= Interactive) $ do
- createDirectoryHierarchy (directoryOf hi_file_path)
- writeBinIface hi_file_path new_iface
-
-- Debug printing
+ ; when (isJust pp_orphs && dopt Opt_WarnOrphans dflags)
+ (printDump (fromJust pp_orphs))
; when (dopt Opt_D_dump_hi_diffs dflags) (printDump pp_diffs)
; dumpIfSet_dyn dflags Opt_D_dump_hi "FINAL INTERFACE"
(pprModIface new_iface)
- ; return new_iface }
+ ; return (new_iface, no_change_at_all) }
where
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
- hi_file_path = ml_hi_file location
- omit_prags = dopt Opt_OmitInterfacePragmas dflags
+ dflags = hsc_dflags hsc_env
+ deliberatelyOmitted x = panic ("Deliberately omitted: " ++ x)
-mustExposeThing :: NameSet -> TyThing -> Bool
--- We are compiling without -O, and thus trying to write as little as
--- possible into the interface file. But we must expose the details of
--- any data types and classes whose constructors, fields, methods are
--- visible to an importing module
-mustExposeThing exports (ATyCon tc)
- = any exported_data_con (tyConDataCons tc)
- -- Expose rep if any datacon or field is exported
-
- || (isNewTyCon tc && isFFITy (snd (newTyConRep tc)))
- -- Expose the rep for newtypes if the rep is an FFI type.
- -- For a very annoying reason. 'Foreign import' is meant to
- -- be able to look through newtypes transparently, but it
- -- can only do that if it can "see" the newtype representation
- where
- exported_data_con con
- = any (`elemNameSet` exports) (dataConName con : dataConFieldLabels con)
-
-mustExposeThing exports (AClass cls)
- = any exported_class_op (classSelIds cls)
- where -- Expose rep if any classs op is exported
- exported_class_op op = getName op `elemNameSet` exports
-
-mustExposeThing exports other = False
-
-
-wantDeclFor :: NameSet -- User-exported things
- -> NameSet -- Abstract things
- -> TyThing -> Bool
-wantDeclFor exports abstracts thing
- | Just parent <- nameParent_maybe name -- An implicit thing
- = parent `elemNameSet` abstracts && name `elemNameSet` exports
+-----------------------------
+writeIfaceFile :: HscEnv -> ModLocation -> ModIface -> Bool -> IO ()
+-- Write the interface file, if necessary
+writeIfaceFile hsc_env location new_iface no_change_at_all
+ | no_change_at_all = return ()
+ | ghc_mode == Interactive = return ()
+ | ghc_mode == JustTypecheck = return ()
| otherwise
- = True
+ = do { createDirectoryHierarchy (directoryOf hi_file_path)
+ ; writeBinIface hi_file_path new_iface }
where
- name = getName thing
-
+ ghc_mode = ghcMode (hsc_dflags hsc_env)
+ hi_file_path = ml_hi_file location
-deliberatelyOmitted x = panic ("Deliberately omitted: " ++ x)
-----------------------------
-mkExtNameFn :: HscEnv -> ExternalPackageState -> Module -> Name -> IfaceExtName
-mkExtNameFn hsc_env eps this_mod
+mkExtNameFn :: HscEnv -> HomeModules -> ExternalPackageState -> Module -> Name -> IfaceExtName
+mkExtNameFn hsc_env hmods eps this_mod
= ext_nm
where
- dflags = hsc_dflags hsc_env
hpt = hsc_HPT hsc_env
pit = eps_PIT eps
Nothing -> LocalTop occ
Just par -> LocalTopSub occ (nameOccName par)
| isWiredInName name = ExtPkg mod occ
- | isHomeModule dflags mod = HomePkg mod occ vers
+ | isHomeModule hmods mod = HomePkg mod occ vers
| otherwise = ExtPkg mod occ
where
mod = nameModule name
iface = lookupIfaceByModule hpt pit mod `orElse`
pprPanic "lookupVers2" (ppr mod <+> ppr occ)
+
+---------------------
+-- mkLhsNameFn ignores versioning info altogether
+-- It is used for the LHS of instance decls and rules, where we
+-- there's no point in recording version info
+mkLhsNameFn :: Module -> Name -> IfaceExtName
+mkLhsNameFn this_mod name
+ | isInternalName name = pprTrace "mkLhsNameFn: unexpected internal" (ppr name) $
+ LocalTop occ -- Should not happen
+ | mod == this_mod = LocalTop occ
+ | otherwise = ExtPkg mod occ
+ where
+ mod = nameModule name
+ occ = nameOccName name
+
+
-----------------------------
-- Compute version numbers for local decls
-> [IfaceDecl] -- The new decls
-> (ModIface,
Bool, -- True <=> no changes at all; no need to write new Iface
- SDoc) -- Differences
+ SDoc, -- Differences
+ Maybe SDoc) -- Warnings about orphans
addVersionInfo Nothing new_iface new_decls
-- No old interface, so definitely write a new one!
- = (new_iface { mi_orphan = anyNothing getInstKey (mi_insts new_iface)
- || anyNothing getRuleKey (mi_rules new_iface),
+ = (new_iface { mi_orphan = anyNothing ifInstOrph (mi_insts new_iface)
+ || anyNothing ifRuleOrph (mi_rules new_iface),
mi_decls = [(initialVersion, decl) | decl <- new_decls],
mi_ver_fn = \n -> Just initialVersion },
- False, ptext SLIT("No old interface file") $$
- pprOrphans orph_insts orph_rules)
+ False,
+ ptext SLIT("No old interface file"),
+ pprOrphans orph_insts orph_rules)
where
- orph_insts = filter (isNothing . getInstKey) (mi_insts new_iface)
- orph_rules = filter (isNothing . getRuleKey) (mi_rules new_iface)
+ orph_insts = filter (isNothing . ifInstOrph) (mi_insts new_iface)
+ orph_rules = filter (isNothing . ifRuleOrph) (mi_rules new_iface)
addVersionInfo (Just old_iface@(ModIface { mi_mod_vers = old_mod_vers,
mi_exp_vers = old_exp_vers,
new_iface@(ModIface { mi_fix_fn = new_fixities })
new_decls
- | no_change_at_all = (old_iface, True, ptext SLIT("Interface file unchanged") $$ pp_orphs)
+ | no_change_at_all = (old_iface, True, ptext SLIT("Interface file unchanged"), pp_orphs)
| otherwise = (final_iface, False, vcat [ptext SLIT("Interface file has changed"),
- nest 2 pp_diffs,
- text "" $$ pp_orphs])
+ nest 2 pp_diffs], pp_orphs)
where
final_iface = new_iface { mi_mod_vers = bump_unless no_output_change old_mod_vers,
mi_exp_vers = bump_unless no_export_change old_exp_vers,
decls_w_vers = [(add_vers decl, decl) | decl <- new_decls]
-------------------
- (old_non_orph_insts, old_orph_insts) = mkRuleMap getInstKey (mi_insts old_iface)
- (new_non_orph_insts, new_orph_insts) = mkRuleMap getInstKey (mi_insts new_iface)
+ (old_non_orph_insts, old_orph_insts) = mkOrphMap ifInstOrph (mi_insts old_iface)
+ (new_non_orph_insts, new_orph_insts) = mkOrphMap ifInstOrph (mi_insts new_iface)
same_insts occ = eqMaybeBy (eqListBy eqIfInst)
(lookupOccEnv old_non_orph_insts occ)
(lookupOccEnv new_non_orph_insts occ)
- (old_non_orph_rules, old_orph_rules) = mkRuleMap getRuleKey (mi_rules old_iface)
- (new_non_orph_rules, new_orph_rules) = mkRuleMap getRuleKey (mi_rules new_iface)
+ (old_non_orph_rules, old_orph_rules) = mkOrphMap ifRuleOrph (mi_rules old_iface)
+ (new_non_orph_rules, new_orph_rules) = mkOrphMap ifRuleOrph (mi_rules new_iface)
same_rules occ = eqMaybeBy (eqListBy eqIfRule)
(lookupOccEnv old_non_orph_rules occ)
(lookupOccEnv new_non_orph_rules occ)
pp_orphs = pprOrphans new_orph_insts new_orph_rules
pprOrphans insts rules
- = vcat [if null insts then empty else
- ptext SLIT("Orphan instances:") <+> vcat (map ppr insts),
- if null rules then empty else
- ptext SLIT("Orphan rules:") <+> vcat (map ppr rules)]
+ | null insts && null rules = Nothing
+ | otherwise
+ = Just $ vcat [
+ if null insts then empty else
+ hang (ptext SLIT("Warning: orphan instances:"))
+ 2 (vcat (map ppr insts)),
+ if null rules then empty else
+ hang (ptext SLIT("Warning: orphan rules:"))
+ 2 (vcat (map ppr rules))
+ ]
computeChangedOccs :: [(OccName, IfaceEq)] -> OccSet
computeChangedOccs eq_info
changedWrt so_far (EqBut kids) = so_far `intersectsOccSet` kids
----------------------
--- mkRuleMap partitions instance decls or rules into
+-- mkOrphMap partitions instance decls or rules into
-- (a) an OccEnv for ones that are not orphans,
-- mapping the local OccName to a list of its decls
-- (b) a list of orphan decls
-mkRuleMap :: (decl -> Maybe OccName) -- (Just occ) for a non-orphan decl, keyed by occ
+mkOrphMap :: (decl -> Maybe OccName) -- (Just occ) for a non-orphan decl, keyed by occ
-- Nothing for an orphan decl
-> [decl] -- Sorted into canonical order
-> (OccEnv [decl], -- Non-orphan decls associated with their key;
-- each sublist in canonical order
[decl]) -- Orphan decls; in canonical order
-mkRuleMap get_key decls
+mkOrphMap get_key decls
= foldl go (emptyOccEnv, []) decls
where
go (non_orphs, orphs) d
= (extendOccEnv_C (\ ds _ -> d:ds) non_orphs occ [d], orphs)
| otherwise = (non_orphs, d:orphs)
--- getXxKey: find at least one local OccName that belongs to this decl
-
-getInstKey :: IfaceInst -> Maybe OccName
-getInstKey (IfaceInst {ifInstHead = inst_ty})
- = case [occ | LocalTop occ <- cls_ext : tc_exts] of
- [] -> Nothing
- (occ:_) -> Just occ
- where
- (cls_ext, tcs) = ifaceInstGates inst_ty
- tc_exts = [tc | IfaceTc tc <- tcs]
- -- Ignore the wired-in IfaceTyCons; the class will do as the key
-
-getRuleKey :: IfaceRule -> Maybe OccName
-getRuleKey (IfaceRule {ifRuleHead = LocalTop occ}) = Just occ
-getRuleKey other = Nothing
-
anyNothing :: (a -> Maybe b) -> [a] -> Bool
anyNothing p [] = False
anyNothing p (x:xs) = isNothing (p x) || anyNothing p xs
\begin{code}
mkUsageInfo :: HscEnv
- -> ModuleEnv (Module, Maybe Bool, SrcSpan)
+ -> HomeModules
+ -> ModuleEnv (Module, Bool, SrcSpan)
-> [(Module, IsBootInterface)]
-> NameSet -> IO [Usage]
-mkUsageInfo hsc_env dir_imp_mods dep_mods used_names
+mkUsageInfo hsc_env hmods dir_imp_mods dep_mods used_names
= do { eps <- hscEPS hsc_env
- ; let usages = mk_usage_info (eps_PIT eps) hsc_env
+ ; let usages = mk_usage_info (eps_PIT eps) hsc_env hmods
dir_imp_mods dep_mods used_names
; usages `seqList` return usages }
-- seq the list of Usages returned: occasionally these
-- don't get evaluated for a while and we can end up hanging on to
-- the entire collection of Ifaces.
-mk_usage_info pit hsc_env dir_imp_mods dep_mods proto_used_names
+mk_usage_info pit hsc_env hmods dir_imp_mods dep_mods proto_used_names
= mapCatMaybes mkUsage dep_mods
-- ToDo: do we need to sort into canonical order?
where
- dflags = hsc_dflags hsc_env
hpt = hsc_HPT hsc_env
used_names = mkNameSet $ -- Eliminate duplicates
mod = nameModule name
add_item occs _ = occ:occs
- import_all mod = case lookupModuleEnv dir_imp_mods mod of
- Just (_,imp_all,_) -> isNothing imp_all
- Nothing -> False
+ depend_on_exports mod = case lookupModuleEnv dir_imp_mods mod of
+ Just (_,no_imp,_) -> not no_imp
+ Nothing -> True
-- We want to create a Usage for a home module if
-- a) we used something from; has something in used_names
mkUsage :: (Module, Bool) -> Maybe Usage
mkUsage (mod_name, _)
| isNothing maybe_iface -- We can't depend on it if we didn't
- || not (isHomeModule dflags mod) -- even open the interface!
+ || not (isHomeModule hmods mod) -- even open the interface!
|| (null used_occs
- && not all_imported
+ && isNothing export_vers
&& not orphan_mod)
= Nothing -- Record no usage info
version_env = mi_ver_fn iface
mod_vers = mi_mod_vers iface
rules_vers = mi_rule_vers iface
- all_imported = import_all mod
- export_vers | all_imported = Just (mi_exp_vers iface)
- | otherwise = Nothing
+ export_vers | depend_on_exports mod = Just (mi_exp_vers iface)
+ | otherwise = Nothing
-- The sort is to put them into canonical order
used_occs = lookupModuleEnv ent_map mod `orElse` []
-- Group by module and sort by occurrence
-- This keeps the list in canonical order
mkIfaceExports exports
- = [ (mkSysModuleFS fs, eltsFM avails)
+ = [ (mkModuleFS fs, eltsFM avails)
| (fs, avails) <- fmToList groupFM
]
where
avail_fs = occNameFS (availName avail)
add_avail avail_fm _ = addToFM_C add_item avail_fm avail_fs avail
- add_item (AvailTC p occs) _ = AvailTC p (insert occ occs)
- add_item (Avail n) _ = pprPanic "MkIface.addAvail" (ppr n <+> ppr name)
+ add_item (AvailTC p occs) _ = AvailTC p (List.insert occ occs)
+ add_item (Avail n) _ = pprPanic "MkIface.addAvail" (ppr n <+> ppr name)
\end{code}
\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 " ++ moduleString (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")))
-- If the source has changed and we're in interactive mode, avoid reading
-- an interface; just return the one we might have been supplied with.
getGhciMode `thenM` \ ghci_mode ->
- if (ghci_mode == Interactive) && not source_unchanged then
+ if (ghci_mode == Interactive || ghci_mode == JustTypecheck)
+ && not source_unchanged then
returnM (outOfDate, maybe_iface)
else
-- 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 {
- Left err -> -- Old interface file not found, or garbled; give up
+ Failed err -> -- Old interface file not found, or garbled; give up
traceIf (text "FYI: cannot read old interface file:"
$$ nest 4 err) `thenM_`
returnM (outOfDate, Nothing)
- ; Right iface ->
+ ; Succeeded iface ->
-- We have got the old iface; check its versions
checkVersions source_unchanged iface `thenM` \ recomp ->
-- Instead, get an Either back which we can test
case mb_iface of {
- Left exn -> (out_of_date (sep [ptext SLIT("Can't find version number for module"),
+ Failed exn -> (out_of_date (sep [ptext SLIT("Can't find version number for module"),
ppr mod_name]));
-- Couldn't find or parse a module mentioned in the
-- old interface file. Don't complain -- it might just be that
-- the current module doesn't need that import and it's been deleted
- Right iface ->
+ Succeeded iface ->
let
new_mod_vers = mi_mod_vers iface
new_decl_vers = mi_ver_fn iface
\begin{code}
showIface :: FilePath -> IO ()
--- Raad binary interface, and print it out
+-- Read binary interface, and print it out
showIface filename = do
-- skip the version check; we don't want to worry about profiled vs.
-- non-profiled interfaces, for example.
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")
, pprDeprecs (mi_deprecs iface)
]
where
- ppr_package ThisPackage = empty
- ppr_package (ExternalPackage id) = doubleQuotes (ftext id)
+ pp_boot | mi_boot iface = ptext SLIT("[boot]")
+ | otherwise = empty
+ ppr_package HomePackage = empty
+ ppr_package (ExtPackage id) = doubleQuotes (ppr id)
exp_vers = mi_exp_vers iface
rule_vers = mi_rule_vers iface
projects / ghc-hetmet.git / blobdiff