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, unpackCStringFoldr_RDR, unpackCStringUtf8_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 )
\begin{code}
-type RenameResult = ( Module -- This module
+type RenameResult = ( PersistentCompilerState,
+ , Module -- This module
, RenamedHsModule -- Renamed module
, Maybe ParsedIface -- The existing interface file, if any
, ParsedIface -- The new interface
- , RnNameSupply -- Final env; for renaming derivings
- , FixityEnv -- The fixity environment; for derivings
, [Module]) -- Imported modules
-renameModule :: UniqSupply -> RdrNameHsModule -> IO (Maybe RenameResult)
-renameModule us this_mod@(HsModule mod_name vers exports imports local_decls _ loc)
+renameModule :: PersistentCompilerState -> HomeSymbolTable
+ -> RdrNameHsModule -> IO (Maybe RenameResult)
+renameModule old_pcs hst 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
- (mkSearchPath opt_HiMap) loc
- (rename this_mod) ;
+ ((maybe_rn_stuff, dump_action), msgs, new_pcs)
+ <- initRn dflags finder old_pcs hst loc (rename this_mod) ;
-- Check for warnings
- printErrorsAndWarnings rn_errs_bag rn_warns_bag ;
+ printErrorsAndWarnings msgs ;
-- Dump any debugging output
dump_action ;
-- Return results
if not (isEmptyBag rn_errs_bag) then
- do { ghcExit 1 ; return Nothing }
+ return (old_pcs, Nothing)
else
- return maybe_rn_stuff
+ return (new_pcs, maybe_rn_stuff)
}
\end{code}
getIfacesRn `thenRn` \ ifaces ->
let
direct_import_mods :: [Module]
- direct_import_mods = [m | (_, _, Just (m, _, _, _, ImportByUser, _))
- <- eltsFM (iImpModInfo ifaces)]
- -- Pick just the non-back-edge imports
- -- (Back edges are ImportByUserSource)
+ 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
implicit_occs = string_occs ++ foldr ((++) . get) implicit_main decls
-- Virtually every program has error messages in it somewhere
- string_occs = [unpackCString_RDR, unpackCStringFoldr_RDR, unpackCStringUtf8_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
`thenRn_` returnRn acc
| otherwise -> returnRn acc ;
- Just (name:_) ->
+ Just ((name,_):_) ->
-- Check for duplicate fixity decl
case lookupNameEnv acc name of {
, case parent_avail of { AvailTC _ _ -> True; other -> False }
]
- defined_names = mkNameSet (concat (rdrEnvElts gbl_env))
- defined_but_not_used =
- nameSetToList (defined_names `minusNameSet` really_used_names)
+ defined_names, defined_but_not_used :: [(Name,Provenance)]
+ defined_names = concat (rdrEnvElts gbl_env)
+ defined_but_not_used = filter not_used defined_names
+ not_used name = not (name `elemNameSet` really_used_names)
-- Filter out the ones only defined implicitly
- bad_locals = [n | n <- defined_but_not_used, isLocallyDefined n]
- bad_imp_names = [n | n <- defined_but_not_used, isUserImportedExplicitlyName n,
- not (module_unused n)]
+ bad_locals :: [Name]
+ bad_locals = [n | (n,LocalDef) <- defined_but_not_used]
+
+ bad_imp_names :: [(Name,Provenance)]
+ bad_imp_names = [(n,p) | (n,p@(UserImport mod _ True) <- defined_but_not_used,
+ not (module_unused mod)]
deprec_used deprec_env = [ (n,txt)
| n <- nameSetToList mentioned_names,
-- 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))]
-
- 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 = expectJust "module_unused" (maybeUserImportedFrom n)
- `elem` unused_imp_mods
- -- module_unused is only called if it's user-imported
+ unused_imp_mods = [m | m <- direct_import_mods,
+ not (maybeToBool (lookupFM minimal_imports m)),
+ moduleName m /= pRELUDE_Name]
+
+ module_unused :: Module -> Bool
+ module_unused mod = mod `elem` unused_imp_mods
+
in
warnUnusedModules unused_imp_mods `thenRn_`
warnUnusedLocalBinds bad_locals `thenRn_`
projects / ghc-hetmet.git / blobdiff