- idinfo = get_idinfo id
- inline_pragma = idWantsToBeINLINEd id
-
- ty_pretty = pprType PprInterface (initNmbr (nmbrType (idType id)))
- sig_pretty = ppBesides [ppr PprInterface (getOccName id), ppPStr SLIT(" :: "), ty_pretty]
-
- prag_pretty | opt_OmitInterfacePragmas = ppNil
- | otherwise = ppCat [arity_pretty, strict_pretty, unfold_pretty]
-
- ------------ Arity --------------
- arity_pretty = ppArityInfo PprInterface (arityInfo idinfo)
-
- ------------ Strictness --------------
- strict_info = strictnessInfo idinfo
- maybe_worker = getWorkerId_maybe strict_info
- strict_pretty = ppStrictnessInfo PprInterface strict_info
-
- ------------ Unfolding --------------
- unfold_pretty | show_unfold = ppCat [ppStr "_U_", pprIfaceUnfolding rhs]
- | otherwise = ppNil
-
- show_unfold = not implicit_unfolding && -- Unnecessary
- (inline_pragma || not dodgy_unfolding) -- Dangerous
-
- implicit_unfolding = maybeToBool maybe_worker ||
- bottomIsGuaranteed strict_info
-
- dodgy_unfolding = is_rec || -- No recursive unfoldings please!
- case guidance of -- Too big to show
- UnfoldNever -> True
- other -> False
-
- guidance = calcUnfoldingGuidance inline_pragma
- opt_InterfaceUnfoldThreshold
- rhs
-
-
- ------------ Extra free Ids --------------
- new_needed_ids = (needed_ids `minusIdSet` unitIdSet id) `unionIdSets`
- extra_ids
-
- extra_ids | opt_OmitInterfacePragmas = emptyIdSet
- | otherwise = worker_ids `unionIdSets`
- unfold_ids
-
- worker_ids = case maybe_worker of
- Just wkr -> unitIdSet wkr
- Nothing -> emptyIdSet
-
- unfold_ids | show_unfold = free_vars
- | otherwise = emptyIdSet
- where
- (_,free_vars) = addExprFVs interesting emptyIdSet rhs
- interesting bound id = isLocallyDefined id &&
- not (id `elementOfIdSet` bound) &&
- 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!
- -> [CoreBinding] -- In dependency order, later depend on earlier
- -> IO ()
-
-ifaceBinds hdl needed_ids final_ids binds
- = hPutStr hdl (uppShow 0 (prettyToUn (ppAboves pretties))) >>
- hPutStr hdl "\n"
+ 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
+ -> NameEnv Fixity -> NameEnv Fixity -- 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