#endif
import CmdLineOpts ( DynFlag(..), opt_PprStyle_Debug, dopt )
+import Packages ( moduleToPackageConfig, mkPackageId, package,
+ isHomeModule )
import DriverState ( v_MainModIs, v_MainFunIs )
import HsSyn ( HsModule(..), HsExtCore(..), HsGroup(..), LHsDecl, SpliceDecl(..), HsBind(..),
nlHsApp, nlHsVar, pprLHsBinds )
import RdrHsSyn ( findSplice )
-import PrelNames ( runIOName, rootMainName, mAIN_Name,
+import PrelNames ( runIOName, rootMainName, mAIN,
main_RDR_Unqual )
import RdrName ( RdrName, mkRdrUnqual, emptyGlobalRdrEnv,
plusGlobalRdrEnv )
import TcSimplify ( tcSimplifyTop )
import TcTyClsDecls ( tcTyAndClassDecls )
import LoadIface ( loadOrphanModules, loadHiBootInterface )
-import IfaceEnv ( lookupOrig )
-import RnNames ( importsFromLocalDecls, rnImports, exportsFromAvail,
+import RnNames ( importsFromLocalDecls, rnImports, exportsFromAvail,
reportUnusedNames, reportDeprecations )
import RnEnv ( lookupSrcOcc_maybe )
import RnSource ( rnSrcDecls, rnTyClDecls, checkModDeprec )
import ErrUtils ( Messages, mkDumpDoc, showPass )
import Id ( mkExportedLocalId, isLocalId, idName, idType )
import Var ( Var )
-import Module ( mkHomeModule, mkModuleName, moduleName, moduleEnvElts )
+import Module ( mkModule, moduleEnvElts )
import OccName ( mkVarOcc )
import Name ( Name, isExternalName, getSrcLoc, getOccName )
import NameSet
import SrcLoc ( srcLocSpan, Located(..), noLoc )
import Outputable
import HscTypes ( ModGuts(..), HscEnv(..), ExternalPackageState(..),
- GhciMode(..), noDependencies, isOneShot,
- Deprecs( NoDeprecs ), ModIface(..), plusDeprecs,
+ GhciMode(..), noDependencies,
+ Deprecs( NoDeprecs ), plusDeprecs,
ForeignStubs(NoStubs), TyThing(..),
TypeEnv, lookupTypeEnv,
extendTypeEnvWithIds, typeEnvIds, typeEnvTyCons,
- emptyFixityEnv, availName
+ emptyFixityEnv
)
#ifdef GHCI
import HsSyn ( HsStmtContext(..), Stmt(..), HsExpr(..), HsBindGroup(..),
import SrcLoc ( interactiveSrcLoc, unLoc )
import Kind ( Kind )
import Var ( globaliseId )
-import Name ( nameOccName, nameModuleName )
+import Name ( nameOccName, nameModule )
import NameEnv ( delListFromNameEnv )
import PrelNames ( iNTERACTIVE, ioTyConName, printName, monadNames, itName, returnIOName )
-import Module ( ModuleName, lookupModuleEnvByName )
+import Module ( Module, lookupModuleEnv )
import HscTypes ( InteractiveContext(..), ExternalPackageState( eps_PTE ),
HomeModInfo(..), typeEnvElts, typeEnvClasses,
availNames, icPrintUnqual,
-> Located (HsModule RdrName)
-> IO (Messages, Maybe TcGblEnv)
-tcRnModule hsc_env (L loc (HsModule maybe_mod exports
+tcRnModule hsc_env (L loc (HsModule maybe_mod export_ies
import_decls local_decls mod_deprec))
= do { showPass (hsc_dflags hsc_env) "Renamer/typechecker" ;
let { this_mod = case maybe_mod of
- Nothing -> mkHomeModule mAIN_Name
+ Nothing -> mAIN
-- 'module M where' is omitted
Just (L _ mod) -> mod } ;
-- The normal case
initTc hsc_env this_mod $
setSrcSpan loc $
- do { -- Deal with imports; sets tcg_rdr_env, tcg_imports
+ do {
+ checkForPackageModule (hsc_dflags hsc_env) this_mod;
+
+ -- Deal with imports; sets tcg_rdr_env, tcg_imports
(rdr_env, imports) <- rnImports import_decls ;
-- Record boot-file info in the EPS, so that it's
reportDeprecations tcg_env ;
-- Process the export list
- 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.)
- --
- -- Importing these supporting declarations is required
- -- *only* to gether usage information
- -- (see comments with MkIface.mkImportInfo for why)
- -- We don't need the results, but sucking them in may side-effect
- -- the ExternalPackageState, apart from recording usage
- mappM (tcLookupGlobal . availName) export_avails ;
--}
+ exports <- exportsFromAvail (isJust maybe_mod) export_ies ;
-- Check whether the entire module is deprecated
-- This happens only once per module
tcDump final_env ;
return final_env
}}}}
+
+-- This is really a sanity check that the user has given -package-name
+-- if necessary. -package-name is only necessary when the package database
+-- already contains the current package, because then we can't tell
+-- whether a given module is in the current package or not, without knowing
+-- the name of the current package.
+checkForPackageModule dflags this_mod
+ | not (isHomeModule dflags this_mod),
+ Just (pkg,_) <- moduleToPackageConfig dflags this_mod =
+ let
+ ppr_pkg = ppr (mkPackageId (package pkg))
+ in
+ addErr (ptext SLIT("Module") <+> quotes (ppr this_mod) <+>
+ ptext SLIT("is a member of package") <+> ppr_pkg <> char '.' $$
+ ptext SLIT("To compile this module, please use -ignore-package") <+> ppr_pkg <> char '.')
+ | otherwise = return ()
\end{code}
mb_main_mod <- readMutVar v_MainModIs ;
mb_main_fn <- readMutVar v_MainFunIs ;
let { main_mod = case mb_main_mod of {
- Just mod -> mkModuleName mod ;
- Nothing -> mAIN_Name } ;
+ Just mod -> mkModule mod ;
+ Nothing -> mAIN } ;
main_fn = case mb_main_fn of {
Just fn -> mkRdrUnqual (mkVarOcc (mkFastString fn)) ;
Nothing -> main_RDR_Unqual } } ;
-- If we are in module Main, check that 'main' is defined.
-- It may be imported from another module!
--
- -- ToDo: We have to return the main_name separately, because it's a
- -- bona fide 'use', and should be recorded as such, but the others
- -- aren't
--
-- Blimey: a whole page of code to do this...
- | mod_name /= main_mod
+ | mod /= main_mod
= return tcg_env
| otherwise
`snocBag` main_bind,
tcg_dus = tcg_dus tcg_env
`plusDU` usesOnly (unitFV main_name)
+ -- Record the use of 'main', so that we don't
+ -- complain about it being defined but not used
})
}}}
where
- mod_name = moduleName (tcg_mod tcg_env)
+ mod = tcg_mod tcg_env
complain_no_main | ghci_mode == Interactive = return ()
| otherwise = failWithTc noMainMsg
\begin{code}
#ifdef GHCI
-mkExportEnv :: HscEnv -> [ModuleName] -- Expose these modules' exports only
+mkExportEnv :: HscEnv -> [Module] -- Expose these modules' exports only
-> IO GlobalRdrEnv
mkExportEnv hsc_env exports
= do { mb_envs <- initTcPrintErrors hsc_env iNTERACTIVE $
-- Some error; initTc will have printed it
}
-getModuleExports :: ModuleName -> TcM GlobalRdrEnv
+getModuleExports :: Module -> TcM GlobalRdrEnv
getModuleExports mod
= do { iface <- load_iface mod
; loadOrphanModules (dep_orphs (mi_deps iface))
-- so their instances are visible
; avails <- exportsToAvails (mi_exports iface)
; let { gres = [ GRE { gre_name = name, gre_prov = vanillaProv mod }
- | avail <- avails, name <- availNames avail ] }
+ | avail <- nameSetToList avails ] }
; returnM (mkGlobalRdrEnv gres) }
-vanillaProv :: ModuleName -> Provenance
+vanillaProv :: Module -> Provenance
-- We're building a GlobalRdrEnv as if the user imported
-- all the specified modules into the global interactive module
vanillaProv mod = Imported [ImportSpec mod mod False
getModuleContents
:: HscEnv
-> InteractiveContext
- -> ModuleName -- Module to inspect
+ -> Module -- Module to inspect
-> Bool -- Grab just the exports, or the whole toplev
-> IO (Maybe [IfaceDecl])
| not exports_only -- We want the whole top-level type env
-- so it had better be a home module
= do { hpt <- getHpt
- ; case lookupModuleEnvByName hpt mod of
+ ; case lookupModuleEnv hpt mod of
Just mod_info -> return (map toIfaceDecl $
filter wantToSee $
typeEnvElts $
| otherwise -- Want the exports only
= do { iface <- load_iface mod
- ; avails <- exportsToAvails (mi_exports iface)
- ; mappM get_decl avails
+ ; mappM get_decl [ (mod,avail) | (mod, avails) <- mi_exports iface
+ , avail <- avails ]
}
- get_decl avail
- = do { thing <- tcLookupGlobal (availName avail)
- ; return (filter_decl (availOccs avail) (toIfaceDecl thing)) }
+ get_decl (mod, avail)
+ = do { main_name <- lookupOrig mod (availName avail)
+ ; thing <- tcLookupGlobal main_name
+ ; return (filter_decl (availNames avail) (toIfaceDecl thing)) }
---------------------
filter_decl occs decl@(IfaceClass {ifSigs = sigs})
keep_sig occs (IfaceClassOp occ _ _) = occ `elem` occs
keep_con occs con = ifConOcc con `elem` occs
-availOccs avail = map nameOccName (availNames avail)
-
wantToSee (AnId id) = not (isImplicitId id)
wantToSee (ADataCon _) = False -- They'll come via their TyCon
wantToSee _ = True
emptyNameSet -- Show data cons
ext_nm (munge thing)
where
- ext_nm n = ExtPkg (nameModuleName n) (nameOccName n)
+ ext_nm n = ExtPkg (nameModule n) (nameOccName n)
-- munge transforms a thing to it's "parent" thing
munge (ADataCon dc) = ATyCon (dataConTyCon dc)
projects / ghc-hetmet.git / blobdiff