X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcRnDriver.lhs;h=235b045e7e129dd6e9ca6d1ee8419c896839f604;hb=bddd4b23e32532091a64bdb1c432dfbc8ca84645;hp=c744c1513ab981896a564fc032b1c720ad4d5661;hpb=b9a98f56bf88c69a13b477ab8422fbd71df20019;p=ghc-hetmet.git diff --git a/compiler/typecheck/TcRnDriver.lhs b/compiler/typecheck/TcRnDriver.lhs index c744c15..235b045 100644 --- a/compiler/typecheck/TcRnDriver.lhs +++ b/compiler/typecheck/TcRnDriver.lhs @@ -102,7 +102,7 @@ import Maybes import Util import Bag -import Control.Monad ( unless ) +import Control.Monad import Data.Maybe ( isJust ) \end{code} @@ -320,8 +320,8 @@ tcRnExtCore hsc_env (HsExtCore this_mod decls src_binds) 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, @@ -896,19 +896,10 @@ tcRnStmt hsc_env ictxt rdr_stmt -- 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; @@ -928,26 +919,47 @@ tcRnStmt hsc_env ictxt rdr_stmt 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 @@ -1000,7 +1012,7 @@ mkPlan (L loc (ExprStmt expr _ _)) -- An expression typed at the prompt ; 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 @@ -1025,7 +1037,7 @@ mkPlan stmt@(L loc (BindStmt {})) ; 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: @@ -1044,10 +1056,9 @@ tcGhciStmts stmts = 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 + tc_io_stmts stmts = tcStmts DoExpr tcDoStmt stmts (emptyRefinement, io_ret_ty) ; names = map unLoc (collectLStmtsBinders stmts) ; @@ -1072,7 +1083,7 @@ tcGhciStmts 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 @@ -1317,8 +1328,8 @@ tcDump env = 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) @@ -1331,8 +1342,8 @@ tcDump env 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) }