%
-% (c) The University of Glasgow 2006
+% (c) The University of Glasgow 2006-2008
% (c) The GRASP/AQUA Project, Glasgow University, 1993-1998
%
\end{code}
-----------------------------------------------
- MkIface.lhs deals with versioning
+ Recompilation checking
-----------------------------------------------
-Here's the fingerprint-related info in an interface file
+A complete description of how recompilation checking works can be
+found in the wiki commentary:
- module Foo xxxxxxxxxxxxxxxx -- module fingerprint
- yyyyyyyyyyyyyyyy -- export list fingerprint
- zzzzzzzzzzzzzzzz -- rule fingerprint
- Usages: -- Version info for what this compilation of Foo imported
- Baz xxxxxxxxxxxxxxxx -- Module version
- [yyyyyyyyyyyyyyyy] -- The export-list version
- -- ( if Foo depended on it)
- (g,zzzzzzzzzzzzzzzz) -- Function and its version
- (T,wwwwwwwwwwwwwwww) -- Type and its version
+ http://hackage.haskell.org/trac/ghc/wiki/Commentary/Compiler/RecompilationAvoidance
- <fingerprint> f :: Int -> Int {- Unfolding: \x -> Wib.t x -}
-
- -----------------------------------------------
- Basic idea
- -----------------------------------------------
+Please read the above page for a top-down description of how this all
+works. Notes below cover specific issues related to the implementation.
Basic idea:
+
* In the mi_usages information in an interface, we record the
fingerprint of each free variable of the module
* In checkOldIface we compare the mi_usages for the module with
the actual fingerprint for all each thing recorded in mi_usages
-Fixities
-~~~~~~~~
-We count A.f as changing if its fixity changes
-
-Rules
-~~~~~
-If a rule changes, we want to recompile any module that might be
-affected by that rule. For non-orphan rules, this is relatively easy.
-If module M defines f, and a rule for f, just arrange that the fingerprint
-for M.f changes if any of the rules for M.f change. Any module
-that does not depend on M.f can't be affected by the rule-change
-either.
-
-Orphan rules (ones whose 'head function' is not defined in M) are
-harder. Here's what we do.
-
- * We have a per-module orphan-rule fingerprint which changes if
- any orphan rule changes. (It's unaffected by non-orphan rules.)
-
- * We record usage info for any orphan module 'below' this one,
- giving the orphan-rule fingerprint. We recompile if this
- changes.
-
-The net effect is that if an orphan rule changes, we recompile every
-module above it. That's very conservative, but it's devilishly hard
-to know what it might affect, so we just have to be conservative.
-
-Instance decls
-~~~~~~~~~~~~~~
-In an iface file we have
- module A where
- instance Eq a => Eq [a] = dfun29
- dfun29 :: ...
-
-We have a fingerprint for dfun29, covering its unfolding
-etc. Suppose we are compiling a module M that imports A only
-indirectly. If typechecking M uses this instance decl, we record the
-dependency on A.dfun29 as if it were a free variable of the module
-(via the tcg_inst_usages accumulator). That means that A will appear
-in M's usage list. If the shape of the instance declaration changes,
-then so will dfun29's fingerprint, triggering a recompilation.
-
-Adding an instance declaration, or changing an instance decl that is
-not currently used, is more tricky. (This really only makes a
-difference when we have overlapping instance decls, because then the
-new instance decl might kick in to override the old one.) We handle
-this in a very similar way that we handle rules above.
-
- * For non-orphan instance decls, identify one locally-defined tycon/class
- mentioned in the decl. Treat the instance decl as part of the defn of that
- tycon/class, so that if the shape of the instance decl changes, so does the
- tycon/class; that in turn will force recompilation of anything that uses
- that tycon/class.
-
- * For orphan instance decls, act the same way as for orphan rules.
- Indeed, we use the same global orphan-rule version number.
-
-mkUsageInfo
-~~~~~~~~~~~
-mkUsageInfo figures out what the ``usage information'' for this
-moudule is; that is, what it must record in its interface file as the
-things it uses.
-
-We produce a line for every module B below the module, A, currently being
-compiled:
- import B <n> ;
-to record the fact that A does import B indirectly. This is used to decide
-to look for B.hi rather than B.hi-boot when compiling a module that
-imports A. This line says that A imports B, but uses nothing in it.
-So we'll get an early bale-out when compiling A if B's fingerprint changes.
-
-The usage information records:
-
-\begin{itemize}
-\item (a) anything reachable from its body code
-\item (b) any module exported with a @module Foo@
-\item (c) anything reachable from an exported item
-\end{itemize}
-
-Why (b)? Because if @Foo@ changes then this module's export list
-will change, so we must recompile this module at least as far as
-making a new interface file --- but in practice that means complete
-recompilation.
-
-Why (c)? Consider this:
-\begin{verbatim}
- module A( f, g ) where | module B( f ) where
- import B( f ) | f = h 3
- g = ... | h = ...
-\end{verbatim}
-
-Here, @B.f@ isn't used in A. Should we nevertheless record @B.f@ in
-@A@'s usages? Our idea is that we aren't going to touch A.hi if it is
-*identical* to what it was before. If anything about @B.f@ changes
-than anyone who imports @A@ should be recompiled in case they use
-@B.f@ (they'll get an early exit if they don't). So, if anything
-about @B.f@ changes we'd better make sure that something in A.hi
-changes, and the convenient way to do that is to record the version
-number @B.f@ in A.hi in the usage list. If B.f changes that'll force a
-complete recompiation of A, which is overkill but it's the only way to
-write a new, slightly different, A.hi.
-
-But the example is tricker. Even if @B.f@ doesn't change at all,
-@B.h@ may do so, and this change may not be reflected in @f@'s version
-number. But with -O, a module that imports A must be recompiled if
-@B.h@ changes! So A must record a dependency on @B.h@. So we treat
-the occurrence of @B.f@ in the export list *just as if* it were in the
-code of A, and thereby haul in all the stuff reachable from it.
-
- *** Conclusion: if A mentions B.f in its export list,
- behave just as if A mentioned B.f in its source code,
- and slurp in B.f and all its transitive closure ***
-
-[NB: If B was compiled with -O, but A isn't, we should really *still*
-haul in all the unfoldings for B, in case the module that imports A *is*
-compiled with -O. I think this is the case.]
-
-SimonM [30/11/2007]: I believe the above is all out of date; the
-current implementation doesn't do it this way. Instead, when any of
-the dependencies of a declaration changes, the version of the
-declaration itself changes.
-
\begin{code}
#include "HsVersions.h"
import IfaceSyn
-import IfaceType
import LoadIface
import Id
import IdInfo
import NewDemand
+import Annotations
import CoreSyn
import CoreFVs
import Class
import InstEnv
import FamInstEnv
import TcRnMonad
+import HsSyn
import HscTypes
import Finder
import DynFlags
import RdrName
import NameEnv
import NameSet
-import OccName
import Module
import BinIface
import ErrUtils
import ListSetOps
import Binary
import Fingerprint
-import Panic
+import Bag
import Control.Monad
import Data.List
-> Maybe Fingerprint -- The old fingerprint, if we have it
-> ModDetails -- The trimmed, tidied interface
-> ModGuts -- Usages, deprecations, etc
- -> IO (ModIface, -- The new one
- Bool) -- True <=> there was an old Iface, and the
+ -> IO (Messages,
+ Maybe (ModIface, -- The new one
+ Bool)) -- True <=> there was an old Iface, and the
-- new one is identical, so no need
-- to write it
mg_dir_imps = dir_imp_mods,
mg_rdr_env = rdr_env,
mg_fix_env = fix_env,
- mg_deprecs = deprecs,
+ mg_warns = warns,
mg_hpc_info = hpc_info }
= mkIface_ hsc_env maybe_old_fingerprint
this_mod is_boot used_names deps rdr_env
- fix_env deprecs hpc_info dir_imp_mods mod_details
-
+ fix_env warns hpc_info dir_imp_mods mod_details
+
-- | make an interface from the results of typechecking only. Useful
-- for non-optimising compilation, or where we aren't generating any
-- object code at all ('HscNothing').
-> Maybe Fingerprint -- The old fingerprint, if we have it
-> ModDetails -- gotten from mkBootModDetails, probably
-> TcGblEnv -- Usages, deprecations, etc
- -> IO (ModIface,
- Bool)
+ -> IO (Messages, Maybe (ModIface, Bool))
mkIfaceTc hsc_env maybe_old_fingerprint mod_details
tc_result@TcGblEnv{ tcg_mod = this_mod,
tcg_src = hsc_src,
tcg_imports = imports,
tcg_rdr_env = rdr_env,
tcg_fix_env = fix_env,
- tcg_deprecs = deprecs,
+ tcg_warns = warns,
tcg_hpc = other_hpc_info
}
= do
let hpc_info = emptyHpcInfo other_hpc_info
mkIface_ hsc_env maybe_old_fingerprint
this_mod (isHsBoot hsc_src) used_names deps rdr_env
- fix_env deprecs hpc_info (imp_mods imports) mod_details
+ fix_env warns hpc_info (imp_mods imports) mod_details
mkUsedNames :: TcGblEnv -> IO NameSet
-- on M.hi-boot, and hence that we should do the hi-boot consistency
-- check.)
- -- Modules don't compare lexicographically usually,
- -- but we want them to do so here.
- le_mod :: Module -> Module -> Bool
- le_mod m1 m2 = moduleNameFS (moduleName m1)
- <= moduleNameFS (moduleName m2)
-
- le_dep_mod :: (ModuleName, IsBootInterface)
- -> (ModuleName, IsBootInterface) -> Bool
- le_dep_mod (m1,_) (m2,_) = moduleNameFS m1 <= moduleNameFS m2
-
-
pkgs | th_used = insertList thPackageId (imp_dep_pkgs imports)
| otherwise = imp_dep_pkgs imports
- return Deps { dep_mods = sortLe le_dep_mod dep_mods,
- dep_pkgs = sortLe (<=) pkgs,
- dep_orphs = sortLe le_mod (imp_orphs imports),
- dep_finsts = sortLe le_mod (imp_finsts imports) }
+ return Deps { dep_mods = sortBy (stableModuleNameCmp `on` fst) dep_mods,
+ dep_pkgs = sortBy stablePackageIdCmp pkgs,
+ dep_orphs = sortBy stableModuleCmp (imp_orphs imports),
+ dep_finsts = sortBy stableModuleCmp (imp_finsts imports) }
-- sort to get into canonical order
-
+ -- NB. remember to use lexicographic ordering
mkIface_ :: HscEnv -> Maybe Fingerprint -> Module -> IsBootInterface
-> NameSet -> Dependencies -> GlobalRdrEnv
- -> NameEnv FixItem -> Deprecations -> HpcInfo
+ -> NameEnv FixItem -> Warnings -> HpcInfo
-> ImportedMods
-> ModDetails
- -> IO (ModIface, Bool)
+ -> IO (Messages, Maybe (ModIface, Bool))
mkIface_ hsc_env maybe_old_fingerprint
- this_mod is_boot used_names deps rdr_env fix_env src_deprecs hpc_info
+ this_mod is_boot used_names deps rdr_env fix_env src_warns hpc_info
dir_imp_mods
ModDetails{ md_insts = insts,
md_fam_insts = fam_insts,
md_rules = rules,
+ md_anns = anns,
md_vect_info = vect_info,
md_types = type_env,
md_exports = exports }
-- Sigh: see Note [Root-main Id] in TcRnDriver
; fixities = [(occ,fix) | FixItem occ fix <- nameEnvElts fix_env]
- ; deprecs = src_deprecs
+ ; warns = src_warns
; iface_rules = map (coreRuleToIfaceRule this_mod) rules
; iface_insts = map instanceToIfaceInst insts
; iface_fam_insts = map famInstToIfaceFamInst fam_insts
mi_vect_info = iface_vect_info,
mi_fixities = fixities,
- mi_deprecs = deprecs,
+ mi_warns = warns,
+ mi_anns = mkIfaceAnnotations anns,
mi_globals = Just rdr_env,
-- Left out deliberately: filled in by addVersionInfo
mi_hpc = isHpcUsed hpc_info,
-- And build the cached values
- mi_dep_fn = mkIfaceDepCache deprecs,
+ mi_warn_fn = mkIfaceWarnCache warns,
mi_fix_fn = mkIfaceFixCache fixities }
}
- ; (new_iface, no_change_at_all, pp_orphs)
+ ; (new_iface, no_change_at_all)
<- {-# SCC "versioninfo" #-}
addFingerprints hsc_env maybe_old_fingerprint
intermediate_iface decls
- -- Debug printing
- ; when (isJust pp_orphs && dopt Opt_WarnOrphans dflags)
- (printDump (expectJust "mkIface" pp_orphs))
+ -- Warn about orphans
+ ; let orph_warnings --- Laziness means no work done unless -fwarn-orphans
+ | dopt Opt_WarnOrphans dflags = rule_warns `unionBags` inst_warns
+ | otherwise = emptyBag
+ errs_and_warns = (orph_warnings, emptyBag)
+ unqual = mkPrintUnqualified dflags rdr_env
+ inst_warns = listToBag [ instOrphWarn unqual d
+ | (d,i) <- insts `zip` iface_insts
+ , isNothing (ifInstOrph i) ]
+ rule_warns = listToBag [ ruleOrphWarn unqual this_mod r
+ | r <- iface_rules
+ , isNothing (ifRuleOrph r) ]
+
+ ; if errorsFound dflags errs_and_warns
+ then return ( errs_and_warns, Nothing )
+ else do {
-- XXX ; when (dopt Opt_D_dump_hi_diffs dflags) (printDump pp_diffs)
-
+
+ -- Debug printing
; dumpIfSet_dyn dflags Opt_D_dump_hi "FINAL INTERFACE"
(pprModIface new_iface)
-- with the old GlobalRdrEnv (mi_globals).
; let final_iface = new_iface{ mi_globals = Just rdr_env }
- ; return (final_iface, no_change_at_all) }
+ ; return (errs_and_warns, Just (final_iface, no_change_at_all)) }}
where
r1 `le_rule` r2 = ifRuleName r1 <= ifRuleName r2
i1 `le_inst` i2 = ifDFun i1 `le_occ` ifDFun i2
mkHashFun hsc_env eps
= \name ->
let
- mod = nameModule name
+ mod = ASSERT2( isExternalName name, ppr name ) nameModule name
occ = nameOccName name
iface = lookupIfaceByModule (hsc_dflags hsc_env) hpt pit mod `orElse`
pprPanic "lookupVers2" (ppr mod <+> ppr occ)
-> ModIface -- The new interface (lacking decls)
-> [IfaceDecl] -- The new decls
-> IO (ModIface, -- Updated interface
- Bool, -- True <=> no changes at all;
+ Bool) -- True <=> no changes at all;
-- no need to write Iface
- Maybe SDoc) -- Warnings about orphans
addFingerprints hsc_env mb_old_fingerprint iface0 new_decls
= do
, let out = localOccs $ freeNamesDeclABI abi
]
+ name_module n = ASSERT( isExternalName n ) nameModule n
localOccs = map (getUnique . getParent . getOccName)
- . filter ((== this_mod) . nameModule)
+ . filter ((== this_mod) . name_module)
. nameSetToList
where getParent occ = lookupOccEnv parent_map occ `orElse` occ
where n = ifName d
-- strongly-connected groups of declarations, in dependency order
- groups = stronglyConnComp edges
+ groups = stronglyConnCompFromEdgedVertices edges
global_hash_fn = mkHashFun hsc_env eps
| isWiredInName name = putNameLiterally bh name
-- wired-in names don't have fingerprints
| otherwise
- = let hash | nameModule name /= this_mod = global_hash_fn name
+ = ASSERT( isExternalName name )
+ let hash | nameModule name /= this_mod = global_hash_fn name
| otherwise =
snd (lookupOccEnv local_env (getOccName name)
`orElse` pprPanic "urk! lookup local fingerprint"
let sorted_deps = sortDependencies (mi_deps iface0)
-- the export hash of a module depends on the orphan hashes of the
- -- orphan modules below us in the dependeny tree. This is the way
+ -- orphan modules below us in the dependency tree. This is the way
-- that changes in orphans get propagated all the way up the
-- dependency tree. We only care about orphan modules in the current
-- package, because changes to orphans outside this package will be
(map fst sorted_decls,
export_hash,
orphan_hash,
- mi_deprecs iface0)
+ mi_warns iface0)
-- The interface hash depends on:
-- - the ABI hash, plus
mi_decls = sorted_decls,
mi_hash_fn = lookupOccEnv local_env }
--
- return (final_iface, no_change_at_all, pp_orphs)
+ return (final_iface, no_change_at_all)
where
this_mod = mi_module iface0
-- non-orphans?
fam_insts = mi_fam_insts iface0
fix_fn = mi_fix_fn iface0
- pp_orphs = pprOrphans orph_insts orph_rules
getOrphanHashes :: HscEnv -> [Module] -> IO [Fingerprint]
data IfaceDeclExtras
= IfaceIdExtras Fixity [IfaceRule]
| IfaceDataExtras Fixity [IfaceInstABI] [(Fixity,[IfaceRule])]
- | IfaceClassExtras [IfaceInstABI] [(Fixity,[IfaceRule])]
+ | IfaceClassExtras Fixity [IfaceInstABI] [(Fixity,[IfaceRule])]
+ | IfaceSynExtras Fixity
| IfaceOtherDeclExtras
freeNamesDeclExtras :: IfaceDeclExtras -> NameSet
= unionManyNameSets (map freeNamesIfRule rules)
freeNamesDeclExtras (IfaceDataExtras _ _insts subs)
= unionManyNameSets (map freeNamesSub subs)
-freeNamesDeclExtras (IfaceClassExtras _insts subs)
+freeNamesDeclExtras (IfaceClassExtras _ _insts subs)
= unionManyNameSets (map freeNamesSub subs)
+freeNamesDeclExtras (IfaceSynExtras _)
+ = emptyNameSet
freeNamesDeclExtras IfaceOtherDeclExtras
= emptyNameSet
putByte bh 1; put_ bh fix; put_ bh rules
put_ bh (IfaceDataExtras fix insts cons) = do
putByte bh 2; put_ bh fix; put_ bh insts; put_ bh cons
- put_ bh (IfaceClassExtras insts methods) = do
- putByte bh 3; put_ bh insts; put_ bh methods
+ put_ bh (IfaceClassExtras fix insts methods) = do
+ putByte bh 3; put_ bh fix; put_ bh insts; put_ bh methods
+ put_ bh (IfaceSynExtras fix) = do
+ putByte bh 4; put_ bh fix
put_ bh IfaceOtherDeclExtras = do
- putByte bh 4
+ putByte bh 5
declExtras :: (OccName -> Fixity)
-> OccEnv [IfaceRule]
(map IfaceInstABI $ lookupOccEnvL inst_env n)
(map (id_extras . ifConOcc) (visibleIfConDecls cons))
IfaceClass{ifSigs=sigs} ->
- IfaceClassExtras
+ IfaceClassExtras (fix_fn n)
(map IfaceInstABI $ lookupOccEnvL inst_env n)
[id_extras op | IfaceClassOp op _ _ <- sigs]
+ IfaceSyn{} -> IfaceSynExtras (fix_fn n)
_other -> IfaceOtherDeclExtras
where
n = ifName decl
id_extras occ = (fix_fn occ, lookupOccEnvL rule_env occ)
--- When hashing an instance, we omit the DFun. This is because if a
--- DFun is used it will already have a separate entry in the usages
--- list, and we don't want changes to the DFun to cause the hash of
--- the instnace to change - that would cause unnecessary changes to
--- orphans, for example.
+--
+-- When hashing an instance, we hash only its structure, not the
+-- fingerprints of the things it mentions. See the section on instances
+-- in the commentary,
+-- http://hackage.haskell.org/trac/ghc/wiki/Commentary/Compiler/RecompilationAvoidance
+--
newtype IfaceInstABI = IfaceInstABI IfaceInst
instance Binary IfaceInstABI where
-- used when we want to fingerprint a structure without depending on the
-- fingerprints of external Names that it refers to.
putNameLiterally :: BinHandle -> Name -> IO ()
-putNameLiterally bh name = do
- put_ bh $! nameModule name
- put_ bh $! nameOccName name
+putNameLiterally bh name = ASSERT( isExternalName name )
+ do { put_ bh $! nameModule name
+ ; put_ bh $! nameOccName name }
computeFingerprint :: Binary a
=> DynFlags
return $! readHexFingerprint hash_str
-}
-pprOrphans :: [IfaceInst] -> [IfaceRule] -> Maybe SDoc
-pprOrphans insts 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))
- ]
+instOrphWarn :: PrintUnqualified -> Instance -> WarnMsg
+instOrphWarn unqual inst
+ = mkWarnMsg (getSrcSpan inst) unqual $
+ hang (ptext (sLit "Warning: orphan instance:")) 2 (pprInstanceHdr inst)
+
+ruleOrphWarn :: PrintUnqualified -> Module -> IfaceRule -> WarnMsg
+ruleOrphWarn unqual mod rule
+ = mkWarnMsg silly_loc unqual $
+ ptext (sLit "Orphan rule:") <+> ppr rule
+ where
+ silly_loc = srcLocSpan (mkSrcLoc (moduleNameFS (moduleName mod)) 1 0)
+ -- We don't have a decent SrcSpan for a Rule, not even the CoreRule
+ -- Could readily be fixed by adding a SrcSpan to CoreRule, if we wanted to
----------------------
-- mkOrphMap partitions instance decls or rules into
| otherwise
= case nameModule_maybe name of
Nothing -> pprTrace "mkUsageInfo: internal name?" (ppr name) mv_map
- Just mod -> extendModuleEnv_C (++) mv_map mod [occ]
+ Just mod -> -- We use this fiddly lambda function rather than
+ -- (++) as the argument to extendModuleEnv_C to
+ -- avoid quadratic behaviour (trac #2680)
+ extendModuleEnv_C (\xs _ -> occ:xs) mv_map mod [occ]
where occ = nameOccName name
-- We want to create a Usage for a home module if
\end{code}
\begin{code}
+mkIfaceAnnotations :: [Annotation] -> [IfaceAnnotation]
+mkIfaceAnnotations = map mkIfaceAnnotation
+
+mkIfaceAnnotation :: Annotation -> IfaceAnnotation
+mkIfaceAnnotation (Annotation { ann_target = target, ann_value = serialized }) = IfaceAnnotation {
+ ifAnnotatedTarget = fmap nameOccName target,
+ ifAnnotatedValue = serialized
+ }
+\end{code}
+
+\begin{code}
mkIfaceExports :: [AvailInfo]
-> [(Module, [GenAvailInfo OccName])]
- -- Group by module and sort by occurrence
- -- This keeps the list in canonical order
+ -- Group by module and sort by occurrence
mkIfaceExports exports
= [ (mod, eltsFM avails)
- | (mod, avails) <- fmToList groupFM
+ | (mod, avails) <- sortBy (stableModuleCmp `on` fst)
+ (moduleEnvToList groupFM)
+ -- NB. the fmToList is in a random order,
+ -- because Ord Module is not a predictable
+ -- ordering. Hence we perform a final sort
+ -- using the stable Module ordering.
]
where
-- Group by the module where the exported entities are defined
-- else the plusFM will simply discard one! They
-- should have been combined by now.
add env (Avail n)
- = add_one env (nameModule n) (Avail (nameOccName n))
+ = ASSERT( isExternalName n )
+ add_one env (nameModule n) (Avail (nameOccName n))
add env (AvailTC tc ns)
- = foldl add_for_mod env mods
+ = ASSERT( all isExternalName ns )
+ foldl add_for_mod env mods
where
tc_occ = nameOccName tc
mods = nub (map nameModule ns)
orM = foldr f (return False)
where f m rest = do b <- m; if b then return True else rest
- dep_missing (L _ mod) = do
- find_res <- liftIO $ findImportedModule hsc_env mod Nothing
+ dep_missing (L _ (ImportDecl (L _ mod) pkg _ _ _ _)) = do
+ find_res <- liftIO $ findImportedModule hsc_env mod pkg
case find_res of
Found _ mod
| pkg == this_pkg
-- Instead, get an Either back which we can test
case mb_iface of
- Failed _ -> (out_of_date (sep [ptext (sLit "Couldn't load interface for module"),
- ppr mod]));
- -- 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
- Succeeded iface -> continue iface
+ Failed _ -> (out_of_date (sep [ptext (sLit "Couldn't load interface for module"),
+ ppr mod]))
+ -- 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
+ Succeeded iface -> continue iface
checkModUsage :: PackageId ->Usage -> IfG RecompileRequired
-- Reason: Iface stuff uses OccNames, and the conversion here does
-- not do tidying on the way
tyThingToIfaceDecl (AnId id)
- = IfaceId { ifName = getOccName id,
- ifType = toIfaceType (idType id),
- ifIdInfo = info }
+ = IfaceId { ifName = getOccName id,
+ ifType = toIfaceType (idType id),
+ ifIdDetails = toIfaceIdDetails (idDetails id),
+ ifIdInfo = info }
where
info = case toIfaceIdInfo (idInfo id) of
[] -> NoInfo
| isSynTyCon tycon
= IfaceSyn { ifName = getOccName tycon,
ifTyVars = toIfaceTvBndrs tyvars,
- ifOpenSyn = syn_isOpen,
- ifSynRhs = toIfaceType syn_tyki,
+ ifSynRhs = syn_rhs,
+ ifSynKind = syn_ki,
ifFamInst = famInstToIface (tyConFamInst_maybe tycon)
}
| otherwise = pprPanic "toIfaceDecl" (ppr tycon)
where
tyvars = tyConTyVars tycon
- (syn_isOpen, syn_tyki) = case synTyConRhs tycon of
- OpenSynTyCon ki _ -> (True , ki)
- SynonymTyCon ty -> (False, ty)
+ (syn_rhs, syn_ki)
+ = case synTyConRhs tycon of
+ OpenSynTyCon ki _ -> (Nothing, toIfaceType ki)
+ SynonymTyCon ty -> (Just (toIfaceType ty), toIfaceType (typeKind ty))
ifaceConDecls (NewTyCon { data_con = con }) =
IfNewTyCon (ifaceConDecl con)
ifaceConDecl data_con
= IfCon { ifConOcc = getOccName (dataConName data_con),
ifConInfix = dataConIsInfix data_con,
+ ifConWrapper = isJust (dataConWrapId_maybe data_con),
ifConUnivTvs = toIfaceTvBndrs (dataConUnivTyVars data_con),
ifConExTvs = toIfaceTvBndrs (dataConExTyVars data_con),
ifConEqSpec = to_eq_spec (dataConEqSpec data_con),
do_rough (Just n) = Just (toIfaceTyCon_name n)
dfun_name = idName dfun_id
- mod = nameModule dfun_name
+ mod = ASSERT( isExternalName dfun_name ) nameModule dfun_name
is_local name = nameIsLocalOrFrom mod name
-- Compute orphanhood. See Note [Orphans] in IfaceSyn
- (_, _, cls, tys) = tcSplitDFunTy (idType dfun_id)
+ (_, cls, tys) = tcSplitDFunTy (idType dfun_id)
-- Slightly awkward: we need the Class to get the fundeps
(tvs, fds) = classTvsFds cls
arg_names = [filterNameSet is_local (tyClsNamesOfType ty) | ty <- tys]
orph | is_local cls_name = Just (nameOccName cls_name)
- | all isJust mb_ns = head mb_ns
+ | all isJust mb_ns = ASSERT( not (null mb_ns) ) head mb_ns
| otherwise = Nothing
mb_ns :: [Maybe OccName] -- One for each fundep; a locally-defined name
-- See Note [IdInfo on nested let-bindings] in IfaceSyn
id_info = idInfo id
inline_prag = inlinePragInfo id_info
- prag_info | isAlwaysActive inline_prag = NoInfo
- | otherwise = HasInfo [HsInline inline_prag]
+ prag_info | isDefaultInlinePragma inline_prag = NoInfo
+ | otherwise = HasInfo [HsInline inline_prag]
--------------------------
+toIfaceIdDetails :: IdDetails -> IfaceIdDetails
+toIfaceIdDetails VanillaId = IfVanillaId
+toIfaceIdDetails (DFunId {}) = IfDFunId
+toIfaceIdDetails (RecSelId { sel_naughty = n
+ , sel_tycon = tc }) = IfRecSelId (toIfaceTyCon tc) n
+toIfaceIdDetails other = pprTrace "toIfaceIdDetails" (ppr other)
+ IfVanillaId -- Unexpected
+
toIfaceIdInfo :: IdInfo -> [IfaceInfoItem]
toIfaceIdInfo id_info
= catMaybes [arity_hsinfo, caf_hsinfo, strict_hsinfo,
- inline_hsinfo, wrkr_hsinfo, unfold_hsinfo]
+ inline_hsinfo, unfold_hsinfo]
where
------------ Arity --------------
arity_info = arityInfo id_info
Just sig | not (isTopSig sig) -> Just (HsStrictness sig)
_other -> Nothing
- ------------ Worker --------------
- work_info = workerInfo id_info
- has_worker = workerExists work_info
- wrkr_hsinfo = case work_info of
- HasWorker work_id wrap_arity ->
- Just (HsWorker ((idName work_id)) wrap_arity)
- NoWorker -> Nothing
-
------------ Unfolding --------------
- -- The unfolding is redundant if there is a worker
- unfold_info = unfoldingInfo id_info
- rhs = unfoldingTemplate unfold_info
- no_unfolding = neverUnfold unfold_info
- -- The CoreTidy phase retains unfolding info iff
- -- we want to expose the unfolding, taking into account
- -- unconditional NOINLINE, etc. See TidyPgm.addExternal
- unfold_hsinfo | no_unfolding = Nothing
- | has_worker = Nothing -- Unfolding is implicit
- | otherwise = Just (HsUnfold (toIfaceExpr rhs))
+ unfold_hsinfo = toIfUnfolding (unfoldingInfo id_info)
------------ Inline prag --------------
inline_prag = inlinePragInfo id_info
- inline_hsinfo | isAlwaysActive inline_prag = Nothing
- | no_unfolding && not has_worker = Nothing
- -- If the iface file give no unfolding info, we
- -- don't need to say when inlining is OK!
- | otherwise = Just (HsInline inline_prag)
+ inline_hsinfo | isDefaultInlinePragma inline_prag = Nothing
+ | otherwise = Just (HsInline inline_prag)
+
+--------------------------
+toIfUnfolding :: Unfolding -> Maybe IfaceInfoItem
+toIfUnfolding (CoreUnfolding { uf_tmpl = rhs, uf_arity = arity, uf_guidance = guidance })
+ = case guidance of
+ InlineRule { ug_ir_info = InlSat } -> Just (HsUnfold (IfInlineRule arity True (toIfaceExpr rhs)))
+ InlineRule { ug_ir_info = InlUnSat } -> Just (HsUnfold (IfInlineRule arity False (toIfaceExpr rhs)))
+ InlineRule { ug_ir_info = InlWrapper w } -> Just (HsUnfold (IfWrapper arity (idName w)))
+ UnfoldNever -> Nothing
+ UnfoldIfGoodArgs {} -> Just (HsUnfold (IfCoreUnfold (toIfaceExpr rhs)))
+ UnfoldAlways -> panic "toIfUnfolding:UnfoldAlways"
+ -- Never happens because we never have
+ -- bindings for unfold-always things
+toIfUnfolding (DFunUnfolding _con ops)
+ = Just (HsUnfold (IfDFunUnfold (map toIfaceExpr ops)))
+ -- No need to serialise the data constructor;
+ -- we can recover it from the type of the dfun
+toIfUnfolding _
+ = Nothing
--------------------------
coreRuleToIfaceRule :: Module -> CoreRule -> IfaceRule
---------------------
toIfaceNote :: Note -> IfaceNote
toIfaceNote (SCC cc) = IfaceSCC cc
-toIfaceNote InlineMe = IfaceInlineMe
toIfaceNote (CoreNote s) = IfaceCoreNote s
---------------------
projects / ghc-hetmet.git / blobdiff