X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Frename%2FRnNames.lhs;h=31ab4c78c8267d6be722c30a7d64bf3bf27c85db;hb=a357abfc2ed4f0ac6eae1cf542fe4fb3bebe686e;hp=63fd99dde1ae688b645f5f128dbd16bbaf7e814c;hpb=16513d4899e167d20e120c2b3907230b7ff9dd83;p=ghc-hetmet.git

diff --git a/compiler/rename/RnNames.lhs b/compiler/rename/RnNames.lhs
index 63fd99d..31ab4c7 100644
--- a/compiler/rename/RnNames.lhs
+++ b/compiler/rename/RnNames.lhs
@@ -17,6 +17,7 @@ import DynFlags		( DynFlag(..), GhcMode(..), DynFlags(..) )
 import HsSyn		( IE(..), ieName, ImportDecl(..), LImportDecl,
 			  ForeignDecl(..), HsGroup(..), HsValBinds(..),
 			  Sig(..), collectHsBindLocatedBinders, tyClDeclNames,
+			  instDeclATs, isIdxTyDecl,
 			  LIE )
 import RnEnv
 import IfaceEnv		( ifaceExportNames )
@@ -57,6 +58,7 @@ import DriverPhases	( isHsBoot )
 import Util		( notNull )
 import List		( partition )
 import IO		( openFile, IOMode(..) )
+import Monad		( liftM )
 \end{code}
 
 
@@ -151,10 +153,9 @@ rnImportDecl' iface decl_spec (ImportDecl mod_name want_boot qual_only as_mod (J
          return $ ImportDecl mod_name want_boot qual_only as_mod (Just (want_hiding,rn_import_items))
     where
     srcSpanWrapper (L span ieRdr)
-        = setSrcSpan span $
-          case get_item ieRdr of
+        = case get_item ieRdr of
             Nothing
-                -> do addErr (badImportItemErr iface decl_spec ieRdr)
+                -> do addErrAt span (badImportItemErr iface decl_spec ieRdr)
                       return Nothing
             Just ieNames
                 -> return (Just [L span ie | ie <- ieNames])
@@ -410,14 +411,27 @@ used for source code.
 
 	*** See "THE NAMING STORY" in HsDecls ****
 
+Instances of indexed types
+~~~~~~~~~~~~~~~~~~~~~~~~~~
+Indexed data/newtype instances contain data constructors that we need to
+collect, too.  Moreover, we need to descend into the data/newtypes instances
+of associated families.
+
+We need to be careful with the handling of the type constructor of each type
+instance as the family constructor is already defined, and we want to avoid
+raising a duplicate declaration error.  So, we make a new name for it, but
+don't return it in the 'AvailInfo'.
+
 \begin{code}
 getLocalDeclBinders :: TcGblEnv -> HsGroup RdrName -> RnM [Name]
-getLocalDeclBinders gbl_env (HsGroup {hs_valds = ValBindsIn val_decls val_sigs, 
+getLocalDeclBinders gbl_env (HsGroup {hs_valds = ValBindsIn val_decls val_sigs,
 				      hs_tyclds = tycl_decls, 
+				      hs_instds = inst_decls,
 				      hs_fords = foreign_decls })
   = do	{ tc_names_s <- mappM new_tc tycl_decls
+	; at_names_s <- mappM inst_ats inst_decls
 	; val_names  <- mappM new_simple val_bndrs
-	; return (foldr (++) val_names tc_names_s) }
+	; return (foldr (++) val_names (tc_names_s ++ concat at_names_s)) }
   where
     mod        = tcg_mod gbl_env
     is_hs_boot = isHsBoot (tcg_src gbl_env) ;
@@ -435,9 +449,14 @@ getLocalDeclBinders gbl_env (HsGroup {hs_valds = ValBindsIn val_decls val_sigs,
     new_tc tc_decl 
 	= do { main_name <- newTopSrcBinder mod Nothing main_rdr
 	     ; sub_names <- mappM (newTopSrcBinder mod (Just main_name)) sub_rdrs
-	     ; return (main_name : sub_names) }
+	     ; if isIdxTyDecl (unLoc tc_decl)	   -- index type definitions
+	       then return (            sub_names) -- are usage occurences
+	       else return (main_name : sub_names) }
 	where
 	  (main_rdr : sub_rdrs) = tyClDeclNames (unLoc tc_decl)
+
+    inst_ats inst_decl 
+	= mappM new_tc (instDeclATs (unLoc inst_decl))
 \end{code}
 
 
@@ -725,7 +744,7 @@ check_occs ie occs names
 
 	    | otherwise		-- Same occ name but different names: an error
 	    ->	do { global_env <- getGlobalRdrEnv ;
-  		     addErr (exportClashErr global_env name name' ie ie') ;
+  		     addErr (exportClashErr global_env name' name ie' ie) ;
 		     returnM occs }
       where
 	name_occ = nameOccName name
@@ -753,8 +772,8 @@ reportDeprecations dflags tcg_env
     check hpt pit (GRE {gre_name = name, gre_prov = Imported (imp_spec:_)})
       | name `elemNameSet` used_names
       ,	Just deprec_txt <- lookupDeprec dflags hpt pit name
-      = setSrcSpan (importSpecLoc imp_spec) $
-	addWarn (sep [ptext SLIT("Deprecated use of") <+> 
+      = addWarnAt (importSpecLoc imp_spec)
+		  (sep [ptext SLIT("Deprecated use of") <+> 
 			pprNonVarNameSpace (occNameSpace (nameOccName name)) <+> 
 		 	quotes (ppr name),
 		      (parens imp_msg) <> colon,