Commit 7ec07e40 authored by Simon Peyton Jones's avatar Simon Peyton Jones

Slight refactoring to the fix for #4012

Add CoreSyn.chooseOrphanAnchor, and use it
parent 4c8e69e0
......@@ -68,7 +68,7 @@ module CoreSyn (
deAnnotate, deAnnotate', deAnnAlt, collectAnnBndrs,
-- * Orphanhood
IsOrphan(..), isOrphan, notOrphan,
IsOrphan(..), isOrphan, notOrphan, chooseOrphanAnchor,
-- * Core rule data types
CoreRule(..), RuleBase,
......@@ -723,6 +723,21 @@ notOrphan :: IsOrphan -> Bool
notOrphan NotOrphan{} = True
notOrphan _ = False
chooseOrphanAnchor :: [Name] -> IsOrphan
-- Something (rule, instance) is relate to all the Names in this
-- list. Choose one of them to be an "anchor" for the orphan. We make
-- the choice deterministic to avoid gratuitious changes in the ABI
-- hash (Trac #4012). Specficially, use lexicographic comparison of
-- OccName rather than comparing Uniques
--
-- NB: 'minimum' use Ord, and (Ord OccName) works lexicographically
--
chooseOrphanAnchor local_names
| null local_names = IsOrphan
| otherwise = NotOrphan (minimum occs)
where
occs = map nameOccName local_names
instance Binary IsOrphan where
put_ bh IsOrphan = putByte bh 0
put_ bh (NotOrphan n) = do
......
......@@ -45,7 +45,7 @@ import Id
import IdInfo ( SpecInfo( SpecInfo ) )
import VarEnv
import VarSet
import Name ( Name, NamedThing(..), nameIsLocalOrFrom, nameOccName )
import Name ( Name, NamedThing(..), nameIsLocalOrFrom )
import NameSet
import NameEnv
import Unify ( ruleMatchTyX, MatchEnv(..) )
......@@ -185,10 +185,7 @@ mkRule this_mod is_auto is_local name act fn bndrs args rhs
-- 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
orph = chooseOrphanAnchor local_lhs_names
--------------
roughTopNames :: [CoreExpr] -> [Maybe Name]
......
......@@ -29,7 +29,7 @@ module InstEnv (
#include "HsVersions.h"
import CoreSyn (IsOrphan(..), isOrphan, notOrphan)
import CoreSyn ( IsOrphan(..), isOrphan, notOrphan, chooseOrphanAnchor )
import Module
import Class
import Var
......@@ -234,19 +234,9 @@ mkLocalInstance dfun oflag tvs cls tys
mb_ns | null fds = [choose_one arg_names]
| otherwise = map do_one fds
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 local_names of
[] -> IsOrphan
(_ : _) -> NotOrphan anchor
where
local_names = nameSetElems (unionNameSets nss)
anchor = minimum $ map nameOccName local_names
, not (tv `elem` rtvs)]
choose_one nss = chooseOrphanAnchor (nameSetElems (unionNameSets nss))
mkImportedInstance :: Name
-> [Maybe Name]
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment