\section[TcModule]{Typechecking a whole module}
\begin{code}
+{-# OPTIONS -w #-}
+-- The above warning supression flag is a temporary kludge.
+-- While working on this module you are encouraged to remove it and fix
+-- any warnings in the module. See
+-- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
+-- for details
+
module TcRnDriver (
#ifdef GHCI
tcRnStmt, tcRnExpr, tcRnType,
import Id
import Var
import Module
-import UniqFM
+import LazyUniqFM
import Name
import NameEnv
import NameSet
import TcHsType
import TcMType
import TcMatches
-import TcGadt
import RnTypes
import RnExpr
import IfaceEnv
import Util
import Bag
-import Control.Monad ( unless )
+import Control.Monad
import Data.Maybe ( isJust )
\end{code}
tcRnModule hsc_env hsc_src save_rn_syntax
(L loc (HsModule maybe_mod export_ies
- import_decls local_decls mod_deprec _
+ import_decls local_decls mod_deprec
module_info maybe_doc))
= do { showPass (hsc_dflags hsc_env) "Renamer/typechecker" ;
tcg_env <- finishDeprecations (hsc_dflags hsc_env) mod_deprec tcg_env ;
-- Process the export list
+ traceRn (text "rn4a: before exports");
tcg_env <- rnExports (isJust maybe_mod) export_ies tcg_env ;
- traceRn (text "rn4") ;
+ traceRn (text "rn4b: after exportss") ;
-- Compare the hi-boot iface (if any) with the real thing
-- Must be done after processing the exports
let { ldecls = map noLoc decls } ;
- -- Deal with the type declarations; first bring their stuff
- -- into scope, then rname them, then type check them
- tcg_env <- importsFromLocalDecls (mkFakeGroup ldecls) ;
+ -- bring the type and class decls into scope
+ -- ToDo: check that this doesn't need to extract the val binds.
+ -- It seems that only the type and class decls need to be in scope below because
+ -- (a) tcTyAndClassDecls doesn't need the val binds, and
+ -- (b) tcExtCoreBindings doesn't need anything
+ -- (in fact, it might not even need to be in the scope of
+ -- this tcg_env at all)
+ tcg_env <- importsFromLocalDecls False (mkFakeGroup ldecls)
+ emptyUFM {- no fixity decls -} ;
setGblEnv tcg_env $ do {
- rn_decls <- rnTyClDecls ldecls ;
- failIfErrsM ;
+ rn_decls <- checkNoErrs $ rnTyClDecls ldecls ;
-- Dump trace of renaming part
rnDump (ppr rn_decls) ;
-- Typecheck them all together so that
-- any mutually recursive types are done right
- tcg_env <- checkNoErrs (tcTyAndClassDecls emptyModDetails rn_decls) ;
+ tcg_env <- tcTyAndClassDecls emptyModDetails rn_decls ;
-- Make the new type env available to stuff slurped from interface files
setGblEnv tcg_env $ do {
mod_guts = ModGuts { mg_module = this_mod,
mg_boot = False,
- mg_usages = [], -- ToDo: compute usage
- mg_dir_imps = [], -- ??
+ mg_used_names = emptyNameSet, -- ToDo: compute usage
+ mg_dir_imps = emptyModuleEnv, -- ??
mg_deps = noDependencies, -- ??
mg_exports = my_exports,
mg_types = final_type_env,
tcg_rules = rules, tcg_fords = fords } = tcg_env
; all_binds = binds `unionBags` inst_binds } ;
+ failIfErrsM ; -- Don't zonk if there have been errors
+ -- It's a waste of time; and we may get debug warnings
+ -- about strangely-typed TyCons!
+
(bind_ids, binds', fords', rules') <- zonkTopDecls all_binds rules fords ;
let { final_type_env = extendTypeEnvWithIds type_env bind_ids
-- If ds is [] we get ([], Nothing)
-- Deal with decls up to, but not including, the first splice
- (tcg_env, rn_decls) <- checkNoErrs $ rnTopSrcDecls first_group ;
- -- checkNoErrs: stop if renaming fails
+ (tcg_env, rn_decls) <- rnTopSrcDecls first_group ;
+ -- rnTopSrcDecls fails if there are any errors
(tcg_env, tcl_env) <- setGblEnv tcg_env $
tcTopSrcDecls boot_details rn_decls ;
-- Typecheck type/class decls
; traceTc (text "Tc2")
; let tycl_decls = hs_tyclds rn_group
- ; tcg_env <- checkNoErrs (tcTyAndClassDecls emptyModDetails tycl_decls)
+ ; tcg_env <- tcTyAndClassDecls emptyModDetails tycl_decls
; setGblEnv tcg_env $ do {
-- Typecheck instance decls
\begin{code}
------------------------------------------------
rnTopSrcDecls :: HsGroup RdrName -> TcM (TcGblEnv, HsGroup Name)
+-- Fails if there are any errors
rnTopSrcDecls group
- = do { -- Bring top level binders into scope
- tcg_env <- importsFromLocalDecls group ;
- setGblEnv tcg_env $ do {
-
- failIfErrsM ; -- No point in continuing if (say) we have duplicate declarations
+ = do { -- Rename the source decls (with no shadowing; error on duplicates)
+ (tcg_env, rn_decls) <- checkNoErrs $ rnSrcDecls False group ;
- -- Rename the source decls
- (tcg_env, rn_decls) <- rnSrcDecls group ;
- failIfErrsM ;
-
- -- save the renamed syntax, if we want it
+ -- save the renamed syntax, if we want it
let { tcg_env'
| Just grp <- tcg_rn_decls tcg_env
= tcg_env{ tcg_rn_decls = Just (appendGroups grp rn_decls) }
rnDump (ppr rn_decls) ;
return (tcg_env', rn_decls)
- }}
+ }
------------------------------------------------
tcTopSrcDecls :: ModDetails -> HsGroup Name -> TcM (TcGblEnv, TcLclEnv)
-- The latter come in via tycl_decls
traceTc (text "Tc2") ;
- tcg_env <- checkNoErrs (tcTyAndClassDecls boot_details tycl_decls) ;
- -- tcTyAndClassDecls recovers internally, but if anything gave rise to
- -- an error we'd better stop now, to avoid a cascade
+ tcg_env <- tcTyAndClassDecls boot_details tycl_decls ;
+ -- If there are any errors, tcTyAndClassDecls fails here
-- Make these type and class decls available to stuff slurped from interface files
writeMutVar (tcg_type_env_var tcg_env) (tcg_type_env tcg_env) ;
#ifdef GHCI
setInteractiveContext :: HscEnv -> InteractiveContext -> TcRn a -> TcRn a
setInteractiveContext hsc_env icxt thing_inside
- = let
- -- Initialise the tcg_inst_env with instances
- -- from all home modules. This mimics the more selective
- -- call to hptInstances in tcRnModule
- dfuns = fst (hptInstances hsc_env (\mod -> True))
+ = let -- Initialise the tcg_inst_env with instances from all home modules.
+ -- This mimics the more selective call to hptInstances in tcRnModule.
+ (home_insts, home_fam_insts) = hptInstances hsc_env (\mod -> True)
in
updGblEnv (\env -> env {
- tcg_rdr_env = ic_rn_gbl_env icxt,
- tcg_inst_env = extendInstEnvList (tcg_inst_env env) dfuns }) $
-
+ tcg_rdr_env = ic_rn_gbl_env icxt,
+ tcg_inst_env = extendInstEnvList (tcg_inst_env env) home_insts,
+ tcg_fam_inst_env = extendFamInstEnvList (tcg_fam_inst_env env)
+ home_fam_insts
+ }) $
tcExtendGhciEnv (ic_tmp_ids icxt) $
-- tcExtendGhciEnv does lots:
-- None of the Ids should be of unboxed type, because we
-- cast them all to HValues in the end!
- mappM bad_unboxed (filter (isUnLiftedType . idType) zonked_ids) ;
+ mapM bad_unboxed (filter (isUnLiftedType . idType) zonked_ids) ;
traceTc (text "tcs 1") ;
- let { -- (a) Make all the bound ids "global" ids, now that
- -- they're notionally top-level bindings. This is
- -- 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.
- --
- -- (b) Tidy their types; this is important, because :info may
- -- ask to look at them, and :info expects the things it looks
- -- up to have tidy types
- global_ids = map globaliseAndTidy zonked_ids ;
+ let { global_ids = map globaliseAndTidy zonked_ids } ;
{- ---------------------------------------------
At one stage I removed any shadowed bindings from the type_env;
Hence this code is commented out
-------------------------------------------------- -}
- } ;
dumpOptTcRn Opt_D_dump_tc
(vcat [text "Bound Ids" <+> pprWithCommas ppr global_ids,
text "Typechecked expr" <+> ppr zonked_expr]) ;
- returnM (global_ids, zonked_expr)
+ return (global_ids, zonked_expr)
}
where
bad_unboxed id = addErr (sep [ptext SLIT("GHCi can't bind a variable of unlifted type:"),
nest 2 (ppr id <+> dcolon <+> ppr (idType id))])
globaliseAndTidy :: Id -> Id
-globaliseAndTidy id
--- Give the Id a Global Name, and tidy its type
+globaliseAndTidy id -- Note [Interactively-bound Ids in GHCi]
= Id.setIdType (globaliseId VanillaGlobal id) tidy_type
where
tidy_type = tidyTopType (idType id)
\end{code}
+Note [Interactively-bound Ids in GHCi]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+The Ids bound by previous Stmts in Template Haskell are currently
+ a) GlobalIds
+ b) with an Internal Name (not External)
+ c) and a tidied type
+
+ (a) They must be GlobalIds (not LocalIds) 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.
+
+ (b) They retain their Internal names becuase we don't have a suitable
+ Module to name them with. We could revisit this choice.
+
+ (c) Their types are tidied. This is important, because :info may ask
+ to look at them, and :info expects the things it looks up to have
+ tidy types
+
+
+--------------------------------------------------------------------------
+ Typechecking Stmts in GHCi
+
Here is the grand plan, implemented in tcUserStmt
What you type The IO [HValue] that hscStmt returns
; runPlans [ -- Plan A
do { stuff@([it_id], _) <- tcGhciStmts [bind_stmt, print_it]
; it_ty <- zonkTcType (idType it_id)
- ; ifM (isUnitTy it_ty) failM
+ ; when (isUnitTy it_ty) failM
; return stuff },
-- Plan B; a naked bind statment
; let print_plan = do
{ stuff@([v_id], _) <- tcGhciStmts [stmt, print_v]
; v_ty <- zonkTcType (idType v_id)
- ; ifM (isUnitTy v_ty || not (isTauTy v_ty)) failM
+ ; when (isUnitTy v_ty || not (isTauTy v_ty)) failM
; return stuff }
-- The plans are:
= do { ioTyCon <- tcLookupTyCon ioTyConName ;
ret_id <- tcLookupId returnIOName ; -- return @ IO
let {
- io_ty = mkTyConApp ioTyCon [] ;
ret_ty = mkListTy unitTy ;
io_ret_ty = mkTyConApp ioTyCon [ret_ty] ;
- tc_io_stmts stmts = tcStmts DoExpr (tcDoStmt io_ty) stmts
- (emptyRefinement, io_ret_ty) ;
+ tc_io_stmts stmts = tcStmts DoExpr tcDoStmt stmts io_ret_ty ;
names = map unLoc (collectLStmtsBinders stmts) ;
-- OK, we're ready to typecheck the stmts
traceTc (text "TcRnDriver.tcGhciStmts: tc stmts") ;
((tc_stmts, ids), lie) <- getLIE $ tc_io_stmts stmts $ \ _ ->
- mappM tcLookupId names ;
+ mapM tcLookupId names ;
-- Look up the names right in the middle,
-- where they will all be in scope
= do { dflags <- getDOpts ;
-- Dump short output if -ddump-types or -ddump-tc
- ifM (dopt Opt_D_dump_types dflags || dopt Opt_D_dump_tc dflags)
- (dumpTcRn short_dump) ;
+ when (dopt Opt_D_dump_types dflags || dopt Opt_D_dump_tc dflags)
+ (dumpTcRn short_dump) ;
-- Dump bindings if -ddump-tc
dumpOptTcRn Opt_D_dump_tc (mkDumpDoc "Typechecker" full_dump)
tcCoreDump mod_guts
= do { dflags <- getDOpts ;
- ifM (dopt Opt_D_dump_types dflags || dopt Opt_D_dump_tc dflags)
- (dumpTcRn (pprModGuts mod_guts)) ;
+ when (dopt Opt_D_dump_types dflags || dopt Opt_D_dump_tc dflags)
+ (dumpTcRn (pprModGuts mod_guts)) ;
-- Dump bindings if -ddump-tc
dumpOptTcRn Opt_D_dump_tc (mkDumpDoc "Typechecker" full_dump) }
projects / ghc-hetmet.git / blobdiff