From: simonpj@microsoft.com Date: Tue, 6 Nov 2007 13:55:48 +0000 (+0000) Subject: Fix Trac #1814 (staging interaction in Template Haskell and GHCi), and add comments X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=commitdiff_plain;h=3f1b316d7035c55cd712cd39a9981339bcef2e8c Fix Trac #1814 (staging interaction in Template Haskell and GHCi), and add comments An Id bound by GHCi from a previous Stmt is Global but Internal, and I'd forgotten that, leading to unnecessary restrictions when using TH and GHCi together. This patch fixes the problem and adds lots of explanatory comments (which is where most of the extra lines come from). --- diff --git a/compiler/typecheck/TcEnv.lhs b/compiler/typecheck/TcEnv.lhs index 4c87a12..a23795c 100644 --- a/compiler/typecheck/TcEnv.lhs +++ b/compiler/typecheck/TcEnv.lhs @@ -47,7 +47,7 @@ module TcEnv( -- Template Haskell stuff checkWellStaged, spliceOK, bracketOK, tcMetaTy, thLevel, - topIdLvl, + topIdLvl, thTopLevelId, -- New Ids newLocalName, newDFunName, newFamInstTyConName, @@ -604,6 +604,10 @@ tcMetaTy :: Name -> TcM Type tcMetaTy tc_name = tcLookupTyCon tc_name `thenM` \ t -> returnM (mkTyConApp t []) + +thTopLevelId :: Id -> Bool +-- See Note [What is a top-level Id?] in TcSplice +thTopLevelId id = isGlobalId id || isExternalName (idName id) \end{code} diff --git a/compiler/typecheck/TcExpr.lhs b/compiler/typecheck/TcExpr.lhs index 206629c..27b4cf1 100644 --- a/compiler/typecheck/TcExpr.lhs +++ b/compiler/typecheck/TcExpr.lhs @@ -1001,7 +1001,7 @@ thLocalId orig id id_ty th_bind_lvl -------------------------------------- thBrackId orig id ps_var lie_var - | isExternalName id_name + | thTopLevelId id = -- Top-level identifiers in this module, -- (which have External Names) -- are just like the imported case: @@ -1012,7 +1012,7 @@ thBrackId orig id ps_var lie_var -- But we do need to put f into the keep-alive -- set, because after desugaring the code will -- only mention f's *name*, not f itself. - do { keepAliveTc id_name; return id } + do { keepAliveTc id; return id } | otherwise = -- Nested identifiers, such as 'x' in @@ -1044,11 +1044,9 @@ thBrackId orig id ps_var lie_var -- Update the pending splices ; ps <- readMutVar ps_var - ; writeMutVar ps_var ((id_name, nlHsApp (nlHsVar lift) (nlHsVar id)) : ps) + ; writeMutVar ps_var ((idName id, nlHsApp (nlHsVar lift) (nlHsVar id)) : ps) ; return id } } - where - id_name = idName id #endif /* GHCI */ \end{code} diff --git a/compiler/typecheck/TcRnDriver.lhs b/compiler/typecheck/TcRnDriver.lhs index 4443eaf..efe58a1 100644 --- a/compiler/typecheck/TcRnDriver.lhs +++ b/compiler/typecheck/TcRnDriver.lhs @@ -899,16 +899,7 @@ tcRnStmt hsc_env ictxt rdr_stmt mappM 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,7 +919,6 @@ 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, @@ -941,13 +931,35 @@ tcRnStmt hsc_env ictxt rdr_stmt 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 diff --git a/compiler/typecheck/TcRnMonad.lhs b/compiler/typecheck/TcRnMonad.lhs index 396805f..f118f47 100644 --- a/compiler/typecheck/TcRnMonad.lhs +++ b/compiler/typecheck/TcRnMonad.lhs @@ -875,9 +875,11 @@ setLclTypeEnv lcl_env thing_inside recordThUse :: TcM () recordThUse = do { env <- getGblEnv; writeMutVar (tcg_th_used env) True } -keepAliveTc :: Name -> TcM () -- Record the name in the keep-alive set -keepAliveTc n = do { env <- getGblEnv; - ; updMutVar (tcg_keep env) (`addOneToNameSet` n) } +keepAliveTc :: Id -> TcM () -- Record the name in the keep-alive set +keepAliveTc id + | isLocalId id = do { env <- getGblEnv; + ; updMutVar (tcg_keep env) (`addOneToNameSet` idName id) } + | otherwise = return () keepAliveSetTc :: NameSet -> TcM () -- Record the name in the keep-alive set keepAliveSetTc ns = do { env <- getGblEnv; diff --git a/compiler/typecheck/TcRnTypes.lhs b/compiler/typecheck/TcRnTypes.lhs index 9ecb943..eb1cd04 100644 --- a/compiler/typecheck/TcRnTypes.lhs +++ b/compiler/typecheck/TcRnTypes.lhs @@ -369,7 +369,7 @@ type ThLevel = Int -- Incremented when going inside a bracket, -- decremented when going inside a splice -- NB: ThLevel is one greater than the 'n' in Fig 2 of the - -- original "Template meta-programmign for Haskell" paper + -- original "Template meta-programming for Haskell" paper impLevel, topLevel :: ThLevel topLevel = 1 -- Things defined at top level of this module diff --git a/compiler/typecheck/TcSplice.lhs b/compiler/typecheck/TcSplice.lhs index 11e45e4..9ec400d 100644 --- a/compiler/typecheck/TcSplice.lhs +++ b/compiler/typecheck/TcSplice.lhs @@ -78,8 +78,14 @@ import qualified Control.Exception as Exception( userErrors ) Note [Template Haskell levels] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ * Imported things are impLevel (= 0) + +* In GHCi, variables bound by a previous command are treated + as impLevel, because we have bytecode for them. + * Variables are bound at the "current level" + * The current level starts off at topLevel (= 1) + * The level is decremented by splicing $(..) incremented by brackets [| |] incremented by name-quoting 'f @@ -105,12 +111,22 @@ When a variable is used, we compare - Non-top-level Only if there is a liftable instance h = \(x:Int) -> [| x |] +See Note [What is a top-level Id?] + Note [Quoting names] ~~~~~~~~~~~~~~~~~~~~ -A quoted name is a bit like a quoted expression, except that we have no -cross-stage lifting (c.f. TcExpr.thBrackId). +A quoted name 'n is a bit like a quoted expression [| n |], except that we +have no cross-stage lifting (c.f. TcExpr.thBrackId). So, after incrementing +the use-level to account for the brackets, the cases are: -Examples: + bind > use Error + bind = use OK + bind < use + Imported things OK + Top-level things OK + Non-top-level Error + +See Note [What is a top-level Id?] in TcEnv. Examples: f 'map -- OK; also for top-level defns of this module @@ -122,6 +138,20 @@ Examples: [| \x. $(f 'x) |] -- OK +Note [What is a top-level Id?] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +In the level-control criteria above, we need to know what a "top level Id" is. +There are three kinds: + * Imported from another module (GlobalId, ExternalName) + * Bound at the top level of this module (ExternalName) + * In GHCi, bound by a previous stmt (GlobalId) +It's strange that there is no one criterion tht picks out all three, but that's +how it is right now. (The obvious thing is to give an ExternalName to GHCi Ids +bound in an earlier Stmt, but what module would you choose? See +Note [Interactively-bound Ids in GHCi] in TcRnDriver.) + +The predicate we use is TcEnv.thTopLevelId. + %************************************************************************ %* * @@ -175,7 +205,7 @@ tcBracket brack res_ty getLIEVar `thenM` \ lie_var -> setStage (Brack next_level pending_splices lie_var) ( - getLIE (tc_bracket brack) + getLIE (tc_bracket next_level brack) ) `thenM` \ (meta_ty, lie) -> tcSimplifyBracket lie `thenM_` @@ -187,35 +217,34 @@ tcBracket brack res_ty returnM (noLoc (HsBracketOut brack pendings)) } -tc_bracket :: HsBracket Name -> TcM TcType -tc_bracket (VarBr name) -- Note [Quoting names] +tc_bracket :: ThLevel -> HsBracket Name -> TcM TcType +tc_bracket use_lvl (VarBr name) -- Note [Quoting names] = do { thing <- tcLookup name ; case thing of AGlobal _ -> return () - ATcId { tct_level = bind_lvl } - | isExternalName name -- C.f isExternalName case of - -> keepAliveTc name -- TcExpr.thBrackId + ATcId { tct_level = bind_lvl, tct_id = id } + | thTopLevelId id -- C.f thTopLevelId case of + -> keepAliveTc id -- TcExpr.thBrackId | otherwise - -> do { use_stage <- getStage - ; checkTc (thLevel use_stage == bind_lvl) + -> do { checkTc (use_lvl == bind_lvl) (quotedNameStageErr name) } other -> pprPanic "th_bracket" (ppr name) ; tcMetaTy nameTyConName -- Result type is Var (not Q-monadic) } -tc_bracket (ExpBr expr) +tc_bracket use_lvl (ExpBr expr) = do { any_ty <- newFlexiTyVarTy liftedTypeKind ; tcMonoExpr expr any_ty ; tcMetaTy expQTyConName } -- Result type is Expr (= Q Exp) -tc_bracket (TypBr typ) +tc_bracket use_lvl (TypBr typ) = do { tcHsSigType ExprSigCtxt typ ; tcMetaTy typeQTyConName } -- Result type is Type (= Q Typ) -tc_bracket (DecBr decls) +tc_bracket use_lvl (DecBr decls) = do { tcTopSrcDecls emptyModDetails decls -- Typecheck the declarations, dicarding the result -- We'll get all that stuff later, when we splice it in @@ -226,7 +255,7 @@ tc_bracket (DecBr decls) -- Result type is Q [Dec] } -tc_bracket (PatBr _) +tc_bracket use_lvl (PatBr _) = failWithTc (ptext SLIT("Tempate Haskell pattern brackets are not supported yet")) quotedNameStageErr v