[project @ 1999-03-17 10:06:21 by simonpj]

Make it so that Local (i.e. non-top-level) names record
whether they originally came from an interface file.  This
means that when unifying two type variables we can readily
choose one that occurred in the source, rather than one
imported from an interface file.  That in turn improves
compiler error messages.  E.g.

  rd :: (RealFloat a, RealFrac b) => b -> Transformation a
  rd degrees  = r ((degrees / 180.0) * pi)

used to say

    Could not deduce `Floating a'
	(arising from use of `pi' at Foo.hs:11)
	from the context: (RealFloat a1, RealFrac a)
    Probable cause: missing `Floating a' in type signature for `rd'

[here the 'a' came from the signature for 'pi' in PrelBase;
 the 'a1' is a renamed version of the 'a' in the source pgm]

but now says

    Could not deduce `Floating b'
	(arising from use of `pi' at Foo.hs:11)
	from the context: (RealFloat a, RealFrac b)
    Probable cause: missing `Floating b' in type signature for `rd'

diff --git a/ghc/compiler/basicTypes/Name.lhs b/ghc/compiler/basicTypes/Name.lhs
index c895f18..9c1fee1 100644 (file)
--- 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 6fd0ba7..f7a78e5 100644 (file)
--- 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