diff --git a/ghc/compiler/basicTypes/Name.lhs b/ghc/compiler/basicTypes/Name.lhs index c895f1814e81a947907ddf77995465a7c06dab62..9c1fee1b124e7f00d7143a030601fb2a578d1a29 100644 --- a/ghc/compiler/basicTypes/Name.lhs +++ b/ghc/compiler/basicTypes/Name.lhs @@ -10,7 +10,8 @@ module Name ( -- The Name type Name, -- Abstract - mkLocalName, mkSysLocalName, mkTopName, + mkLocalName, mkImportedLocalName, mkSysLocalName, + mkTopName, mkDerivedName, mkGlobalName, mkWiredInIdName, mkWiredInTyConName, maybeWiredInIdName, maybeWiredInTyConName, @@ -24,12 +25,12 @@ module Name ( isLocallyDefinedName, isSystemName, isLocalName, isGlobalName, isExternallyVisibleName, - + -- Provenance Provenance(..), ImportReason(..), pprProvenance, ExportFlag(..), PrintUnqualified, - pprNameProvenance, systemProvenance, + pprNameProvenance, systemProvenance, hasBetterProv, -- Class NamedThing and overloaded friends NamedThing(..), @@ -93,6 +94,16 @@ mkLocalName uniq occ loc = Name { n_uniq = uniq, n_sort = Local, n_occ = occ, -- * for interface files we tidyCore first, which puts the uniques -- into the print name (see setNameVisibility below) +mkImportedLocalName :: Unique -> OccName -> SrcLoc -> Name + -- Just the same as mkLocalName, except the provenance is different + -- Reason: this flags the name as one that came in from an interface file. + -- This is useful when trying to decide which of two type variables + -- should 'win' when unifying them. + -- NB: this is only for non-top-level names, so we use ImplicitImport +mkImportedLocalName uniq occ loc = Name { n_uniq = uniq, n_sort = Local, n_occ = occ, + n_prov = NonLocalDef ImplicitImport True } + + mkGlobalName :: Unique -> Module -> OccName -> Provenance -> Name mkGlobalName uniq mod occ prov = Name { n_uniq = uniq, n_sort = Global mod, n_occ = occ, n_prov = prov } @@ -419,6 +430,15 @@ isGlobalName other = True -- does not mean visible at the source level (that's isExported). isExternallyVisibleName name = isGlobalName name +hasBetterProv :: Name -> Name -> Bool +hasBetterProv name1 name2 + = case n_prov name1 of + LocalDef _ _ -> True + SystemProv -> False + NonLocalDef _ _ -> case n_prov name2 of + LocalDef _ _ -> False + other -> True + isSystemName (Name {n_prov = SystemProv}) = True isSystemName other = False \end{code} diff --git a/ghc/compiler/typecheck/TcUnify.lhs b/ghc/compiler/typecheck/TcUnify.lhs index 6fd0ba76a1e0f04a7698045748d96a2a6591bea6..f7a78e57c3681cefaab0b7a2b5255835de106a7e 100644 --- a/ghc/compiler/typecheck/TcUnify.lhs +++ b/ghc/compiler/typecheck/TcUnify.lhs @@ -24,7 +24,7 @@ import Type ( Type(..), tyVarsOfType, funTyCon, ) import TyCon ( TyCon, isTupleTyCon, isUnboxedTupleTyCon, tyConArity ) -import Name ( isSystemName ) +import Name ( hasBetterProv ) import Var ( TyVar, tyVarKind, varName ) import VarEnv import VarSet ( varSetElems ) @@ -272,8 +272,7 @@ uUnboundVar swapped tv1 maybe_ty1 ps_ty2 ty2@(TyVarTy tv2) Nothing -> checkKinds swapped tv1 ty2 `thenTc_` -- Try to update sys-y type variables in preference to sig-y ones - -- (the latter respond False to isSystemName) - if isSystemName (varName tv2) then + if varName tv1 `hasBetterProv` varName tv2 then tcPutTyVar tv2 (TyVarTy tv1) `thenNF_Tc_` returnTc () else