X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Frename%2FRnNames.lhs;h=a756c7f6c91f22d969895c234fbcc6ed2c6ecf14;hp=e8490ac63f6f02a0c1e2f24c6bffb05d4eab59cd;hb=6ea06bbf08517d9805feb82df65cc56ecbaf23a4;hpb=b633499b3a9508fce26b622f2d0cd836290e9503 diff --git a/compiler/rename/RnNames.lhs b/compiler/rename/RnNames.lhs index e8490ac..a756c7f 100644 --- a/compiler/rename/RnNames.lhs +++ b/compiler/rename/RnNames.lhs @@ -37,7 +37,7 @@ import ErrUtils import Util import FastString import ListSetOps -import Data.List ( partition, (\\), delete ) +import Data.List ( partition, (\\), delete, find ) import qualified Data.Set as Set import System.IO import Control.Monad @@ -446,7 +446,7 @@ get_local_binders gbl_env (HsGroup {hs_valds = ValBindsIn _ val_sigs, hs_fords = foreign_decls }) = do { -- separate out the family instance declarations let (tyinst_decls1, tycl_decls_noinsts) - = partition (isFamInstDecl . unLoc) tycl_decls + = partition (isFamInstDecl . unLoc) (concat tycl_decls) tyinst_decls = tyinst_decls1 ++ instDeclATs inst_decls -- process all type/class decls except family instances @@ -604,7 +604,7 @@ filterImports iface decl_spec (Just (want_hiding, import_items)) all_avails lookup_ie :: Bool -> IE RdrName -> MaybeErr Message [(IE Name,AvailInfo)] lookup_ie opt_typeFamilies ie = let bad_ie :: MaybeErr Message a - bad_ie = Failed (badImportItemErr iface decl_spec ie) + bad_ie = Failed (badImportItemErr iface decl_spec ie all_avails) lookup_name rdr | isQual rdr = Failed (qualImportItemErr rdr) @@ -1064,12 +1064,10 @@ check_occs ie occs names | name == name' -- Duplicate export -- But we don't want to warn if the same thing is exported -- by two different module exports. See ticket #4478. - -> if diffModules ie ie' - then return occs - else do - { warn_dup_exports <- doptM Opt_WarnDuplicateExports ; - warnIf warn_dup_exports (dupExportWarn name_occ ie ie') ; - return occs } + -> do unless (diffModules ie ie') $ do + warn_dup_exports <- doptM Opt_WarnDuplicateExports + warnIf warn_dup_exports (dupExportWarn name_occ ie ie') + return occs | otherwise -- Same occ name but different names: an error -> do { global_env <- getGlobalRdrEnv ; @@ -1458,14 +1456,51 @@ qualImportItemErr rdr = hang (ptext (sLit "Illegal qualified name in import item:")) 2 (ppr rdr) -badImportItemErr :: ModIface -> ImpDeclSpec -> IE RdrName -> SDoc -badImportItemErr iface decl_spec ie +badImportItemErrStd :: ModIface -> ImpDeclSpec -> IE RdrName -> SDoc +badImportItemErrStd iface decl_spec ie = sep [ptext (sLit "Module"), quotes (ppr (is_mod decl_spec)), source_import, ptext (sLit "does not export"), quotes (ppr ie)] where source_import | mi_boot iface = ptext (sLit "(hi-boot interface)") | otherwise = empty +badImportItemErrDataCon :: OccName -> ModIface -> ImpDeclSpec -> IE RdrName -> SDoc +badImportItemErrDataCon dataType iface decl_spec ie + = vcat [ ptext (sLit "In module") + <+> quotes (ppr (is_mod decl_spec)) + <+> source_import <> colon + , nest 2 $ quotes datacon + <+> ptext (sLit "is a data constructor of") + <+> quotes (ppr dataType) + , ptext (sLit "To import it use") + , nest 2 $ quotes (ptext (sLit "import") + <+> ppr (is_mod decl_spec) + <+> parens (ppr dataType <+> parens datacon)) + , ptext (sLit "or") + , nest 2 $ quotes (ptext (sLit "import") + <+> ppr (is_mod decl_spec) + <+> parens (ppr dataType <+> parens (ptext $ sLit ".."))) + ] + where + datacon = ppr . rdrNameOcc $ ieName ie + source_import | mi_boot iface = ptext (sLit "(hi-boot interface)") + | otherwise = empty + +badImportItemErr :: ModIface -> ImpDeclSpec -> IE RdrName -> [AvailInfo] -> SDoc +badImportItemErr iface decl_spec ie avails + = case find checkIfDataCon avails of + Just con -> badImportItemErrDataCon (availOccName con) iface decl_spec ie + Nothing -> badImportItemErrStd iface decl_spec ie + where + checkIfDataCon (AvailTC _ ns) = + case find (\n -> importedFS == nameOccNameFS n) ns of + Just n -> isDataConName n + Nothing -> False + checkIfDataCon _ = False + availOccName = nameOccName . availName + nameOccNameFS = occNameFS . nameOccName + importedFS = occNameFS . rdrNameOcc $ ieName ie + illegalImportItemErr :: SDoc illegalImportItemErr = ptext (sLit "Illegal import item")