#include "HsVersions.h"
#ifdef GHCI
-import {-# SOURCE #-} TcSplice( tcSpliceDecls )
+import {-# SOURCE #-} TcSplice ( tcSpliceDecls )
+import DsMeta ( qTyConName )
#endif
import CmdLineOpts ( DynFlag(..), opt_PprStyle_Debug, dopt )
-import HsSyn ( HsModule(..), HsBinds(..), MonoBinds(..), HsDecl(..), HsExpr(..),
+import HsSyn ( HsModule(..), HsBinds(..), MonoBinds(..), HsExpr(..),
Stmt(..), Pat(VarPat), HsStmtContext(..), RuleDecl(..),
- HsGroup(..),
+ HsGroup(..), SpliceDecl(..),
mkSimpleMatch, placeHolderType, toHsType, andMonoBinds,
isSrcRule, collectStmtsBinders
)
import RdrName ( RdrName, getRdrName, mkUnqual, mkRdrUnqual,
lookupRdrEnv, elemRdrEnv )
-import RnHsSyn ( RenamedHsDecl, RenamedStmt, RenamedTyClDecl,
+import RnHsSyn ( RenamedStmt, RenamedTyClDecl,
ruleDeclFVs, instDeclFVs, tyClDeclFVs )
import TcHsSyn ( TypecheckedHsExpr, TypecheckedRuleDecl,
zonkTopBinds, zonkTopDecls, mkHsLet,
import RnNames ( rnImports, exportsFromAvail, reportUnusedNames )
import RnIfaces ( slurpImpDecls, checkVersions, RecompileRequired, outOfDate )
import RnHiFiles ( readIface, loadOldIface )
-import RnEnv ( lookupSrcName, lookupOccRn,
+import RnEnv ( lookupSrcName, lookupOccRn, plusGlobalRdrEnv,
ubiquitousNames, implicitModuleFVs, implicitStmtFVs, dataTcOccs )
import RnExpr ( rnStmts, rnExpr )
import RnNames ( importsFromLocalDecls )
import Id ( Id, mkLocalId, isLocalId, idName, idType, idUnfolding, setIdLocalExported )
import IdInfo ( GlobalIdDetails(..) )
import Var ( Var, setGlobalIdDetails )
-import Module ( Module, moduleName, moduleUserString )
+import Module ( Module, moduleName, moduleUserString, moduleEnvElts )
import Name ( Name, isExternalName, getSrcLoc, nameOccName )
import NameEnv ( delListFromNameEnv )
import NameSet
ModIface, ModDetails(..), ModGuts(..),
HscEnv(..),
ModIface(..), ModDetails(..), IfaceDecls(..),
- GhciMode(..),
+ GhciMode(..), noDependencies,
Deprecations(..), plusDeprecs,
emptyGlobalRdrEnv,
GenAvailInfo(Avail), availsToNameSet,
#ifdef GHCI
import RdrName ( rdrEnvElts )
import RnHiFiles ( loadInterface )
-import RnEnv ( mkGlobalRdrEnv, plusGlobalRdrEnv )
+import RnEnv ( mkGlobalRdrEnv )
import HscTypes ( GlobalRdrElt(..), GlobalRdrEnv, ImportReason(..), Provenance(..),
isLocalGRE )
#endif
do { -- Deal with imports; sets tcg_rdr_env, tcg_imports
(rdr_env, imports) <- rnImports import_decls ;
updGblEnv ( \ gbl -> gbl { tcg_rdr_env = rdr_env,
- tcg_imports = imports })
+ tcg_imports = tcg_imports gbl `plusImportAvails` imports })
$ do {
- traceRn (text "rn1") ;
+ traceRn (text "rn1" <+> ppr (imp_dep_mods imports)) ;
-- Fail if there are any errors so far
-- The error printing (if needed) takes advantage
-- of the tcg_env we have now set
updGblEnv (\gbl -> gbl { tcg_deprecs = tcg_deprecs gbl `plusDeprecs` mod_deprecs })
$ do {
- traceRn (text "rn4") ;
-- Process the export list
export_avails <- exportsFromAvail exports ;
updGblEnv (\gbl -> gbl { tcg_exports = export_avails })
do { addMessages (head msgs_s) ; failM }
else do {
- mapM_ addMessages msgs_s ; -- Add deprecation warnings
- mapM tcLookupGlobal names -- and lookup up the entities
- }}
+ -- Add deprecation warnings
+ mapM_ addMessages msgs_s ;
+
+ -- Slurp in the supporting declarations
+ tcg_env <- importSupportingDecls (mkFVs names) ;
+ setGblEnv tcg_env $ do {
+
+ -- And lookup up the entities
+ mapM tcLookupGlobal names
+ }}}
\end{code}
mod_guts = ModGuts { mg_module = this_mod,
mg_usages = [], -- ToDo: compute usage
mg_dir_imps = [], -- ??
+ mg_deps = noDependencies, -- ??
mg_exports = my_exports,
mg_types = final_type_env,
mg_insts = tcg_insts tcg_env,
-- If there is no splice, we're done
case group_tail of
Nothing -> return (tcg_env, src_fvs1)
- Just (splice_expr, rest_ds) -> do {
+ Just (SpliceDecl splice_expr splice_loc, rest_ds) -> do {
setGblEnv tcg_env $ do {
-
+
+#ifndef GHCI
+ failWithTc (text "Can't do a top-level splice; need a bootstrapped compiler")
+#else
-- Rename the splice expression, and get its supporting decls
- (rn_splice_expr, fvs) <- initRn SourceMode (rnExpr splice_expr) ;
- tcg_env <- importSupportingDecls fvs ;
+ (rn_splice_expr, fvs) <- initRn SourceMode $
+ addSrcLoc splice_loc $
+ rnExpr splice_expr ;
+ tcg_env <- importSupportingDecls (fvs `addOneFV` qTyConName) ;
setGblEnv tcg_env $ do {
-- Execute the splice
(tcg_env, src_fvs2) <- tcRnSrcDecls (spliced_decls ++ rest_ds) ;
return (tcg_env, src_fvs1 `plusFV` src_fvs2)
- }}}}
+ }
+#endif /* GHCI */
+ }}}
\end{code}
tcg_imports gbl })
$ do {
+ failIfErrsM ; -- No point in continuing if (say) we have duplicate declarations
+
-- Rename the source decls
(tcg_env, rn_src_decls, src_fvs) <- initRn SourceMode (rnSrcDecls group) ;
setGblEnv tcg_env $ do {
pprTcGblEnv :: TcGblEnv -> SDoc
pprTcGblEnv (TcGblEnv { tcg_type_env = type_env,
tcg_insts = dfun_ids,
- tcg_rules = rules })
+ tcg_rules = rules,
+ tcg_imports = imports })
= vcat [ ppr_types dfun_ids type_env
, ppr_insts dfun_ids
, vcat (map ppr rules)
- , ppr_gen_tycons (typeEnvTyCons type_env)]
+ , ppr_gen_tycons (typeEnvTyCons type_env)
+ , ppr (moduleEnvElts (imp_dep_mods imports))
+ , ppr (imp_dep_pkgs imports)]
pprModGuts :: ModGuts -> SDoc
pprModGuts (ModGuts { mg_types = type_env,