+\begin{code}
+checkIface :: Maybe ParsedIface -- The old interface, read from M.hi
+ -> ParsedIface -- The new interface; but with all version numbers = 1
+ -> IO (Maybe ParsedIface) -- Nothing => no change; no need to write new Iface
+ -- Just pi => Here is the new interface to write
+ -- with correct version numbers
+ -- The I/O part is just so it can print differences
+
+-- NB: the fixities, declarations, rules are all assumed
+-- to be sorted by increasing order of hsDeclName, so that
+-- we can compare for equality
+
+checkIface Nothing new_iface
+-- No old interface, so definitely write a new one!
+ = return (Just new_iface)
+
+checkIface (Just iface) new_iface
+ | no_output_change && no_usage_change
+ = return Nothing
+
+ | otherwise -- Add updated version numbers
+ = do { dumpIfSet opt_D_dump_hi_diffs "Interface file changes" pp_diffs ;
+ return (Just final_iface )}
+
+ where
+ final_iface = new_iface { pi_vers = new_mod_vers,
+ pi_fixity = (new_fixity_vers, new_fixities),
+ pi_rules = (new_rules_vers, new_rules),
+ pi_decls = final_decls }
+
+ no_usage_change = pi_usages iface == pi_usages new_iface
+
+ no_output_change = no_decl_changed &&
+ new_fixity_vers == fixity_vers &&
+ new_rules_vers == rules_vers &&
+ no_export_change
+
+ no_export_change = pi_exports iface == pi_exports new_iface
+
+ new_mod_vers | no_output_change = mod_vers
+ | otherwise = bumpVersion mod_vers
+
+ mod_vers = pi_vers iface
+
+ (fixity_vers, fixities) = pi_fixity iface
+ (_, new_fixities) = pi_fixity new_iface
+ new_fixity_vers | fixities == new_fixities = fixity_vers
+ | otherwise = bumpVersion fixity_vers
+
+ (rules_vers, rules) = pi_rules iface
+ (_, new_rules) = pi_rules new_iface
+ new_rules_vers | rules == new_rules = rules_vers
+ | otherwise = bumpVersion rules_vers
+
+ (no_decl_changed, pp_diffs, final_decls) = merge_decls True empty [] (pi_decls iface) (pi_decls new_iface)
+
+ -- 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
+ merge_decls ok_so_far pp acc [] [] = (ok_so_far, pp, reverse acc)
+ merge_decls ok_so_far pp acc old [] = (False, pp, reverse acc)
+ merge_decls ok_so_far pp acc [] (nvd:nvds) = merge_decls False (pp $$ only_new nvd) (nvd:acc) [] nvds
+ merge_decls ok_so_far pp acc (vd@(v,d):vds) (nvd@(_,nd):nvds)
+ = case d_name `compare` nd_name of
+ LT -> merge_decls False (pp $$ only_old vd) acc vds (nvd:nvds)
+ GT -> merge_decls False (pp $$ only_new nvd) (nvd:acc) (vd:vds) nvds
+ EQ | d == nd -> merge_decls ok_so_far pp (vd:acc) vds nvds
+ | otherwise -> merge_decls False (pp $$ changed d nd) ((bumpVersion v, nd):acc) vds nvds
+ where
+ d_name = hsDeclName d
+ nd_name = hsDeclName nd