- core_idinfo = idInfo id
- stg_idinfo = get_idinfo id
-
- ty_pretty = pprType (idType id)
- sig_pretty = hsep [ppr (getOccName id), dcolon, ty_pretty]
-
- prag_pretty
- | opt_OmitInterfacePragmas = empty
- | otherwise = hsep [ptext SLIT("{-##"),
- arity_pretty,
- caf_pretty,
- cpr_pretty,
- strict_pretty,
- wrkr_pretty,
- unfold_pretty,
- ptext SLIT("##-}")]
-
- ------------ Arity --------------
- arity_info = arityInfo stg_idinfo
- arity_pretty = ppArityInfo arity_info
-
- ------------ Caf Info --------------
- caf_pretty = ppCafInfo (cafInfo stg_idinfo)
-
- ------------ CPR Info --------------
- cpr_pretty = ppCprInfo (cprInfo core_idinfo)
-
- ------------ Strictness --------------
- strict_info = strictnessInfo core_idinfo
- bottoming_fn = isBottomingStrictness strict_info
- strict_pretty = ppStrictnessInfo strict_info
-
- ------------ Worker --------------
- work_info = workerInfo core_idinfo
- has_worker = workerExists work_info
- wrkr_pretty = ppWorkerInfo work_info
- Just work_id = work_info
-
-
- ------------ Occ info --------------
- loop_breaker = case occInfo core_idinfo of
- IAmALoopBreaker -> True
- other -> False
-
- ------------ Unfolding --------------
- inline_pragma = inlinePragInfo core_idinfo
- dont_inline = case inline_pragma of
- IMustNotBeINLINEd False Nothing -> True -- Unconditional NOINLINE
- other -> False
-
-
- unfold_pretty | show_unfold = ptext SLIT("__U") <> pprInlinePragInfo inline_pragma <+> pprIfaceUnfolding rhs
- | otherwise = empty
-
- show_unfold = not has_worker && -- Not unnecessary
- not bottoming_fn && -- Not necessary
- not dont_inline &&
- not loop_breaker &&
- rhs_is_small && -- Small enough
- okToUnfoldInHiFile rhs -- No casms etc
-
- rhs_is_small = couldBeSmallEnoughToInline (calcUnfoldingGuidance opt_UF_HiFileThreshold rhs)
-
- ------------ Specialisations --------------
- spec_info = specInfo core_idinfo
-
- ------------ Extra free Ids --------------
- new_needed_ids | opt_OmitInterfacePragmas = emptyVarSet
- | otherwise = worker_ids `unionVarSet`
- unfold_ids `unionVarSet`
- spec_ids
-
- worker_ids | has_worker && interestingId work_id = unitVarSet work_id
- -- Conceivably, the worker might come from
- -- another module
- | otherwise = emptyVarSet
-
- spec_ids = filterVarSet interestingId (rulesRhsFreeVars spec_info)
-
- unfold_ids | show_unfold = find_fvs rhs
- | otherwise = emptyVarSet
-
- find_fvs expr = exprSomeFreeVars interestingId expr
-
- ------------ Sanity checking --------------
- -- The arity of a wrapper function should match its strictness,
- -- or else an importing module will get very confused indeed.
- -- [later: actually all that is necessary is for strictness to exceed arity]
- arity_matches_strictness
- = not has_worker ||
- case strict_info of
- StrictnessInfo ds _ -> length ds >= arityLowerBound arity_info
- other -> True
-
-interestingId id = isId id && isLocallyDefined id &&
- not (omitIfaceSigForId id)
-\end{code}
-
-\begin{code}
-ifaceBinds :: Handle
- -> IdSet -- These Ids are needed already
- -> [Id] -- Ids used at code-gen time; they have better pragma info!
- -> [CoreBind] -- In dependency order, later depend on earlier
- -> IO IdSet -- Set of Ids actually spat out
-
-ifaceBinds hdl needed_ids final_ids binds
- = mapIO (printForIface hdl) (bagToList pretties) >>
- hPutStr hdl "\n" >>
- return emitted
+ final_iface = new_iface { mi_version = new_version }
+ old_mod_vers = vers_module old_version
+ new_version = VersionInfo { vers_module = bumpVersion no_output_change old_mod_vers,
+ vers_exports = bumpVersion no_export_change (vers_exports old_version),
+ vers_rules = bumpVersion no_rule_change (vers_rules old_version),
+ vers_decls = tc_vers }
+
+ no_output_change = no_tc_change && no_rule_change && no_export_change && no_deprec_change
+ no_usage_change = mi_usages old_iface == mi_usages new_iface
+
+ no_export_change = mi_exports old_iface == mi_exports new_iface -- Kept sorted
+ no_rule_change = dcl_rules old_decls == dcl_rules new_decls -- Ditto
+ no_deprec_change = old_deprecs == new_deprecs
+
+ -- Fill in the version number on the new declarations by looking at the old declarations.
+ -- Set the flag if anything changes.
+ -- Assumes that the decls are sorted by hsDeclName.
+ (no_tc_change, pp_tc_diffs, tc_vers) = diffDecls old_version old_fixities new_fixities
+ (dcl_tycl old_decls) (dcl_tycl new_decls)
+ pp_diffs = vcat [pp_tc_diffs,
+ pp_change no_export_change "Export list",
+ pp_change no_rule_change "Rules",
+ pp_change no_deprec_change "Deprecations",
+ pp_change no_usage_change "Usages"]
+ pp_change True what = empty
+ pp_change False what = text what <+> ptext SLIT("changed")
+
+diffDecls :: VersionInfo -- Old version
+ -> FixityEnv -> FixityEnv -- Old and new fixities
+ -> [RenamedTyClDecl] -> [RenamedTyClDecl] -- Old and new decls
+ -> (Bool, -- True <=> no change
+ SDoc, -- Record of differences
+ NameEnv Version) -- New version map
+
+diffDecls (VersionInfo { vers_module = old_mod_vers, vers_decls = old_decls_vers })
+ old_fixities new_fixities old new
+ = diff True empty emptyNameEnv old new