diff options
-rw-r--r-- | compiler/specialise/Rules.hs | 12 | ||||
-rw-r--r-- | compiler/types/InstEnv.hs | 13 |
2 files changed, 19 insertions, 6 deletions
diff --git a/compiler/specialise/Rules.hs b/compiler/specialise/Rules.hs index cb71e3a3f3..7cf6e56bb7 100644 --- a/compiler/specialise/Rules.hs +++ b/compiler/specialise/Rules.hs @@ -180,9 +180,15 @@ mkRule this_mod is_auto is_local name act fn bndrs args rhs lhs_names = nameSetElems (extendNameSet (exprsOrphNames args) fn) -- TODO: copied from ruleLhsOrphNames - orph = case filter (nameIsLocalOrFrom this_mod) lhs_names of - (n : _) -> NotOrphan (nameOccName n) - [] -> IsOrphan + -- Since rules get eventually attached to one of the free names + -- from the definition when compiling the ABI hash, we should make + -- it deterministic. This chooses the one with minimal OccName + -- as opposed to uniq value. + local_lhs_names = filter (nameIsLocalOrFrom this_mod) lhs_names + anchor = minimum $ map nameOccName local_lhs_names + orph = case local_lhs_names of + (_ : _) -> NotOrphan anchor + [] -> IsOrphan -------------- roughTopNames :: [CoreExpr] -> [Maybe Name] diff --git a/compiler/types/InstEnv.hs b/compiler/types/InstEnv.hs index f810850d4b..db8f531a58 100644 --- a/compiler/types/InstEnv.hs +++ b/compiler/types/InstEnv.hs @@ -236,10 +236,17 @@ mkLocalInstance dfun oflag tvs cls tys do_one (_ltvs, rtvs) = choose_one [ns | (tv,ns) <- cls_tvs `zip` arg_names , not (tv `elem` rtvs)] + -- Since instance declarations get eventually attached to one of the types + -- from the definition when compiling the ABI hash, we should make + -- it deterministic. This chooses the one with minimal OccName + -- as opposed to uniq value. choose_one :: [NameSet] -> IsOrphan - choose_one nss = case nameSetElems (unionNameSets nss) of - [] -> IsOrphan - (n : _) -> NotOrphan (nameOccName n) + choose_one nss = case local_names of + [] -> IsOrphan + (_ : _) -> NotOrphan anchor + where + local_names = nameSetElems (unionNameSets nss) + anchor = minimum $ map nameOccName local_names mkImportedInstance :: Name -> [Maybe Name] |