------------------------------------------------------------------------------
--- Compute version numbers for local decls
-
-addVersionInfo
- :: (Name -> (OccName,Version)) -- lookup parents and versions of names
- -> Maybe ModIface -- The old interface, read from M.hi
- -> ModIface -- The new interface (lacking decls)
- -> [IfaceDecl] -- The new decls
- -> (ModIface, -- Updated interface
- Bool, -- True <=> no changes at all; no need to write Iface
- SDoc, -- Differences
- Maybe SDoc) -- Warnings about orphans
-
-addVersionInfo ver_fn Nothing new_iface new_decls
--- No old interface, so definitely write a new one!
- = (new_iface { mi_orphan = not (null orph_insts && null orph_rules)
- , mi_finsts = not . null $ mi_fam_insts new_iface
- , mi_decls = [(initialVersion, decl) | decl <- new_decls]
- , mi_ver_fn = mkIfaceVerCache (zip (repeat initialVersion)
- new_decls)
- },
- False,
- ptext SLIT("No old interface file"),
- pprOrphans orph_insts orph_rules)
- where
- orph_insts = filter (isNothing . ifInstOrph) (mi_insts new_iface)
- orph_rules = filter (isNothing . ifRuleOrph) (mi_rules new_iface)
-
-addVersionInfo ver_fn (Just old_iface@(ModIface {
- mi_mod_vers = old_mod_vers,
- mi_exp_vers = old_exp_vers,
- mi_rule_vers = old_rule_vers,
- mi_decls = old_decls,
- mi_ver_fn = old_decl_vers,
- mi_fix_fn = old_fixities }))
- new_iface@(ModIface { mi_fix_fn = new_fixities })
- new_decls
- | 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], 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,
- mi_rule_vers = bump_unless no_rule_change old_rule_vers,
- mi_orphan = not (null new_orph_rules && null new_orph_insts),
- mi_finsts = not . null $ mi_fam_insts new_iface,
- mi_decls = decls_w_vers,
- mi_ver_fn = mkIfaceVerCache decls_w_vers }
-
- decls_w_vers = [(add_vers decl, decl) | decl <- new_decls]
-
- -------------------
- (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)
- old_fam_insts = mi_fam_insts old_iface
- new_fam_insts = mi_fam_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) =
- 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)
- -------------------
- -- Computing what changed
- no_output_change = no_decl_change && no_rule_change &&
- no_export_change && no_deprec_change
- no_export_change = mi_exports new_iface == mi_exports old_iface
- -- Kept sorted
- no_decl_change = isEmptyOccSet changed_occs
- no_rule_change = not (changedWrtNames changed_occs (eqListBy eqIfRule old_orph_rules new_orph_rules)
- || changedWrtNames changed_occs (eqListBy eqIfInst old_orph_insts new_orph_insts)
- || changedWrtNames changed_occs (eqListBy eqIfFamInst old_fam_insts new_fam_insts))
- no_deprec_change = mi_deprecs new_iface == mi_deprecs old_iface
-
- -- If the usages havn't changed either, we don't need to write the interface file
- no_other_changes = mi_usages new_iface == mi_usages old_iface &&
- mi_deps new_iface == mi_deps old_iface &&
- mi_hpc new_iface == mi_hpc old_iface
- no_change_at_all = no_output_change && no_other_changes
-
- pp_diffs = vcat [pp_change no_export_change "Export list"
- (ppr old_exp_vers <+> arrow <+> ppr (mi_exp_vers final_iface)),
- pp_change no_rule_change "Rules"
- (ppr old_rule_vers <+> arrow <+> ppr (mi_rule_vers final_iface)),
- pp_change no_deprec_change "Deprecations" empty,
- pp_change no_other_changes "Usages" empty,
- pp_decl_diffs]
- pp_change True what info = empty
- pp_change False what info = text what <+> ptext SLIT("changed") <+> info
-
- -------------------
- old_decl_env = mkOccEnv [(ifName decl, decl) | (_,decl) <- old_decls]
- same_fixity n = bool (old_fixities n == new_fixities n)
-
- -------------------
- -- Adding version info
- new_version = bumpVersion old_mod_vers
- -- Start from the old module version, not from
- -- zero so that if you remove f, and then add
- -- it again, you don't thereby reduce f's
- -- version number
-
- add_vers decl | occ `elemOccSet` changed_occs = new_version
- | otherwise = snd (expectJust "add_vers" (old_decl_vers occ))
- -- If it's unchanged, there jolly well
- where -- should be an old version number
- occ = ifName decl
-
- -------------------
- -- Deciding which declarations have changed
-
- -- For each local decl, the IfaceEq gives the list of things that
- -- must be unchanged for the declaration as a whole to be unchanged.
- eq_info :: [(OccName, IfaceEq)]
- eq_info = map check_eq new_decls
- check_eq new_decl
- | Just old_decl <- lookupOccEnv old_decl_env occ
- = (occ, new_decl `eqIfDecl` old_decl &&& eq_indirects new_decl)
- | otherwise {- No corresponding old decl -}
- = (occ, NotEqual)
- where
- occ = ifName new_decl
-
- eq_indirects :: IfaceDecl -> IfaceEq
- -- When seeing if two decls are the same, remember to
- -- check whether any relevant fixity or rules have changed
- eq_indirects (IfaceId {ifName = occ}) = eq_ind_occ occ
- eq_indirects (IfaceClass {ifName = cls_occ, ifSigs = sigs})
- = same_insts cls_occ &&&
- eq_ind_occs [op | IfaceClassOp op _ _ <- sigs]
- eq_indirects (IfaceData {ifName = tc_occ, ifCons = cons})
- = same_insts tc_occ &&& same_fixity tc_occ &&& -- The TyCon can have a fixity too
- eq_ind_occs (map ifConOcc (visibleIfConDecls cons))
- eq_indirects other = Equal -- Synonyms and foreign declarations
-
- eq_ind_occ :: OccName -> IfaceEq -- For class ops and Ids; check fixity and rules
- eq_ind_occ occ = same_fixity occ &&& same_rules occ
- eq_ind_occs = foldr ((&&&) . eq_ind_occ) Equal
-
- -- The Occs of declarations that changed.
- changed_occs :: OccSet
- changed_occs = computeChangedOccs ver_fn (mi_module new_iface)
- (mi_usages old_iface) eq_info
-
- -------------------
- -- Diffs
- pp_decl_diffs :: SDoc -- Nothing => no changes
- pp_decl_diffs
- | isEmptyOccSet changed_occs = empty
- | otherwise
- = vcat [ptext SLIT("Changed occs:") <+> ppr (occSetElts changed_occs),
- ptext SLIT("Version change for these decls:"),
- nest 2 (vcat (map show_change new_decls))]
-
- eq_env = mkOccEnv eq_info
- show_change new_decl
- | not (occ `elemOccSet` changed_occs) = empty
- | otherwise
- = vcat [ppr occ <+> ppr (old_decl_vers occ) <+> arrow <+> ppr new_version,
- nest 2 why]
- where
- occ = ifName new_decl
- why = case lookupOccEnv eq_env occ of
- Just (EqBut names) -> sep [ppr occ <> colon, ptext SLIT("Free vars (only) changed:") <> ppr names,
- nest 2 (braces (fsep (map ppr (occSetElts
- (occs `intersectOccSet` changed_occs)))))]
- where occs = mkOccSet (map nameOccName (nameSetToList names))
- Just NotEqual
- | Just old_decl <- lookupOccEnv old_decl_env occ
- -> vcat [ptext SLIT("Old:") <+> ppr old_decl,
- ptext SLIT("New:") <+> ppr new_decl]
- | otherwise
- -> ppr occ <+> ptext SLIT("only in new interface")
- other -> pprPanic "MkIface.show_change" (ppr occ)
-
- pp_orphs = pprOrphans new_orph_insts new_orph_rules