X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Frename%2FRnNames.lhs;h=8b09f52a9a9b7d9cdba2f3b63248ce9ed75f8b98;hp=6c35ef11a22aa39c633c53bc8ebd7659b18d77f7;hb=c1681a73fa4ca4cf8758264ae387ac09a9e900d8;hpb=ec0b859902e717c24addff49f9a83efb927fb669 diff --git a/compiler/rename/RnNames.lhs b/compiler/rename/RnNames.lhs index 6c35ef1..8b09f52 100644 --- a/compiler/rename/RnNames.lhs +++ b/compiler/rename/RnNames.lhs @@ -13,7 +13,7 @@ module RnNames ( #include "HsVersions.h" -import DynFlags ( DynFlag(..), GhcMode(..), DynFlags(..) ) +import DynFlags import HsSyn ( IE(..), ieName, ImportDecl(..), LImportDecl, ForeignDecl(..), HsGroup(..), HsValBinds(..), Sig(..), collectHsBindLocatedBinders, tyClDeclNames, @@ -57,7 +57,7 @@ import Monad ( when ) \begin{code} rnImports :: [LImportDecl RdrName] - -> RnM ([LImportDecl Name], GlobalRdrEnv, ImportAvails) + -> RnM ([LImportDecl Name], GlobalRdrEnv, ImportAvails,AnyHpcUsage) rnImports imports -- PROCESS IMPORT DECLS @@ -69,20 +69,25 @@ rnImports imports (source, ordinary) = partition is_source_import imports is_source_import (L _ (ImportDecl _ is_boot _ _ _)) = is_boot + ifOptM Opt_WarnImplicitPrelude ( + when (notNull prel_imports) $ addWarn (implicitPreludeWarn) + ) + stuff1 <- mapM (rnImportDecl this_mod) (prel_imports ++ ordinary) stuff2 <- mapM (rnImportDecl this_mod) source - let (decls, rdr_env, imp_avails) = combine (stuff1 ++ stuff2) - return (decls, rdr_env, imp_avails) + let (decls, rdr_env, imp_avails,hpc_usage) = combine (stuff1 ++ stuff2) + return (decls, rdr_env, imp_avails,hpc_usage) where - combine :: [(LImportDecl Name, GlobalRdrEnv, ImportAvails)] - -> ([LImportDecl Name], GlobalRdrEnv, ImportAvails) - combine = foldr plus ([], emptyGlobalRdrEnv, emptyImportAvails) - where plus (decl, gbl_env1, imp_avails1) - (decls, gbl_env2, imp_avails2) + combine :: [(LImportDecl Name, GlobalRdrEnv, ImportAvails,AnyHpcUsage)] + -> ([LImportDecl Name], GlobalRdrEnv, ImportAvails,AnyHpcUsage) + combine = foldr plus ([], emptyGlobalRdrEnv, emptyImportAvails,False) + where plus (decl, gbl_env1, imp_avails1,hpc_usage1) + (decls, gbl_env2, imp_avails2,hpc_usage2) = (decl:decls, gbl_env1 `plusGlobalRdrEnv` gbl_env2, - imp_avails1 `plusImportAvails` imp_avails2) + imp_avails1 `plusImportAvails` imp_avails2, + hpc_usage1 || hpc_usage2) mkPrelImports :: Module -> Bool -> [LImportDecl RdrName] -> [LImportDecl RdrName] -- Consruct the implicit declaration "import Prelude" (or not) @@ -115,7 +120,7 @@ mkPrelImports this_mod implicit_prelude import_decls rnImportDecl :: Module -> LImportDecl RdrName - -> RnM (LImportDecl Name, GlobalRdrEnv, ImportAvails) + -> RnM (LImportDecl Name, GlobalRdrEnv, ImportAvails,AnyHpcUsage) rnImportDecl this_mod (L loc (ImportDecl loc_imp_mod_name want_boot qual_only as_mod imp_details)) @@ -241,7 +246,7 @@ rnImportDecl this_mod (L loc (ImportDecl loc_imp_mod_name want_boot let new_imp_decl = L loc (ImportDecl loc_imp_mod_name want_boot qual_only as_mod new_imp_details) - returnM (new_imp_decl, gbl_env, imports) + returnM (new_imp_decl, gbl_env, imports, mi_hpc iface) ) warnRedundantSourceImport mod_name @@ -298,7 +303,7 @@ used for source code. *** See "THE NAMING STORY" in HsDecls **** -Instances of indexed types +Instances of type families ~~~~~~~~~~~~~~~~~~~~~~~~~~ Indexed data/newtype instances contain data constructors that we need to collect, too. Moreover, we need to descend into the data/newtypes instances @@ -380,8 +385,8 @@ filterImports iface decl_spec Nothing all_avails filterImports iface decl_spec (Just (want_hiding, import_items)) all_avails = do -- check for errors, convert RdrNames to Names - opt_indexedtypes <- doptM Opt_IndexedTypes - items1 <- mapM (lookup_lie opt_indexedtypes) import_items + opt_typeFamilies <- doptM Opt_TypeFamilies + items1 <- mapM (lookup_lie opt_typeFamilies) import_items let items2 :: [(LIE Name, AvailInfo)] items2 = concat items1 @@ -428,10 +433,10 @@ filterImports iface decl_spec (Just (want_hiding, import_items)) all_avails (name, AvailTC name subs, Just parent) lookup_lie :: Bool -> LIE RdrName -> TcRn [(LIE Name, AvailInfo)] - lookup_lie opt_indexedtypes (L loc ieRdr) + lookup_lie opt_typeFamilies (L loc ieRdr) = do stuff <- setSrcSpan loc $ - case lookup_ie opt_indexedtypes ieRdr of + case lookup_ie opt_typeFamilies ieRdr of Failed err -> addErr err >> return [] Succeeded a -> return a checkDodgyImport stuff @@ -456,7 +461,7 @@ filterImports iface decl_spec (Just (want_hiding, import_items)) all_avails -- AvailInfos for the data constructors and the family (as they have -- different parents). See the discussion at occ_env. lookup_ie :: Bool -> IE RdrName -> MaybeErr Message [(IE Name,AvailInfo)] - lookup_ie opt_indexedtypes ie + lookup_ie opt_typeFamilies ie = let bad_ie = Failed (badImportItemErr iface decl_spec ie) lookup_name rdrName = @@ -501,8 +506,8 @@ filterImports iface decl_spec (Just (want_hiding, import_items)) all_avails children <- if any isNothing mb_children then bad_ie else return (catMaybes mb_children) - -- check for proper import of indexed types - when (not opt_indexedtypes && any isTyConName children) $ + -- check for proper import of type families + when (not opt_typeFamilies && any isTyConName children) $ Failed (typeItemErr (head . filter isTyConName $ children) (text "in import list")) case mb_parent of @@ -708,10 +713,10 @@ rnExports explicit_mod exports -- written "module Main where ..." -- Reason: don't want to complain about 'main' not in scope -- in interactive mode - ; ghc_mode <- getGhcMode + ; dflags <- getDOpts ; let real_exports - | explicit_mod = exports - | ghc_mode == Interactive = Nothing + | explicit_mod = exports + | ghcLink dflags == LinkInMemory = Nothing | otherwise = Just ([noLoc (IEVar main_RDR_Unqual)]) -- ToDo: the 'noLoc' here is unhelpful if 'main' -- turns out to be out of scope @@ -833,8 +838,8 @@ exports_from_avail (Just rdr_items) rdr_env imports this_mod then do addErr (exportItemErr ie) return (IEThingWith name [], AvailTC name [name]) else do let names = catMaybes mb_names - optIdxTypes <- doptM Opt_IndexedTypes - when (not optIdxTypes && any isTyConName names) $ + optTyFam <- doptM Opt_TypeFamilies + when (not optTyFam && any isTyConName names) $ addErr (typeItemErr ( head . filter isTyConName $ names ) @@ -1296,8 +1301,8 @@ dodgyExportWarn item = dodgyMsg (ptext SLIT("export")) item dodgyMsg kind tc = sep [ ptext SLIT("The") <+> kind <+> ptext SLIT("item") <+> quotes (ppr (IEThingAll tc)), - ptext SLIT("suggests that") <+> quotes (ppr tc) <+> ptext SLIT("has constructor or class methods"), - ptext SLIT("but it has none; it is a type synonym or abstract type or class") ] + ptext SLIT("suggests that") <+> quotes (ppr tc) <+> ptext SLIT("has constructors or class methods,"), + ptext SLIT("but it has none") ] exportItemErr export_item = sep [ ptext SLIT("The export item") <+> quotes (ppr export_item), @@ -1305,12 +1310,14 @@ exportItemErr export_item typeItemErr name wherestr = sep [ ptext SLIT("Using 'type' tag on") <+> quotes (ppr name) <+> wherestr, - ptext SLIT("Use -findexed-types to enable this extension") ] + ptext SLIT("Use -ftype-families to enable this extension") ] +exportClashErr :: GlobalRdrEnv -> Name -> Name -> IE RdrName -> IE RdrName + -> Message exportClashErr global_env name1 name2 ie1 ie2 = vcat [ ptext SLIT("Conflicting exports for") <+> quotes (ppr occ) <> colon - , ppr_export ie1 name1 - , ppr_export ie2 name2 ] + , ppr_export ie1' name1' + , ppr_export ie2' name2' ] where occ = nameOccName name1 ppr_export ie name = nest 2 (quotes (ppr ie) <+> ptext SLIT("exports") <+> @@ -1321,6 +1328,10 @@ exportClashErr global_env name1 name2 ie1 ie2 = case lookupGRE_Name global_env name of (gre:_) -> gre [] -> pprPanic "exportClashErr" (ppr name) + get_loc name = nameSrcLoc $ gre_name $ get_gre name + (name1', ie1', name2', ie2') = if get_loc name1 < get_loc name2 + then (name1, ie1, name2, ie2) + else (name2, ie2, name1, ie1) addDupDeclErr :: Name -> Name -> TcRn () addDupDeclErr name_a name_b @@ -1349,4 +1360,7 @@ nullModuleExport mod moduleDeprec mod txt = sep [ ptext SLIT("Module") <+> quotes (ppr mod) <+> ptext SLIT("is deprecated:"), nest 4 (ppr txt) ] + +implicitPreludeWarn + = ptext SLIT("Module `Prelude' implicitly imported") \end{code}