comment for getLocalDeclBinders

[ghc-hetmet.git] / compiler / rename / RnNames.lhs

diff --git a/compiler/rename/RnNames.lhs b/compiler/rename/RnNames.lhs
index d16e3d6..31ab4c7 100644 (file)
--- 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}
 
 
@@ -409,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) ;
@@ -434,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}