X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcSplice.lhs;h=50bbc3cd1c91095e5ef78ddbeb401ade5b16cb2d;hp=11e45e401b2ceb0a321b144c57741814178361f3;hb=f3399c446c7507d46d6cc550aa2fe7027dbc1b5b;hpb=c8a60d43ddd698d673d80711d8e24b87c02cf856 diff --git a/compiler/typecheck/TcSplice.lhs b/compiler/typecheck/TcSplice.lhs index 11e45e4..50bbc3c 100644 --- a/compiler/typecheck/TcSplice.lhs +++ b/compiler/typecheck/TcSplice.lhs @@ -13,7 +13,8 @@ TcSplice: Template Haskell splices -- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings -- for details -module TcSplice( tcSpliceExpr, tcSpliceDecls, tcBracket ) where +module TcSplice( tcSpliceExpr, tcSpliceDecls, tcBracket, + runQuasiQuoteExpr, runQuasiQuotePat ) where #include "HsVersions.h" @@ -78,8 +79,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 +112,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: + + bind > use Error + bind = use OK + bind < use + Imported things OK + Top-level things OK + Non-top-level Error -Examples: +See Note [What is a top-level Id?] in TcEnv. Examples: f 'map -- OK; also for top-level defns of this module @@ -122,6 +139,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. + %************************************************************************ %* * @@ -135,9 +166,15 @@ tcSpliceExpr :: HsSplice Name -> BoxyRhoType -> TcM (HsExpr TcId) kcSpliceType :: HsSplice Name -> TcM (HsType Name, TcKind) -- None of these functions add constraints to the LIE +runQuasiQuoteExpr :: HsQuasiQuote Name -> TcM (LHsExpr RdrName) +runQuasiQuotePat :: HsQuasiQuote Name -> TcM (LPat RdrName) + #ifndef GHCI tcSpliceExpr n e ty = pprPanic "Cant do tcSpliceExpr without GHCi" (ppr e) tcSpliceDecls e = pprPanic "Cant do tcSpliceDecls without GHCi" (ppr e) + +runQuasiQuoteExpr q = pprPanic "Cant do runQuasiQuoteExpr without GHCi" (ppr q) +runQuasiQuotePat q = pprPanic "Cant do runQuasiQuotePat without GHCi" (ppr q) #else \end{code} @@ -175,7 +212,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 +224,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 +262,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 @@ -329,6 +365,80 @@ tcTopSpliceExpr expr meta_ty %************************************************************************ %* * + Quasi-quoting +%* * +%************************************************************************ + +Note [Quasi-quote overview] +~~~~~~~~~~~~~~~~~~~~~~~~~~~ +The GHC "quasi-quote" extension is described by Geoff Mainland's paper +"Why it's nice to be quoted: quasiquoting for Haskell" (Haskell +Workshop 2007). + +Briefly, one writes + [:p| stuff |] +and the arbitrary string "stuff" gets parsed by the parser 'p', whose +type should be Language.Haskell.TH.Quote.QuasiQuoter. 'p' must be +defined in another module, because we are going to run it here. It's +a bit like a TH splice: + $(p "stuff") + +However, you can do this in patterns as well as terms. Becuase of this, +the splice is run by the *renamer* rather than the type checker. + +\begin{code} +runQuasiQuote :: Outputable hs_syn + => HsQuasiQuote Name -- Contains term of type QuasiQuoter, and the String + -> Name -- Of type QuasiQuoter -> String -> Q th_syn + -> String -- Documentation string only + -> Name -- Name of th_syn type + -> (SrcSpan -> th_syn -> Either Message hs_syn) + -> TcM hs_syn +runQuasiQuote (HsQuasiQuote name quoter q_span quote) quote_selector desc meta_ty convert + = do { -- Check that the quoter is not locally defined, otherwise the TH + -- machinery will not be able to run the quasiquote. + ; this_mod <- getModule + ; let is_local = case nameModule_maybe quoter of + Just mod | mod == this_mod -> True + | otherwise -> False + Nothing -> True + ; traceTc (text "runQQ" <+> ppr quoter <+> ppr is_local) + ; checkTc (not is_local) (quoteStageError quoter) + + -- Build the expression + ; let quoterExpr = L q_span $! HsVar $! quoter + ; let quoteExpr = L q_span $! HsLit $! HsString quote + ; let expr = L q_span $ + HsApp (L q_span $ + HsApp (L q_span (HsVar quote_selector)) quoterExpr) quoteExpr + ; recordThUse + ; meta_exp_ty <- tcMetaTy meta_ty + + -- Typecheck the expression + ; zonked_q_expr <- tcTopSpliceExpr expr meta_exp_ty + + -- Run the expression + ; traceTc (text "About to run" <+> ppr zonked_q_expr) + ; result <- runMeta convert zonked_q_expr + ; traceTc (text "Got result" <+> ppr result) + ; showSplice desc zonked_q_expr (ppr result) + ; return result + } + +runQuasiQuoteExpr quasiquote + = runQuasiQuote quasiquote quoteExpName "expression" expQTyConName convertToHsExpr + +runQuasiQuotePat quasiquote + = runQuasiQuote quasiquote quotePatName "pattern" patQTyConName convertToPat + +quoteStageError quoter + = sep [ptext SLIT("GHC stage restriction:") <+> ppr quoter, + nest 2 (ptext SLIT("is used in a quasiquote, and must be imported, not defined locally"))] +\end{code} + + +%************************************************************************ +%* * Splicing a type %* * %************************************************************************ @@ -434,6 +544,11 @@ runMetaE :: (SrcSpan -> TH.Exp -> Either Message (LHsExpr RdrName)) -> TcM (LHsExpr RdrName) runMetaE = runMeta +runMetaP :: (SrcSpan -> TH.Pat -> Either Message (Pat RdrName)) + -> LHsExpr Id -- Of type (Q Pat) + -> TcM (Pat RdrName) +runMetaP = runMeta + runMetaT :: (SrcSpan -> TH.Type -> Either Message (LHsType RdrName)) -> LHsExpr Id -- Of type (Q Type) -> TcM (LHsType RdrName) @@ -470,9 +585,12 @@ runMeta convert expr -- encounter them inside the try -- -- See Note [Exceptions in TH] - either_tval <- tryAllM $ do - { th_syn <- TH.runQ (unsafeCoerce# hval) - ; case convert (getLoc expr) th_syn of + let expr_span = getLoc expr + ; either_tval <- tryAllM $ + setSrcSpan expr_span $ -- Set the span so that qLocation can + -- see where this splice is + do { th_syn <- TH.runQ (unsafeCoerce# hval) + ; case convert expr_span th_syn of Left err -> failWithTc err Right hs_syn -> return hs_syn } @@ -531,10 +649,14 @@ instance TH.Quasi (IOEnv (Env TcGblEnv TcLclEnv)) where qReport True msg = addErr (text msg) qReport False msg = addReport (text msg) - qCurrentModule = do { m <- getModule; - return (moduleNameString (moduleName m)) } - -- ToDo: is throwing away the package name ok here? - + qLocation = do { m <- getModule + ; l <- getSrcSpanM + ; return (TH.Loc { TH.loc_filename = unpackFS (srcSpanFile l) + , TH.loc_module = moduleNameString (moduleName m) + , TH.loc_package = packageIdString (modulePackageId m) + , TH.loc_start = (srcSpanStartLine l, srcSpanStartCol l) + , TH.loc_end = (srcSpanEndLine l, srcSpanEndCol l) }) } + qReify v = reify v -- For qRecover, discard error messages if