extractHsTyNames, extractHsCtxtTyNames
)
-import CmdLineOpts ( opt_HiMap, opt_D_dump_rn_trace, opt_D_dump_minimal_imports,
+import CmdLineOpts ( dopt_D_dump_rn_trace, dopt_D_dump_minimal_imports,
opt_D_dump_rn, opt_D_dump_rn_stats, opt_WarnDeprecations,
opt_WarnUnusedBinds
)
import NameSet
import TysWiredIn ( unitTyCon, intTyCon, doubleTyCon, boolTyCon )
import PrelRules ( builtinRules )
-import PrelInfo ( mAIN_Name, pREL_MAIN_Name, pRELUDE_Name,
- ioTyCon_RDR, unpackCString_RDR, unpackCString2_RDR, unpackCStringFoldr_RDR,
- fractionalClassKeys, derivingOccurrences
+import PrelNames ( mAIN_Name, pREL_MAIN_Name, pRELUDE_Name,
+ ioTyCon_RDR,
+ unpackCString_RDR, unpackCStringFoldr_RDR, unpackCStringUtf8_RDR,
+ eqString_RDR
)
+import PrelInfo ( fractionalClassKeys, derivingOccurrences )
import Type ( namesOfType, funTyCon )
import ErrUtils ( printErrorsAndWarnings, dumpIfSet, ghcExit )
import BasicTypes ( Version, initialVersion )
, ParsedIface -- The new interface
, RnNameSupply -- Final env; for renaming derivings
, FixityEnv -- The fixity environment; for derivings
- , [ModuleName]) -- Imported modules; for profiling
+ , [Module]) -- Imported modules
-renameModule :: UniqSupply -> RdrNameHsModule -> IO (Maybe RenameResult)
-renameModule us this_mod@(HsModule mod_name vers exports imports local_decls _ loc)
+renameModule :: PersistentCompilerState -> RdrNameHsModule -> IO (Maybe RenameResult)
+renameModule pcs this_mod@(HsModule mod_name vers exports imports local_decls _ loc)
= -- Initialise the renamer monad
do {
((maybe_rn_stuff, dump_action), rn_errs_bag, rn_warns_bag)
- <- initRn (mkThisModule mod_name) us
+ <- initRn pcs
+ (mkThisModule mod_name)
(mkSearchPath opt_HiMap) loc
(rename this_mod) ;
mkImportExportInfo mod_name export_avails exports `thenRn` \ (my_exports, my_usages) ->
-- RETURN THE RENAMED MODULE
- getNameSupplyRn `thenRn` \ name_supply ->
+ getNameSupplyRn `thenRn` \ name_supply ->
+ getIfacesRn `thenRn` \ ifaces ->
let
+ direct_import_mods :: [Module]
+ direct_import_mods = [m | (_, _, Just (m, _, _, _, imp, _))
+ <- eltsFM (iImpModInfo ifaces), user_import imp]
+
+ -- *don't* just pick the forward edges. It's entirely possible
+ -- that a module is only reachable via back edges.
+ user_import ImportByUser = True
+ user_import ImportByUserSource = True
+ user_import _ = False
+
this_module = mkThisModule mod_name
- direct_import_mods = [mod | ImportDecl mod _ _ _ _ _ <- imports]
-- Export only those fixities that are for names that are
-- (a) defined in this module
implicit_occs = string_occs ++ foldr ((++) . get) implicit_main decls
-- Virtually every program has error messages in it somewhere
- string_occs = [unpackCString_RDR, unpackCString2_RDR, unpackCStringFoldr_RDR]
+ string_occs = [unpackCString_RDR, unpackCStringFoldr_RDR, unpackCStringUtf8_RDR,
+ eqString_RDR]
- get (TyClD (TyData _ _ _ _ _ _ (Just deriv_classes) _ _))
+ get (TyClD (TyData _ _ _ _ _ _ (Just deriv_classes) _ _ _ _))
= concat (map get_deriv deriv_classes)
get other = []
check (HsVar v) = not (isLocallyDefined v)
check (HsApp f a) = check f && check a
check (HsLit _) = False
+ check (HsOverLit _) = False
check (OpApp l o _ r) = check l && check o && check r
check (NegApp e _) = check e
check (HsPar e) = check e
ASSERT( isEmptyFVs fvs )
returnRn decls1
-stripDecl (mod, TyClD (TyData dt _ tc tvs _ nconstrs _ _ loc))
- = (mod, TyClD (TyData dt [] tc tvs [] nconstrs Nothing NoDataPragmas loc))
+stripDecl (mod, TyClD (TyData dt _ tc tvs _ nconstrs _ _ loc name1 name2))
+ = (mod, TyClD (TyData dt [] tc tvs [] nconstrs Nothing NoDataPragmas loc
+ name1 name2))
-- Nuke the context and constructors
-- But retain the *number* of constructors!
-- Also the tvs will have kinds on them.
getGates source_fvs (SigD (IfaceSig _ ty _ _))
= extractHsTyNames ty
-getGates source_fvs (TyClD (ClassDecl ctxt cls tvs _ sigs _ _ _ _ _ _ _))
+getGates source_fvs (TyClD (ClassDecl ctxt cls tvs _ sigs _ _ _ _ ))
= (delListFromNameSet (foldr (plusFV . get) (extractHsCtxtTyNames ctxt) sigs)
(hsTyVarNames tvs)
`addOneToNameSet` cls)
(hsTyVarNames tvs)
-- A type synonym type constructor isn't a "gate" for instance decls
-getGates source_fvs (TyClD (TyData _ ctxt tycon tvs cons _ _ _ _))
+getGates source_fvs (TyClD (TyData _ ctxt tycon tvs cons _ _ _ _ _ _))
= delListFromNameSet (foldr (plusFV . get) (extractHsCtxtTyNames ctxt) cons)
(hsTyVarNames tvs)
`addOneToNameSet` tycon
get_details (VanillaCon tys) = plusFVs (map get_bang tys)
get_details (InfixCon t1 t2) = get_bang t1 `plusFV` get_bang t2
get_details (RecCon fields) = plusFVs [get_bang t | (_, t) <- fields]
- get_details (NewCon t _) = extractHsTyNames t
get_field (fs,t) | any (`elemNameSet` source_fvs) fs = get_bang t
| otherwise = emptyFVs
getFixities acc (FixD fix)
= fix_decl acc fix
- getFixities acc (TyClD (ClassDecl _ _ _ _ sigs _ _ _ _ _ _ _))
+ getFixities acc (TyClD (ClassDecl _ _ _ _ sigs _ _ _ _ ))
= foldlRn fix_decl acc [sig | FixSig sig <- sigs]
-- Get fixities from class decl sigs too.
getFixities acc other_decl
%*********************************************************
\begin{code}
-reportUnusedNames :: ModuleName -> [ModuleName]
+reportUnusedNames :: ModuleName -> [Module]
-> GlobalRdrEnv -> AvailEnv
-> Avails -> NameSet -> [RenamedHsDecl]
-> RnMG ()
-- There's really no good way to detect this, so the error message
-- in RnEnv.warnUnusedModules is weakened instead
inst_mods = [m | InstD (InstDecl _ _ _ (Just dfun) _) <- imported_decls,
- let m = moduleName (nameModule dfun),
+ let m = nameModule dfun,
m `elem` direct_import_mods
]
- minimal_imports :: FiniteMap ModuleName AvailEnv
+ minimal_imports :: FiniteMap Module AvailEnv
minimal_imports0 = emptyFM
minimal_imports1 = foldNameSet add_name minimal_imports0 really_used_names
minimal_imports = foldr add_inst_mod minimal_imports1 inst_mods
add_name n acc = case maybeUserImportedFrom n of
Nothing -> acc
- Just m -> addToFM_C plusAvailEnv acc (moduleName m)
+ Just m -> addToFM_C plusAvailEnv acc m
(unitAvailEnv (mk_avail n))
add_inst_mod m acc
| m `elemFM` acc = acc -- We import something already
-- unused_imp_mods are the directly-imported modules
-- that are not mentioned in minimal_imports
- unused_imp_mods = [m | m <- direct_import_mods,
- not (maybeToBool (lookupFM minimal_imports m))]
+ unused_imp_mods = [m | m <- direct_import_mods,
+ not (maybeToBool (lookupFM minimal_imports m)),
+ moduleName m /= pRELUDE_Name]
module_unused :: Name -> Bool
-- Name is imported from a module that's completely unused,
-- so don't report stuff about the name (the module covers it)
- module_unused n = moduleName (expectJust "module_unused" (maybeUserImportedFrom n))
+ module_unused n = expectJust "module_unused" (maybeUserImportedFrom n)
`elem` unused_imp_mods
-- module_unused is only called if it's user-imported
in
parens (fsep (punctuate comma (map ppr ies)))
to_ies (mod, avail_env) = mapRn to_ie (availEnvElts avail_env) `thenRn` \ ies ->
- returnRn (mod, ies)
+ returnRn (moduleName mod, ies)
to_ie :: AvailInfo -> RnMG (IE Name)
to_ie (Avail n) = returnRn (IEVar n)
projects / ghc-hetmet.git / blobdiff