import Inst ( showLIE )
import TcBinds ( tcTopBinds )
import TcDefaults ( tcDefaults )
-import TcEnv ( tcExtendGlobalValEnv, tcLookupGlobal )
+import TcEnv ( tcExtendGlobalValEnv )
import TcRules ( tcRules )
import TcForeign ( tcForeignImports, tcForeignExports )
import TcInstDcls ( tcInstDecls1, tcInstDecls2 )
import TcTyClsDecls ( tcTyAndClassDecls )
import LoadIface ( loadOrphanModules )
import RnNames ( importsFromLocalDecls, rnImports, exportsFromAvail,
- reportUnusedNames )
+ reportUnusedNames, reportDeprecations )
import RnEnv ( lookupSrcOcc_maybe )
import RnSource ( rnSrcDecls, rnTyClDecls, checkModDeprec )
import PprCore ( pprIdRules, pprCoreBindings )
import CoreSyn ( IdCoreRule, bindersOfBinds )
-import ErrUtils ( mkDumpDoc, showPass )
+import ErrUtils ( Messages, mkDumpDoc, showPass )
import Id ( mkExportedLocalId, isLocalId, idName, idType )
import Var ( Var )
import Module ( mkHomeModule, mkModuleName, moduleName, moduleEnvElts )
import HscTypes ( ModGuts(..), HscEnv(..),
GhciMode(..), noDependencies,
Deprecs( NoDeprecs ), plusDeprecs,
- GenAvailInfo(Avail), availsToNameSet, availName,
ForeignStubs(NoStubs), TypeEnv, typeEnvTyCons,
extendTypeEnvWithIds, typeEnvIds, typeEnvTyCons,
emptyFixityEnv
import TcMatches ( tcStmtsAndThen, TcStmtCtxt(..) )
import TcSimplify ( tcSimplifyInteractive, tcSimplifyInfer )
import TcType ( Type, mkForAllTys, mkFunTys, mkTyConApp, tyVarsOfType )
-import TcEnv ( tcLookupTyCon, tcLookupId )
-import TyCon ( DataConDetails(..) )
+import TcEnv ( tcLookupTyCon, tcLookupId, tcLookupGlobal )
import Inst ( tcStdSyntaxName )
import RnExpr ( rnStmts, rnLExpr )
import RnNames ( exportsToAvails )
import LoadIface ( loadSrcInterface )
-import IfaceSyn ( IfaceDecl(..), IfaceClassOp(..), IfaceConDecl(..), IfaceExtName(..),
+import IfaceSyn ( IfaceDecl(..), IfaceClassOp(..), IfaceConDecl(..),
+ IfaceExtName(..), IfaceConDecls(..),
tyThingToIfaceDecl )
import RnEnv ( lookupOccRn, dataTcOccs, lookupFixityRn )
import Id ( Id, isImplicitId )
import TysWiredIn ( mkListTy, unitTy )
import IdInfo ( GlobalIdDetails(..) )
import SrcLoc ( interactiveSrcLoc, unLoc )
-import Var ( setGlobalIdDetails )
+import Var ( globaliseId )
import Name ( nameOccName, nameModuleName )
import NameEnv ( delListFromNameEnv )
import PrelNames ( iNTERACTIVE, ioTyConName, printName, monadNames, itName, returnIOName )
import Module ( ModuleName, lookupModuleEnvByName )
import HscTypes ( InteractiveContext(..),
HomeModInfo(..), typeEnvElts,
- TyThing(..), availNames, icPrintUnqual,
+ TyThing(..), availName, availNames, icPrintUnqual,
ModIface(..), ModDetails(..) )
import BasicTypes ( RecFlag(..), Fixity )
import Bag ( unitBag )
\begin{code}
tcRnModule :: HscEnv
-> Located (HsModule RdrName)
- -> IO (Maybe TcGblEnv)
+ -> IO (Messages, Maybe TcGblEnv)
tcRnModule hsc_env (L loc (HsModule maybe_mod exports
import_decls local_decls mod_deprec))
traceRn (text "rn3") ;
+ -- Report the use of any deprecated things
+ -- We do this before processsing the export list so
+ -- that we don't bleat about re-exporting a deprecated
+ -- thing (especially via 'module Foo' export item)
+ -- Only uses in the body of the module are complained about
+ reportDeprecations tcg_env ;
+
-- Process the export list
- export_avails <- exportsFromAvail (isJust maybe_mod) exports ;
+ exports <- exportsFromAvail (isJust maybe_mod) exports ;
+{- Jan 04: I don't think this is necessary any more; usage info is derived from tcg_dus
-- Get any supporting decls for the exports that have not already
-- been sucked in for the declarations in the body of the module.
-- (This can happen if something is imported only to be re-exported.)
-- We don't need the results, but sucking them in may side-effect
-- the ExternalPackageState, apart from recording usage
mappM (tcLookupGlobal . availName) export_avails ;
+-}
-- Check whether the entire module is deprecated
-- This happens only once per module
let { mod_deprecs = checkModDeprec mod_deprec } ;
-- Add exports and deprecations to envt
- let { export_fvs = availsToNameSet export_avails ;
- final_env = tcg_env { tcg_exports = export_avails,
- tcg_dus = tcg_dus tcg_env `plusDU` usesOnly export_fvs,
+ let { final_env = tcg_env { tcg_exports = exports,
+ tcg_dus = tcg_dus tcg_env `plusDU` usesOnly exports,
tcg_deprecs = tcg_deprecs tcg_env `plusDeprecs`
mod_deprecs }
-- A module deprecation over-rides the earlier ones
-- a list of the bound values, coerced to ().
tcRnStmt hsc_env ictxt rdr_stmt
- = initTc hsc_env iNTERACTIVE $
+ = initTcPrintErrors hsc_env iNTERACTIVE $
setInteractiveContext ictxt $ do {
-- Rename; use CmdLineMode because tcRnStmt is only used interactively
-- important: otherwise when we come to compile an expression
-- using these ids later, the byte code generator will consider
-- the occurrences to be free rather than global.
- global_ids = map globaliseId bound_ids ;
- globaliseId id = setGlobalIdDetails id VanillaGlobal ;
+ global_ids = map (globaliseId VanillaGlobal) bound_ids ;
-- Update the interactive context
rn_env = ic_rn_local_env ictxt ;
-> LHsExpr RdrName
-> IO (Maybe Type)
tcRnExpr hsc_env ictxt rdr_expr
- = initTc hsc_env iNTERACTIVE $
+ = initTcPrintErrors hsc_env iNTERACTIVE $
setInteractiveContext ictxt $ do {
(rn_expr, fvs) <- rnLExpr rdr_expr ;
-- *and* as a type or class constructor;
-- hence the call to dataTcOccs, and we return up to two results
tcRnThing hsc_env ictxt rdr_name
- = initTc hsc_env iNTERACTIVE $
+ = initTcPrintErrors hsc_env iNTERACTIVE $
setInteractiveContext ictxt $ do {
-- If the identifier is a constructor (begins with an
toIfaceDecl :: InteractiveContext -> TyThing -> IfaceDecl
toIfaceDecl ictxt thing
- = tyThingToIfaceDecl True {- Discard IdInfo -} ext_nm thing
+ = tyThingToIfaceDecl True {- Discard IdInfo -} emptyNameSet {- Show data cons -}
+ ext_nm thing
where
unqual = icPrintUnqual ictxt
ext_nm n | unqual n = LocalTop (nameOccName n) -- What a hack
\begin{code}
tcRnExtCore :: HscEnv
-> HsExtCore RdrName
- -> IO (Maybe ModGuts)
+ -> IO (Messages, Maybe ModGuts)
-- Nothing => some error occurred
tcRnExtCore hsc_env (HsExtCore this_mod decls src_binds)
-- Wrap up
let {
bndrs = bindersOfBinds core_binds ;
- my_exports = map (Avail . idName) bndrs ;
+ my_exports = mkNameSet (map idName bndrs) ;
-- ToDo: export the data types also?
final_type_env = extendTypeEnvWithIds (tcg_type_env tcg_env) bndrs ;
-> IO GlobalRdrEnv
mkExportEnv hsc_env exports
- = do { mb_envs <- initTc hsc_env iNTERACTIVE $
+ = do { mb_envs <- initTcPrintErrors hsc_env iNTERACTIVE $
mappM getModuleExports exports
; case mb_envs of
Just envs -> return (foldr plusGlobalRdrEnv emptyGlobalRdrEnv envs)
getModuleExports mod
= do { iface <- load_iface mod
; avails <- exportsToAvails (mi_exports iface)
- ; let { gres = [ GRE { gre_name = name, gre_prov = vanillaProv mod,
- gre_deprec = mi_dep_fn iface name }
+ ; let { gres = [ GRE { gre_name = name, gre_prov = vanillaProv mod }
| avail <- avails, name <- availNames avail ] }
; returnM (mkGlobalRdrEnv gres) }
-> IO (Maybe [IfaceDecl])
getModuleContents hsc_env ictxt mod exports_only
- = initTc hsc_env iNTERACTIVE (get_mod_contents exports_only)
+ = initTcPrintErrors hsc_env iNTERACTIVE (get_mod_contents exports_only)
where
get_mod_contents exports_only
| not exports_only -- We want the whole top-level type env
---------------------
filter_decl occs decl@(IfaceClass {ifSigs = sigs})
= decl { ifSigs = filter (keep_sig occs) sigs }
-filter_decl occs decl@(IfaceData {ifCons = DataCons cons})
- = decl { ifCons = DataCons (filter (keep_con occs) cons) }
+filter_decl occs decl@(IfaceData {ifCons = IfDataTyCon cons})
+ = decl { ifCons = IfDataTyCon (filter (keep_con occs) cons) }
+filter_decl occs decl@(IfaceData {ifCons = IfNewTyCon con})
+ | keep_con occs con = decl
+ | otherwise = decl {ifCons = IfAbstractTyCon} -- Hmm?
filter_decl occs decl
= decl
projects / ghc-hetmet.git / blobdiff