\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
#include "HsVersions.h"
import HsSyn
-import Packages ( isHomeModule )
+import Packages ( isHomeModule, PackageIdH(..) )
import IfaceSyn ( IfaceDecl(..), IfaceClassOp(..), IfaceConDecl(..),
IfaceRule(..), IfaceInst(..), IfaceExtName(..), IfaceTyCon(..),
eqIfDecl, eqIfRule, eqIfInst, IfaceEq(..), (&&&), bool,
import TcRnMonad
import TcRnTypes ( mkModDeps )
import TcType ( isFFITy )
-import HscTypes ( ModIface(..), TyThing(..), IfacePackage(..),
+import HscTypes ( ModIface(..), TyThing(..),
ModGuts(..), ModGuts, IfaceExport,
GhciMode(..), HscEnv(..), hscEPS,
Dependencies(..), FixItem(..),
+ ModSummary(..), msHiFilePath,
mkIfaceDepCache, mkIfaceFixCache, mkIfaceVerCache,
typeEnvElts,
GenAvailInfo(..), availName,
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}
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,
; 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_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
}
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)
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
-> [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!
|| anyNothing getRuleKey (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)
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,
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
\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")))
-- 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
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