diff options
Diffstat (limited to 'compiler/rename/RnNames.lhs')
| -rw-r--r-- | compiler/rename/RnNames.lhs | 34 |
1 files changed, 19 insertions, 15 deletions
diff --git a/compiler/rename/RnNames.lhs b/compiler/rename/RnNames.lhs index 68e6d027e6..b1a61db2a2 100644 --- a/compiler/rename/RnNames.lhs +++ b/compiler/rename/RnNames.lhs @@ -486,12 +486,8 @@ getLocalNonValBinders fixity_env hs_tyclds = tycl_decls, hs_instds = inst_decls, hs_fords = foreign_decls }) - = do { -- Separate out the family instance declarations - let (tyinst_decls, tycl_decls_noinsts) - = partition (isFamInstDecl . unLoc) (concat tycl_decls) - - -- Process all type/class decls *except* family instances - ; tc_avails <- mapM new_tc tycl_decls_noinsts + = do { -- Process all type/class decls *except* family instances + ; tc_avails <- mapM new_tc (concat tycl_decls) ; envs <- extendGlobalRdrEnvRn tc_avails fixity_env ; setEnvs envs $ do { -- Bring these things into scope first @@ -499,7 +495,6 @@ getLocalNonValBinders fixity_env -- Process all family instances -- to bring new data constructors into scope - ; ti_avails <- mapM (new_ti Nothing) tyinst_decls ; nti_avails <- concatMapM new_assoc inst_decls -- Finish off with value binders: @@ -510,7 +505,7 @@ getLocalNonValBinders fixity_env | otherwise = for_hs_bndrs ; val_avails <- mapM new_simple val_bndrs - ; let avails = ti_avails ++ nti_avails ++ val_avails + ; let avails = nti_avails ++ val_avails new_bndrs = availsToNameSet avails `unionNameSets` availsToNameSet tc_avails ; envs <- extendGlobalRdrEnvRn avails fixity_env @@ -529,20 +524,25 @@ getLocalNonValBinders fixity_env ; return (Avail nm) } new_tc tc_decl -- NOT for type/data instances - = do { names@(main_name : _) <- mapM newTopSrcBinder (hsTyClDeclBinders tc_decl) + = do { let bndrs = hsTyClDeclBinders (unLoc tc_decl) + ; names@(main_name : _) <- mapM newTopSrcBinder bndrs ; return (AvailTC main_name names) } - new_ti :: Maybe Name -> LTyClDecl RdrName -> RnM AvailInfo + new_ti :: Maybe Name -> FamInstDecl RdrName -> RnM AvailInfo new_ti mb_cls ti_decl -- ONLY for type/data instances - = do { main_name <- lookupTcdName mb_cls (unLoc ti_decl) + = ASSERT( isFamInstDecl ti_decl ) + do { main_name <- lookupTcdName mb_cls ti_decl ; sub_names <- mapM newTopSrcBinder (hsTyClDeclBinders ti_decl) ; return (AvailTC (unLoc main_name) sub_names) } -- main_name is not bound here! new_assoc :: LInstDecl RdrName -> RnM [AvailInfo] - new_assoc (L _ (InstDecl inst_ty _ _ ats)) + new_assoc (L _ (FamInstDecl d)) + = do { avail <- new_ti Nothing d + ; return [avail] } + new_assoc (L _ (ClsInstDecl inst_ty _ _ ats)) = do { mb_cls_nm <- get_cls_parent inst_ty - ; mapM (new_ti mb_cls_nm) ats } + ; mapM (new_ti mb_cls_nm . unLoc) ats } where get_cls_parent inst_ty | Just (_, _, L loc cls_rdr, _) <- splitLHsInstDeclTy_maybe inst_ty @@ -551,7 +551,8 @@ getLocalNonValBinders fixity_env = return Nothing lookupTcdName :: Maybe Name -> TyClDecl RdrName -> RnM (Located Name) --- Used for TyData and TySynonym only +-- Used for TyData and TySynonym only, +-- both ordinary ones and family instances -- See Note [Family instance binders] lookupTcdName mb_cls tc_decl | not (isFamInstDecl tc_decl) -- The normal case @@ -1511,7 +1512,10 @@ warnUnusedImport (L loc decl, used, unused) <+> ptext (sLit "import") <+> pp_mod <> parens empty ] msg2 = sep [pp_herald <+> quotes (pprWithCommas ppr unused), text "from module" <+> quotes pp_mod <+> pp_not_used] - pp_herald = text "The import of" + pp_herald = text "The" <+> pp_qual <+> text "import of" + pp_qual + | ideclQualified decl = text "qualified" + | otherwise = empty pp_mod = ppr (unLoc (ideclName decl)) pp_not_used = text "is redundant" \end{code} |