X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcEnv.lhs;h=097253023ec87834af6660fd8dd37730d0a6bf19;hp=e1b9bd31b70c912cf74f7b61754aa43d89c77fb6;hb=3548802de235eca280982270463db84910ee3748;hpb=ec15937afed087f6b134b21012e5ceba71dc6364

diff --git a/compiler/typecheck/TcEnv.lhs b/compiler/typecheck/TcEnv.lhs
index e1b9bd3..0972530 100644
--- a/compiler/typecheck/TcEnv.lhs
+++ b/compiler/typecheck/TcEnv.lhs
@@ -170,10 +170,18 @@ tcLookupFamInst tycon tys
        ; eps <- getEps
        ; let instEnv = (eps_fam_inst_env eps, tcg_fam_inst_env env)
        ; case lookupFamInstEnv instEnv tycon tys of
-	   [(subst,fam_inst)] -> return (rep_tc, substTyVars subst (tyConTyVars rep_tc))
+
+	   [(subst, fam_inst)] | variable_only_subst -> 
+	     return (rep_tc, substTyVars subst (tyConTyVars rep_tc))
 		where	-- NB: assumption is that (tyConTyVars rep_tc) is in 
 			--     the domain of the substitution
-		  rep_tc = famInstTyCon fam_inst 
+		  rep_tc              = famInstTyCon fam_inst
+		  subst_domain        = varEnvElts . getTvSubstEnv $ subst
+		  tvs		      = map (Type.getTyVar "tcLookupFamInst") 
+					    subst_domain
+		  variable_only_subst = all Type.isTyVarTy subst_domain &&
+					sizeVarSet (mkVarSet tvs) == length tvs
+					-- renaming may have no repetitions
 
 	   other -> famInstNotFound tycon tys other
        }
@@ -680,7 +688,7 @@ wrongThingErr expected thing name
 famInstNotFound tycon tys what
   = failWithTc (msg <+> quotes (ppr tycon <+> hsep (map pprParendType tys)))
   where
-    msg = case what of
-		[] -> ptext SLIT("No instance for")
-		xs -> ptext SLIT("More than one instance for")
+    msg = ptext $ if length what > 1 
+		  then SLIT("More than one family instance for")
+		  else SLIT("No family instance exactly matching")
 \end{code}