X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Frename%2FRnEnv.lhs;h=29a87918f81fc32247ea1c25126671f366786518;hp=91b1269a2456f87ac73ebf6dc7ce36c5c97ccd9c;hb=190f24892156953d73b55401d0467a6f1a88ce5d;hpb=39fd94e2727715556805a85a7e803c337df950a9

diff --git a/compiler/rename/RnEnv.lhs b/compiler/rename/RnEnv.lhs
index 91b1269..29a8791 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, 
@@ -14,6 +14,7 @@ module RnEnv (
 	lookupFixityRn, lookupTyFixityRn, lookupLocatedSigOccRn, 
 	lookupLocatedInstDeclBndr,
 	lookupSyntaxName, lookupSyntaxTable, lookupImportedName,
+	lookupGreRn,    
 
 	newLocalsRn, newIPNameRn,
 	bindLocalNames, bindLocalNamesFV,
@@ -222,6 +223,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
 --------------------------------------------------