X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Frename%2FRnEnv.lhs;h=b21c42d2f1778bcae9ee44b711acd10bb3809b83;hp=91b1269a2456f87ac73ebf6dc7ce36c5c97ccd9c;hb=a835e9faf19400aa6b7999b6f64e60cb1c7737dd;hpb=24bb49b71bce13faa263386e68d49fc0b05557b7

diff --git a/compiler/rename/RnEnv.lhs b/compiler/rename/RnEnv.lhs
index 91b1269..b21c42d 100644
--- a/compiler/rename/RnEnv.lhs
+++ b/compiler/rename/RnEnv.lhs
@@ -5,7 +5,7 @@
 
 \begin{code}
 module RnEnv ( 
-	newTopSrcBinder, 
+	newTopSrcBinder, lookupFamInstDeclBndr,
 	lookupLocatedBndrRn, lookupBndrRn, 
 	lookupLocatedTopBndrRn, lookupTopBndrRn,
 	lookupLocatedOccRn, lookupOccRn, 
@@ -222,6 +222,28 @@ lookupInstDeclBndr cls_name rdr_name
 newIPNameRn :: IPName RdrName -> TcRnIf m n (IPName Name)
 newIPNameRn ip_rdr = newIPName (mapIPName rdrNameOcc ip_rdr)
 
+-- Looking up family names in type instances is a subtle affair.  The family
+-- may be imported, in which case we need to lookup the occurence of a global
+-- name.  Alternatively, the family may be in the same binding group (and in
+-- fact in a declaration processed later), and we need to create a new top
+-- source binder.
+--
+-- So, also this is strictly speaking an occurence, we cannot raise an error
+-- message yet for instances without a family declaration.  This will happen
+-- during renaming the type instance declaration in RnSource.rnTyClDecl.
+--
+lookupFamInstDeclBndr :: Module -> Located RdrName -> RnM Name
+lookupFamInstDeclBndr mod lrdr_name@(L _ rdr_name)
+  | not (isSrcRdrName rdr_name)
+  = lookupImportedName rdr_name	
+
+  | otherwise
+  =	-- First look up the name in the normal environment.
+   lookupGreRn rdr_name			`thenM` \ mb_gre ->
+   case mb_gre of {
+	Just gre -> returnM (gre_name gre) ;
+	Nothing  -> newTopSrcBinder mod Nothing lrdr_name }
+
 --------------------------------------------------
 --		Occurrences
 --------------------------------------------------