X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Frename%2FRnNames.lhs;h=d8d8f3bb6b2773a57f4c6b1e285bdd8c03ff37f4;hp=b5ed7d08c77f4a1420b691c8cc546c44024669e2;hb=9992bfb6bd3644384b9a26b810ef68f05fd60879;hpb=d3541e298dbc79f6cc689cd72a3a3db9707e9d25 diff --git a/compiler/rename/RnNames.lhs b/compiler/rename/RnNames.lhs index b5ed7d0..d8d8f3b 100644 --- a/compiler/rename/RnNames.lhs +++ b/compiler/rename/RnNames.lhs @@ -18,7 +18,7 @@ import HsSyn import TcEnv ( isBrackStage ) import RnEnv import RnHsDoc ( rnHsDoc ) -import IfaceEnv ( ifaceExportNames ) +import IfaceEnv ( ifaceExportNames ) import LoadIface ( loadSrcInterface ) import TcRnMonad @@ -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 @@ -112,8 +112,9 @@ rnImportDecl this_mod implicit_prelude -- (Opt_WarnMissingImportList also checks for T(..) items -- but that is done in checkDodgyImport below) case imp_details of - Just (False, _) -> return () + Just (False, _) -> return () -- Explicit import list _ | implicit_prelude -> return () + | qual_only -> return () | otherwise -> ifDOptM Opt_WarnMissingImportList $ addWarn (missingImportListWarn imp_mod_name) @@ -446,7 +447,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 @@ -586,6 +587,7 @@ filterImports iface decl_spec (Just (want_hiding, import_items)) all_avails = ifDOptM Opt_WarnDodgyImports (addWarn (dodgyImportWarn n)) -- NB. use the RdrName for reporting the warning | IEThingAll {} <- ieRdr + , not (is_qual decl_spec) = ifDOptM Opt_WarnMissingImportList $ addWarn (missingImportListItem ieRdr) checkDodgyImport _ @@ -604,7 +606,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) @@ -826,14 +828,14 @@ it re-exports @GHC@, which includes @takeMVar#@, whose type includes type ExportAccum -- The type of the accumulating parameter of -- the main worker function in rnExports = ([LIE Name], -- Export items with Names - ExportOccMap, -- Tracks exported occurrence names + ExportOccMap, -- Tracks exported occurrence names [AvailInfo]) -- The accumulated exported stuff -- Not nub'd! emptyExportAccum :: ExportAccum emptyExportAccum = ([], emptyOccEnv, []) -type ExportOccMap = OccEnv (Name, IE RdrName) +type ExportOccMap = OccEnv (Name, IE Name) -- Tracks what a particular exported OccName -- in an export list refers to, and which item -- it came from. It's illegal to export two distinct things @@ -910,7 +912,7 @@ exports_from_avail (Just rdr_items) rdr_env imports this_mod exports_from_item :: ExportAccum -> LIE RdrName -> RnM ExportAccum exports_from_item acc@(ie_names, occs, exports) - (L loc ie@(IEModuleContents mod)) + (L loc (IEModuleContents mod)) | let earlier_mods = [ mod | (L _ (IEModuleContents mod)) <- ie_names ] , mod `elem` earlier_mods -- Duplicate export of M = do { warn_dup_exports <- doptM Opt_WarnDuplicateExports ; @@ -935,7 +937,7 @@ exports_from_avail (Just rdr_items) rdr_env imports this_mod -- The qualified and unqualified version of all of -- these names are, in effect, used by this export - ; occs' <- check_occs ie occs names + ; occs' <- check_occs (IEModuleContents mod) occs names -- This check_occs not only finds conflicts -- between this item and others, but also -- internally within this item. That is, if @@ -956,7 +958,7 @@ exports_from_avail (Just rdr_items) rdr_env imports this_mod then return acc -- Avoid error cascade else do - occs' <- check_occs ie occs (availNames avail) + occs' <- check_occs new_ie occs (availNames avail) return (L loc new_ie : lie_names, occs', avail : exports) @@ -1052,8 +1054,8 @@ isModuleExported implicit_prelude mod (GRE { gre_name = name, gre_prov = prov }) Imported is -> any unQualSpecOK is && any (qualSpecOK mod) is ------------------------------- -check_occs :: IE RdrName -> ExportOccMap -> [Name] -> RnM ExportOccMap -check_occs ie occs names +check_occs :: IE Name -> ExportOccMap -> [Name] -> RnM ExportOccMap +check_occs ie occs names -- 'names' are the entities specifed by 'ie' = foldlM check occs names where check occs name @@ -1064,7 +1066,7 @@ 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. - -> do unless (diffModules ie ie') $ do + -> do unless (dupExport_ok name ie ie') $ do warn_dup_exports <- doptM Opt_WarnDuplicateExports warnIf warn_dup_exports (dupExportWarn name_occ ie ie') return occs @@ -1075,9 +1077,38 @@ check_occs ie occs names return occs } where name_occ = nameOccName name - -- True if the two IE RdrName are different module exports. - diffModules (IEModuleContents n1) (IEModuleContents n2) = n1 /= n2 - diffModules _ _ = False + + +dupExport_ok :: Name -> IE Name -> IE Name -> Bool +-- The Name is exported by both IEs. Is that ok? +-- "No" iff the name is mentioned explicitly in both IEs +-- "Yes" otherwise +-- +-- Example of "no": module M( f, f ) +-- +-- Example of "yes" +-- module M( module A, module B ) where +-- import A( f ) +-- import B( f ) +-- +-- Example of "yes" (Trac #2436) +-- module M( C(..), T(..) ) where +-- class C a where { data T a } +-- instace C Int where { data T Int = TInt } +-- +-- Example of "yes" (Trac #2436) +-- module Foo ( T ) where +-- data family T a +-- module Bar ( T(..), module Foo ) where +-- import Foo +-- data instance T Int = TInt + +dupExport_ok n ie1 ie2 + = not (explicit_in ie1 && explicit_in ie2) + where + explicit_in (IEModuleContents _) = False + explicit_in (IEThingAll n') = n == n' + explicit_in _ = True \end{code} %********************************************************* @@ -1456,14 +1487,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") @@ -1489,7 +1557,7 @@ typeItemErr name wherestr = sep [ ptext (sLit "Using 'type' tag on") <+> quotes (ppr name) <+> wherestr, ptext (sLit "Use -XTypeFamilies to enable this extension") ] -exportClashErr :: GlobalRdrEnv -> Name -> Name -> IE RdrName -> IE RdrName +exportClashErr :: GlobalRdrEnv -> Name -> Name -> IE Name -> IE Name -> Message exportClashErr global_env name1 name2 ie1 ie2 = vcat [ ptext (sLit "Conflicting exports for") <+> quotes (ppr occ) <> colon @@ -1533,7 +1601,7 @@ addDupDeclErr names@(name : _) where sorted_names = sortWith nameSrcLoc names -dupExportWarn :: OccName -> IE RdrName -> IE RdrName -> SDoc +dupExportWarn :: OccName -> IE Name -> IE Name -> SDoc dupExportWarn occ_name ie1 ie2 = hsep [quotes (ppr occ_name), ptext (sLit "is exported by"), quotes (ppr ie1),