From 7975202ba9010c581918413808ee06fbab9ac85f Mon Sep 17 00:00:00 2001 From: romes Date: Sat, 19 Mar 2022 17:42:46 +0000 Subject: TTG: Rework and improve splices This commit redefines the structure of Splices in the AST. We get rid of `HsSplice` which used to represent typed and untyped splices, quasi quotes, and the result of splicing either an expression, a type or a pattern. Instead we have `HsUntypedSplice` which models an untyped splice or a quasi quoter, which works in practice just like untyped splices. The `HsExpr` constructor `HsSpliceE` which used to be constructed with an `HsSplice` is split into `HsTypedSplice` and `HsUntypedSplice`. The former is directly constructed with an `HsExpr` and the latter now takes an `HsUntypedSplice`. Both `HsType` and `Pat` constructors `HsSpliceTy` and `SplicePat` now take an `HsUntypedSplice` instead of a `HsSplice` (remember only /untyped splices/ can be spliced as types or patterns). The result of splicing an expression, type, or pattern is now comfortably stored in the extension fields `XSpliceTy`, `XSplicePat`, `XUntypedSplice` as, respectively, `HsUntypedSpliceResult (HsType GhcRn)`, `HsUntypedSpliceResult (Pat GhcRn)`, and `HsUntypedSpliceResult (HsExpr GhcRn)` Overall the TTG extension points are now better used to make invalid states unrepresentable and model the progression between stages better. See Note [Lifecycle of an untyped splice, and PendingRnSplice] and Note [Lifecycle of an typed splice, and PendingTcSplice] for more details. Updates haddock submodule Fixes #21263 ------------------------- Metric Decrease: hard_hole_fits ------------------------- --- compiler/GHC/Tc/Gen/Expr.hs | 19 +- compiler/GHC/Tc/Gen/Head.hs | 2 +- compiler/GHC/Tc/Gen/HsType.hs | 10 +- compiler/GHC/Tc/Gen/Pat.hs | 8 +- compiler/GHC/Tc/Gen/Sig.hs | 4 +- compiler/GHC/Tc/Gen/Splice.hs | 1037 ++++++++++++++++++++++-------------- compiler/GHC/Tc/Gen/Splice.hs-boot | 10 +- 7 files changed, 659 insertions(+), 431 deletions(-) (limited to 'compiler/GHC/Tc/Gen') diff --git a/compiler/GHC/Tc/Gen/Expr.hs b/compiler/GHC/Tc/Gen/Expr.hs index 45c3dabbe5..e26fee1f98 100644 --- a/compiler/GHC/Tc/Gen/Expr.hs +++ b/compiler/GHC/Tc/Gen/Expr.hs @@ -27,7 +27,7 @@ module GHC.Tc.Gen.Expr import GHC.Prelude -import {-# SOURCE #-} GHC.Tc.Gen.Splice( tcSpliceExpr, tcTypedBracket, tcUntypedBracket ) +import {-# SOURCE #-} GHC.Tc.Gen.Splice( tcTypedSplice, tcTypedBracket, tcUntypedBracket ) import GHC.Hs import GHC.Hs.Syn.Type @@ -565,17 +565,18 @@ tcExpr (HsProjection _ _) _ = panic "GHC.Tc.Gen.Expr: tcExpr: HsProjection: Not ************************************************************************ -} --- HsSpliced is an annotation produced by 'GHC.Rename.Splice.rnSpliceExpr'. -- Here we get rid of it and add the finalizers to the global environment. --- -- See Note [Delaying modFinalizers in untyped splices] in GHC.Rename.Splice. -tcExpr (HsSpliceE _ (HsSpliced _ mod_finalizers (HsSplicedExpr expr))) - res_ty - = do addModFinalizersWithLclEnv mod_finalizers - tcExpr expr res_ty -tcExpr (HsSpliceE _ splice) res_ty = tcSpliceExpr splice res_ty -tcExpr e@(HsTypedBracket _ body) res_ty = tcTypedBracket e body res_ty +tcExpr (HsTypedSplice ext splice) res_ty = tcTypedSplice ext splice res_ty +tcExpr e@(HsTypedBracket _ body) res_ty = tcTypedBracket e body res_ty + tcExpr e@(HsUntypedBracket ps body) res_ty = tcUntypedBracket e body ps res_ty +tcExpr (HsUntypedSplice splice _) res_ty + = case splice of + HsUntypedSpliceTop mod_finalizers expr + -> do { addModFinalizersWithLclEnv mod_finalizers + ; tcExpr expr res_ty } + HsUntypedSpliceNested {} -> panic "tcExpr: invalid nested splice" {- ************************************************************************ diff --git a/compiler/GHC/Tc/Gen/Head.hs b/compiler/GHC/Tc/Gen/Head.hs index 17b1299ab1..f663aab407 100644 --- a/compiler/GHC/Tc/Gen/Head.hs +++ b/compiler/GHC/Tc/Gen/Head.hs @@ -482,7 +482,7 @@ tcInferAppHead_maybe fun args HsRecSel _ f -> Just <$> tcInferRecSelId f ExprWithTySig _ e hs_ty -> Just <$> tcExprWithSig e hs_ty HsOverLit _ lit -> Just <$> tcInferOverLit lit - HsSpliceE _ (HsSpliced _ _ (HsSplicedExpr e)) + HsUntypedSplice (HsUntypedSpliceTop _ e) _ -> tcInferAppHead_maybe e args _ -> return Nothing diff --git a/compiler/GHC/Tc/Gen/HsType.hs b/compiler/GHC/Tc/Gen/HsType.hs index f2e5c92d11..54a38a70b4 100644 --- a/compiler/GHC/Tc/Gen/HsType.hs +++ b/compiler/GHC/Tc/Gen/HsType.hs @@ -1042,9 +1042,11 @@ tc_infer_hs_type mode (HsKindSig _ ty sig) -- splices or not. -- -- See Note [Delaying modFinalizers in untyped splices]. -tc_infer_hs_type mode (HsSpliceTy _ (HsSpliced _ _ (HsSplicedTy ty))) +tc_infer_hs_type mode (HsSpliceTy (HsUntypedSpliceTop _ ty) _) = tc_infer_hs_type mode ty +tc_infer_hs_type _ (HsSpliceTy (HsUntypedSpliceNested n) s) = pprPanic "tc_infer_hs_type: invalid nested splice" (pprUntypedSplice True (Just n) s) + tc_infer_hs_type mode (HsDocTy _ ty _) = tc_infer_lhs_type mode ty -- See Note [Typechecking HsCoreTys] @@ -1142,14 +1144,12 @@ tc_hs_type _ ty@(HsRecTy {}) _ -- while capturing the local environment. -- -- See Note [Delaying modFinalizers in untyped splices]. -tc_hs_type mode (HsSpliceTy _ (HsSpliced _ mod_finalizers (HsSplicedTy ty))) +tc_hs_type mode (HsSpliceTy (HsUntypedSpliceTop mod_finalizers ty) _) exp_kind = do addModFinalizersWithLclEnv mod_finalizers tc_hs_type mode ty exp_kind --- This should never happen; type splices are expanded by the renamer -tc_hs_type _ ty@(HsSpliceTy {}) _exp_kind - = failWithTc $ TcRnUnexpectedTypeSplice ty +tc_hs_type _ (HsSpliceTy (HsUntypedSpliceNested n) s) _ = pprPanic "tc_hs_type: invalid nested splice" (pprUntypedSplice True (Just n) s) ---------- Functions and applications tc_hs_type mode (HsFunTy _ mult ty1 ty2) exp_kind diff --git a/compiler/GHC/Tc/Gen/Pat.hs b/compiler/GHC/Tc/Gen/Pat.hs index 45cedcbc8d..cd429f0cc5 100644 --- a/compiler/GHC/Tc/Gen/Pat.hs +++ b/compiler/GHC/Tc/Gen/Pat.hs @@ -685,15 +685,13 @@ AST is used for the subtraction operation. ge' minus'' ; return (mkHsWrapPat mult_wrap pat' pat_ty, res) } --- HsSpliced is an annotation produced by 'GHC.Rename.Splice.rnSplicePat'. -- Here we get rid of it and add the finalizers to the global environment. --- -- See Note [Delaying modFinalizers in untyped splices] in GHC.Rename.Splice. - SplicePat _ splice -> case splice of - (HsSpliced _ mod_finalizers (HsSplicedPat pat)) -> do + SplicePat (HsUntypedSpliceTop mod_finalizers pat) _ -> do { addModFinalizersWithLclEnv mod_finalizers ; tc_pat pat_ty penv pat thing_inside } - _ -> panic "invalid splice in splice pat" + + SplicePat (HsUntypedSpliceNested _) _ -> panic "tc_pat: nested splice in splice pat" XPat (HsPatExpanded lpat rpat) -> do { (rpat', res) <- tc_pat pat_ty penv rpat thing_inside diff --git a/compiler/GHC/Tc/Gen/Sig.hs b/compiler/GHC/Tc/Gen/Sig.hs index 95cb2f467f..16a46f4454 100644 --- a/compiler/GHC/Tc/Gen/Sig.hs +++ b/compiler/GHC/Tc/Gen/Sig.hs @@ -315,8 +315,8 @@ no_anon_wc_ty lty = go lty && go ty HsQualTy { hst_ctxt = ctxt , hst_body = ty } -> gos (unLoc ctxt) && go ty - HsSpliceTy _ (HsSpliced _ _ (HsSplicedTy ty)) -> go $ L noSrcSpanA ty - HsSpliceTy{} -> True + HsSpliceTy (HsUntypedSpliceTop _ ty) _ -> go $ L noSrcSpanA ty + HsSpliceTy (HsUntypedSpliceNested _) _ -> True HsTyLit{} -> True HsTyVar{} -> True HsStarTy{} -> True diff --git a/compiler/GHC/Tc/Gen/Splice.hs b/compiler/GHC/Tc/Gen/Splice.hs index 1f2c9b66eb..4c6279a6d9 100644 --- a/compiler/GHC/Tc/Gen/Splice.hs +++ b/compiler/GHC/Tc/Gen/Splice.hs @@ -20,9 +20,7 @@ -- | Template Haskell splices module GHC.Tc.Gen.Splice( - tcSpliceExpr, tcTypedBracket, tcUntypedBracket, --- runQuasiQuoteExpr, runQuasiQuotePat, --- runQuasiQuoteDecl, runQuasiQuoteType, + tcTypedSplice, tcTypedBracket, tcUntypedBracket, runAnnotation, runMetaE, runMetaP, runMetaT, runMetaD, runQuasi, @@ -120,6 +118,7 @@ import GHC.Unit.Module.ModIface import GHC.Unit.Module.Deps import GHC.Utils.Misc +import GHC.Utils.Trace import GHC.Utils.Panic as Panic import GHC.Utils.Panic.Plain import GHC.Utils.Lexeme @@ -160,287 +159,9 @@ import GHC.Parser.HaddockLex (lexHsDoc) import GHC.Parser (parseIdentifier) import GHC.Rename.Doc (rnHsDoc) -{- -************************************************************************ -* * -\subsection{Main interface + stubs for the non-GHCI case -* * -************************************************************************ --} - -tcTypedBracket :: HsExpr GhcRn -> LHsExpr GhcRn -> ExpRhoType -> TcM (HsExpr GhcTc) -tcUntypedBracket :: HsExpr GhcRn -> HsQuote GhcRn -> [PendingRnSplice] -> ExpRhoType - -> TcM (HsExpr GhcTc) -tcSpliceExpr :: HsSplice GhcRn -> ExpRhoType -> TcM (HsExpr GhcTc) - -- None of these functions add constraints to the LIE - --- runQuasiQuoteExpr :: HsQuasiQuote RdrName -> RnM (LHsExpr RdrName) --- runQuasiQuotePat :: HsQuasiQuote RdrName -> RnM (LPat RdrName) --- runQuasiQuoteType :: HsQuasiQuote RdrName -> RnM (LHsType RdrName) --- runQuasiQuoteDecl :: HsQuasiQuote RdrName -> RnM [LHsDecl RdrName] - -runAnnotation :: CoreAnnTarget -> LHsExpr GhcRn -> TcM Annotation -{- -************************************************************************ -* * -\subsection{Quoting an expression} -* * -************************************************************************ --} - --- See Note [How brackets and nested splices are handled] -tcTypedBracket rn_expr expr res_ty - = addErrCtxt (quotationCtxtDoc expr) $ - do { cur_stage <- getStage - ; ps_ref <- newMutVar [] - ; lie_var <- getConstraintVar -- Any constraints arising from nested splices - -- should get thrown into the constraint set - -- from outside the bracket - - -- Make a new type variable for the type of the overall quote - ; m_var <- mkTyVarTy <$> mkMetaTyVar - -- Make sure the type variable satisfies Quote - ; ev_var <- emitQuoteWanted m_var - -- Bundle them together so they can be used in GHC.HsToCore.Quote for desugaring - -- brackets. - ; let wrapper = QuoteWrapper ev_var m_var - -- Typecheck expr to make sure it is valid. - -- The typechecked expression won't be used, but we return it with its type. - -- (See Note [The life cycle of a TH quotation] in GHC.Hs.Expr) - -- We'll typecheck it again when we splice it in somewhere - ; (tc_expr, expr_ty) <- setStage (Brack cur_stage (TcPending ps_ref lie_var wrapper)) $ - tcScalingUsage Many $ - -- Scale by Many, TH lifting is currently nonlinear (#18465) - tcInferRhoNC expr - -- NC for no context; tcBracket does that - ; let rep = getRuntimeRep expr_ty - ; meta_ty <- tcTExpTy m_var expr_ty - ; ps' <- readMutVar ps_ref - ; codeco <- tcLookupId unsafeCodeCoerceName - ; bracket_ty <- mkAppTy m_var <$> tcMetaTy expTyConName - ; tcWrapResultO (Shouldn'tHappenOrigin "TH typed bracket expression") - rn_expr - (unLoc (mkHsApp (mkLHsWrap (applyQuoteWrapper wrapper) - (nlHsTyApp codeco [rep, expr_ty])) - (noLocA (HsTypedBracket (HsBracketTc (ExpBr noExtField expr) bracket_ty (Just wrapper) ps') tc_expr)))) - meta_ty res_ty } - --- See Note [Typechecking Overloaded Quotes] -tcUntypedBracket rn_expr brack ps res_ty - = do { traceTc "tc_bracket untyped" (ppr brack $$ ppr ps) - - - -- Create the type m Exp for expression bracket, m Type for a type - -- bracket and so on. The brack_info is a Maybe because the - -- VarBracket ('a) isn't overloaded, but also shouldn't contain any - -- splices. - ; (brack_info, expected_type) <- brackTy brack - - -- Match the expected type with the type of all the internal - -- splices. They might have further constrained types and if they do - -- we want to reflect that in the overall type of the bracket. - ; ps' <- case quoteWrapperTyVarTy <$> brack_info of - Just m_var -> mapM (tcPendingSplice m_var) ps - Nothing -> assert (null ps) $ return [] - - ; traceTc "tc_bracket done untyped" (ppr expected_type) - - -- Unify the overall type of the bracket with the expected result - -- type - ; tcWrapResultO BracketOrigin rn_expr - (HsUntypedBracket (HsBracketTc brack expected_type brack_info ps') (XQuote noExtField)) - -- (XQuote noExtField): see Note [The life cycle of a TH quotation] in GHC.Hs.Expr - expected_type res_ty - - } - --- | A type variable with kind * -> * named "m" -mkMetaTyVar :: TcM TyVar -mkMetaTyVar = - newNamedFlexiTyVar (fsLit "m") (mkVisFunTyMany liftedTypeKind liftedTypeKind) - - --- | For a type 'm', emit the constraint 'Quote m'. -emitQuoteWanted :: Type -> TcM EvVar -emitQuoteWanted m_var = do - quote_con <- tcLookupTyCon quoteClassName - emitWantedEvVar BracketOrigin $ - mkTyConApp quote_con [m_var] - ---------------- --- | Compute the expected type of a quotation, and also the QuoteWrapper in --- the case where it is an overloaded quotation. All quotation forms are --- overloaded aprt from Variable quotations ('foo) -brackTy :: HsQuote GhcRn -> TcM (Maybe QuoteWrapper, Type) -brackTy b = - let mkTy n = do - -- New polymorphic type variable for the bracket - m_var <- mkTyVarTy <$> mkMetaTyVar - -- Emit a Quote constraint for the bracket - ev_var <- emitQuoteWanted m_var - -- Construct the final expected type of the quote, for example - -- m Exp or m Type - final_ty <- mkAppTy m_var <$> tcMetaTy n - -- Return the evidence variable and metavariable to be used during - -- desugaring. - let wrapper = QuoteWrapper ev_var m_var - return (Just wrapper, final_ty) - in - case b of - (VarBr {}) -> (Nothing,) <$> tcMetaTy nameTyConName - -- Result type is Var (not Quote-monadic) - (ExpBr {}) -> mkTy expTyConName -- Result type is m Exp - (TypBr {}) -> mkTy typeTyConName -- Result type is m Type - (DecBrG {}) -> mkTy decsTyConName -- Result type is m [Dec] - (PatBr {}) -> mkTy patTyConName -- Result type is m Pat - (DecBrL {}) -> panic "tcBrackTy: Unexpected DecBrL" - ---------------- --- | Typechecking a pending splice from a untyped bracket -tcPendingSplice :: TcType -- Metavariable for the expected overall type of the - -- quotation. - -> PendingRnSplice - -> TcM PendingTcSplice -tcPendingSplice m_var (PendingRnSplice flavour splice_name expr) - -- See Note [Typechecking Overloaded Quotes] - = do { meta_ty <- tcMetaTy meta_ty_name - -- Expected type of splice, e.g. m Exp - ; let expected_type = mkAppTy m_var meta_ty - ; expr' <- tcScalingUsage Many $ tcCheckPolyExpr expr expected_type - -- Scale by Many, TH lifting is currently nonlinear (#18465) - ; return (PendingTcSplice splice_name expr') } - where - meta_ty_name = case flavour of - UntypedExpSplice -> expTyConName - UntypedPatSplice -> patTyConName - UntypedTypeSplice -> typeTyConName - UntypedDeclSplice -> decsTyConName ---------------- --- Takes a m and tau and returns the type m (TExp tau) -tcTExpTy :: TcType -> TcType -> TcM TcType -tcTExpTy m_ty exp_ty - = do { unless (isTauTy exp_ty) $ addErr (err_msg exp_ty) - ; codeCon <- tcLookupTyCon codeTyConName - ; let rep = getRuntimeRep exp_ty - ; return (mkTyConApp codeCon [rep, m_ty, exp_ty]) } - where - err_msg ty - = TcRnUnknownMessage $ mkPlainError noHints $ - vcat [ text "Illegal polytype:" <+> ppr ty - , text "The type of a Typed Template Haskell expression must" <+> - text "not have any quantification." ] - -quotationCtxtDoc :: LHsExpr GhcRn -> SDoc -quotationCtxtDoc br_body - = hang (text "In the Template Haskell quotation") - 2 (thTyBrackets . ppr $ br_body) - - - -- The whole of the rest of the file is the else-branch (ie stage2 only) {- -Note [How top-level splices are handled] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Top-level splices (those not inside a [| .. |] quotation bracket) are handled -very straightforwardly: - - 1. tcTopSpliceExpr: typecheck the body e of the splice $(e) - - 2. runMetaT: desugar, compile, run it, and convert result back to - GHC.Hs syntax RdrName (of the appropriate flavour, eg HsType RdrName, - HsExpr RdrName etc) - - 3. treat the result as if that's what you saw in the first place - e.g for HsType, rename and kind-check - for HsExpr, rename and type-check - - (The last step is different for decls, because they can *only* be - top-level: we return the result of step 2.) - -Note [How brackets and nested splices are handled] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Nested splices (those inside a [| .. |] quotation bracket), -are treated quite differently. - -Remember, there are two forms of bracket - typed [|| e ||] - and untyped [| e |] - -The life cycle of a typed bracket: - * Starts as HsTypedBracket - - * When renaming: - * Set the ThStage to (Brack s RnPendingTyped) - * Rename the body - * Result is a HsTypedBracket - - * When typechecking: - * Set the ThStage to (Brack s (TcPending ps_var lie_var)) - * Typecheck the body, and keep the elaborated result (despite never using it!) - * Nested splices (which must be typed) are typechecked, and - the results accumulated in ps_var; their constraints - accumulate in lie_var - * Result is a HsTypedBracket (HsBracketTc rn_brack ty quote_wrapper pending_splices) tc_brack - where rn_brack is the untyped renamed exp quote constructed from the typed renamed expression :: HsQuote GhcRn - -The life cycle of a un-typed bracket: - * Starts as HsUntypedBracket - - * When renaming: - * Set the ThStage to (Brack s (RnPendingUntyped ps_var)) - * Rename the body - * Nested splices (which must be untyped) are renamed, and the - results accumulated in ps_var - * Result is a HsUntypedBracket pending_splices rn_body - - * When typechecking: - * Typecheck the pending_splices individually - * Ignore the body of the bracket; just check that the context - expects a bracket of that type (e.g. a [p| pat |] bracket should - be in a context needing a (Q Pat) - * Result is a HsUntypedBracket (HsBracketTc rn_brack ty quote_wrapper pending_splices) (XQuote noExtField) - where rn_brack is the incoming renamed bracket :: HsQuote GhcRn - and (XQuote noExtField) stands for the removal of the `HsQuote GhcTc` field (since `HsQuote GhcTc` isn't possible) - -See the related Note [The life cycle of a TH quotation] - -In both cases, desugaring happens like this: - * Hs*Bracket is desugared by GHC.HsToCore.Quote.dsBracket using the renamed - expression held in `HsBracketTc` (`type instance X*Bracket GhcTc = HsBracketTc`). It - - a) Extends the ds_meta environment with the PendingSplices - attached to the bracket - - b) Converts the quoted (HsExpr Name) to a CoreExpr that, when - run, will produce a suitable TH expression/type/decl. This - is why we leave the *renamed* expression attached to the bracket: - the quoted expression should not be decorated with all the goop - added by the type checker - - * Each splice carries a unique Name, called a "splice point", thus - ${n}(e). The name is initialised to an (Unqual "splice") when the - splice is created; the renamer gives it a unique. - - * When GHC.HsToCore.Quote (used to desugar the body of the bracket) comes across - a splice, it looks up the splice's Name, n, in the ds_meta envt, - to find an (HsExpr Id) that should be substituted for the splice; - it just desugars it to get a CoreExpr (GHC.HsToCore.Quote.repSplice). - -Example: - Source: f = [| Just $(g 3) |] - The [| |] part is a HsUntypedBracket GhcPs - - Typechecked: f = [| Just ${s7}(g 3) |]{s7 = g Int 3} - The [| |] part is a HsUntypedBracket GhcTc, containing *renamed* - (not typechecked) expression (see Note [The life cycle of a TH quotation]) - The "s7" is the "splice point"; the (g Int 3) part - is a typechecked expression - - Desugared: f = do { s7 <- g Int 3 - ; return (ConE "Data.Maybe.Just" s7) } - - Note [Template Haskell state diagram] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Here are the ThStages, s, their corresponding level numbers @@ -523,78 +244,574 @@ Note [Template Haskell levels] g1 = $(map ...) is OK g2 = $(f ...) is not OK; because we haven't compiled f yet -Note [Typechecking Overloaded Quotes] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -The main function for typechecking untyped quotations is `tcUntypedBracket`. +Note [How top-level splices are handled] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Top-level splices (those not inside a [| .. |] quotation bracket) are handled +very straightforwardly: + + 1. tcTopSpliceExpr: typecheck the body e of the splice $(e) + + 2. runMetaT: desugar, compile, run it, and convert result back to + GHC.Hs syntax RdrName (of the appropriate flavour, eg HsType RdrName, + HsExpr RdrName etc) + + 3. treat the result as if that's what you saw in the first place + e.g for HsType, rename and kind-check + for HsExpr, rename and type-check + + (The last step is different for decls, because they can *only* be + top-level: we return the result of step 2.) + +Note [Warnings for TH splices] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +We only produce warnings for TH splices when the user requests so +(-fenable-th-splice-warnings). There are multiple reasons: + + * It's not clear that the user that compiles a splice is the author of the code + that produces the warning. Think of the situation where they just splice in + code from a third-party library that produces incomplete pattern matches. + In this scenario, the user isn't even able to fix that warning. + * Gathering information for producing the warnings (pattern-match check + warnings in particular) is costly. There's no point in doing so if the user + is not interested in those warnings. + +That's why we store Origin flags in the Haskell AST. The functions from ThToHs +take such a flag and depending on whether TH splice warnings were enabled or +not, we pass FromSource (if the user requests warnings) or Generated +(otherwise). This is implemented in getThSpliceOrigin. + +For correct pattern-match warnings it's crucial that we annotate the Origin +consistently (#17270). In the future we could offer the Origin as part of the +TH AST. That would enable us to give quotes from the current module get +FromSource origin, and/or third library authors to tag certain parts of +generated code as FromSource to enable warnings. +That effort is tracked in #14838. + +Note [The life cycle of a TH quotation] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +When desugaring a bracket (aka quotation), we want to produce Core +code that, when run, will produce the TH syntax tree for the quotation. +To that end, we want to desugar /renamed/ but not /typechecked/ code; +the latter is cluttered with the typechecker's elaboration that should +not appear in the TH syntax tree. So in (HsExpr GhcTc) tree, we must +have a (HsExpr GhcRn) for the quotation itself. + +As such, when typechecking both typed and untyped brackets, +we keep a /renamed/ bracket in the extension field. + +The HsBracketTc, the GhcTc ext field for both typed and untyped +brackets, contains: + - The renamed quote :: HsQuote GhcRn -- for the desugarer + - [PendingTcSplice] + - The type of the quote + - Maybe QuoteWrapper + +Note that HsBracketTc stores the untyped (HsQuote GhcRn) for both typed and +untyped brackets. They are treated uniformly by the desugarer, and we can +easily construct untyped brackets from typed ones (with ExpBr). + +See Note [Desugaring of brackets]. + +------------ +Typed quotes +------------ +Here is the life cycle of a /typed/ quote [|| e ||], whose datacon is + HsTypedBracket (XTypedBracket p) (LHsExpr p) + + In pass p (XTypedBracket p) (LHsExpr p) + ------------------------------------------- + GhcPs Annotations only LHsExpr GhcPs + GhcRn Annotations only LHsExpr GhcRn + GhcTc HsBracketTc LHsExpr GhcTc: unused! + +Note that in the GhcTc tree, the second field (HsExpr GhcTc) +is entirely unused; the desugarer uses the (HsExpr GhcRn) from the +first field. + +-------------- +Untyped quotes +-------------- +Here is the life cycle of an /untyped/ quote, whose datacon is + HsUntypedBracket (XUntypedBracket p) (HsQuote p) + +Here HsQuote is a sum-type of expressions [| e |], patterns [| p |], +types [| t |] etc. + + In pass p (XUntypedBracket p) (HsQuote p) + ------------------------------------------------------- + GhcPs Annotations only HsQuote GhcPs + GhcRn Annotations, [PendingRnSplice] HsQuote GhcRn + GhcTc HsBracketTc HsQuote GhcTc: unused! + +The difficulty is: the typechecker does not typecheck the body of an +untyped quote, so how do we make a (HsQuote GhcTc) to put in the +second field? + +Answer: we use the extension constructor of HsQuote, namely XQuote, +and make all the other constructors into DataConCantHappen. That is, +the only non-bottom value of type (HsQuote GhcTc) is (XQuote noExtField). +Hence the instances + + type instance XExpBr GhcTc = DataConCantHappen + ...etc... + +See the related Note [How brackets and nested splices are handled] + +Note [Typechecking Overloaded Quotes] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +The main function for typechecking untyped quotations is `tcUntypedBracket`. + +Consider an expression quote, `[| e |]`, its type is `forall m . Quote m => m Exp`. +Note carefully that this is overloaded: its type is not `Q Exp` for some fixed Q. + +When we typecheck it we therefore create a template of a metavariable +`m` applied to `Exp` and emit a constraint `Quote m`. All this is done +in the `brackTy` function. `brackTy` also selects the correct +contents type for the quotation (Exp, Type, Decs etc). + +The meta variable and the constraint evidence variable are +returned together in a `QuoteWrapper` and then passed along to two further places +during compilation: + +1. Typechecking nested splices (immediately in tcPendingSplice) +2. Desugaring quotations (see GHC.HsToCore.Quote) + +`tcPendingSplice` takes the `m` type variable as an argument and +checks each nested splice against this variable `m`. During this +process the variable `m` can either be fixed to a specific value or +further constrained by the nested splices. + +Once we have checked all the nested splices, the quote type is checked against +the expected return type. + +The process is very simple and like typechecking a list where the quotation is +like the container and the splices are the elements of the list which must have +a specific type. + +After the typechecking process is completed, the evidence variable for `Quote m` +and the type `m` is stored in a `QuoteWrapper` which is passed through the pipeline +and used when desugaring quotations. + +Typechecking typed quotations is a similar idea but the `QuoteWrapper` is stored +in the `PendingStuff` as the nested splices are gathered up in a different way +to untyped splices. Untyped splices are found in the renamer but typed splices are +not typechecked and extracted until during typechecking. + +Note [Lifecycle of an untyped splice, and PendingRnSplice] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Untyped splices $(f x) and quasiquotes [p| stuff |] have the following +life cycle. Remember, quasi-quotes are very like splices; see Note [Quasi-quote overview]). + +The type structure is + + data HsExpr p = ... + | HsUntypedSplice (XUntypedSplice p) (HsUntypedSplice p) + + data HsUntypedSplice p + = HsUntypedSpliceExpr (XUntypedSpliceExpr p) (LHsExpr p) + | HsQuasiQuote (XQuasiQuote p) (IdP id) (XRec p FastString) + +Remember that untyped splices can occur in expressions, patterns, +types, and declarations. So we have a HsUntypedSplice data +constructor in all four of these types. + +Untyped splices never occur in (HsExpr GhcTc), and similarly +patterns etc. So we have + + type instance XUntypedSplice GhcTc = DataConCantHappen + +Top-level and nested splices are handled differently. + +------------------------------------- +Nested untyped splices/quasiquotes +---------------------------------- +When we rename an /untyped/ bracket, such as + [| f $(g x) |] +we name and lift out all the nested splices, so that when the +typechecker hits the bracket, it can typecheck those nested splices +without having to walk over the untyped bracket code. Our example +[| f $(g x) |] parses as + + HsUntypedBracket _ + (HsApp (HsVar "f") + (HsUntypedSplice _ (HsUntypedSpliceExpr _ (g x :: LHsExpr GhcPs))) + +RENAMER (rnUntypedBracket): + +* Set the ThStage to (Brack s (RnPendingUntyped ps_var)) + +* Rename the body + +* Nested splices (which must be untyped) are renamed (rnUntypedSplice), + and the results accumulated in ps_var. Each gets a fresh + SplicePointName, 'spn' + +* The SplicePointName connects the `PendingRnSplice` with the particular point + in the syntax tree where that expresion should be spliced in. That point + in the tree is identified by `(HsUntypedSpliceNested spn)`. It is used by + the desugarer, so that we ultimately generate something like + let spn = g x + in App (Var "f") spn + +The result is + HsUntypedBracket + [PendingRnSplice UntypedExpSplice spn (g x :: LHsExpr GHcRn)] + (HsApp (HsVar f) (HsUntypedSplice (HsUntypedSpliceNested spn) + (HsUntypedSpliceExpr _ (g x :: LHsExpr GhcRn)))) + +Note that a nested splice, such as the `$(g x)` now appears twice: + - In the PendingRnSplice: this is the version that will later be typechecked + - In the HsUntypedSpliceExpr in the body of the bracket. This copy is used + only for pretty printing. + +NB: a single untyped bracket can contain many splices, each of a different +`UntypedSpliceFlavour`. For example + + [| let $e0 in (f :: $e1) $e2 (\ $e -> body ) |] + 1 + +Here $e0 is a declaration splice, $e1 is a type splice, $e2 is an +expression splice, and $e3 is a pattern splice. The `PendingRnSplice` +keeps track of which is which through its `UntypedSpliceFlavour` +field. + +TYPECHECKER (tcUntypedBracket): see also Note [Typechecking Overloaded Quotes] + +* Typecheck the [PendingRnSplice] individually, to give [PendingTcSplice] + So PendingTcSplice is used for both typed and untyped splices. + +* Ignore the body of the bracket; just check that the context + expects a bracket of that type (e.g. a [p| pat |] bracket should + be in a context needing a (m Pat) + +* Stash the whole lot inside a HsBracketTc + +Result is: + HsUntypedBracket + (HsBracketTc { hsb_splices = [PendingTcSplice spn (g x :: LHsExpr GHcTc)] + , hsb_quote = HsApp (HsVar f) + (HsUntypedSplice (HsUntypedSpliceNested spn) + (HsUntypedSpliceExpr _ (g x :: LHsExpr GhcRn))) + }) + (XQuote noExtField) + +NB in the typechecker output, the original payload (which would now +have type (HsQuote GhcTc) is stubbed off with (XQuote noExtField). The payload +is now in the hsb_quote field of the HsBracketTc. + + +------------------------------------- +Top-level untyped splices/quasiquotes +------------------------------------- +A top-level splice (not inside a bracket) does not need a SpliceName, +nor does a top-level splice ever end up inside a PendingRnSplice; +hence HsUntypedSpliceTop does not have a SplicePointName field. + +Example $(g x). This is parsed as + + HsUntypedSplice _ (HsUntypedSpliceExpr _ ((g x) :: LHsExpr GhcPs)) + +Renamer: the renamer runs the splice, so the output of the renamer looks like + + HsUntypedSplice (HsUntypedSpliceTop fins (e2 :: LHsExpr GhcRn)) + (HsUntypedSpliceExpr ((g x) :: LHsExpr GhcRn)) + +where 'e2' is the result of running (g x) to + produce the syntax tree for 'e2' + 'fins' is a bunch of TH finalisers, to be run later. + +Typechecker: the typechecker simply adds the finalisers, and +typechecks e2, discarding the HsUntypedSplice altogether. + + +Note [Lifecycle of an typed splice, and PendingTcSplice] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +---------------------- +Nested, typed splices +---------------------- +When we typecheck a /typed/ bracket, we lift nested splices out as +`PendingTcSplice`, very similar to Note [PendingRnSplice]. Again, the +splice needs a SplicePointName, for the desguarer to use to connect +the splice expression with the point in the syntax tree where it is +used. Example: + [|| f $$(g 2)||] + +Parser: this is parsed as + + HsTypedBracket _ (HsApp (HsVar "f") + (HsTypedSplice _ (g 2 :: LHsExpr GhcPs))) + +RENAMER (rnTypedSplice): the renamer adds a SplicePointName, spn: + + HsTypedBracket _ (HsApp (HsVar "f") + (HsTypedSplice spn (g x :: LHsExpr GhcRn))) + +TYPECHECKER (tcTypedBracket): + +* Set the ThStage to (Brack s (TcPending ps_var lie_var)) + +* Typecheck the body, and keep the elaborated result (despite never using it!) + +* Nested splices (which must be typed) are typechecked by tcNestedSplice, and + the results accumulated in ps_var; their constraints accumulate in lie_var + +* Result is a HsTypedBracket (HsBracketTc rn_brack ty quote_wrapper pending_splices) tc_brack + where rn_brack is the untyped renamed exp quote constructed from the typed renamed expression :: HsQuote GhcRn + +Just like untyped brackets, dump the output into a HsBracketTc. + + HsTypedBracket + (HsBracketTc { hsb_splices = [PendingTcSplice spn (g x :: LHsExpr GHcTc)] + , hsb_quote = HsApp (HsVar f) + (HsUntypedSplice (HsUntypedSpliceNested spn) + (HsUntypedSpliceExpr _ (g x :: LHsExpr GhcRn))) + }) + (panic "should never be looked at") + +NB: we never need to represent typed /nested/ splices in phase GhcTc. + +There are only typed expression splices so `PendingTcSplice` doesn't have a +flavour field. + + +-------------------------------- +Top-level, typed splices $$(f x) +-------------------------------- +Typed splices are renamed and typechecked, but only actually run in +the zonker, after typechecking. See Note [Running typed splices in the zonker] + +* Output of parser: + HsTypedSplice _ (e :: HsExpr GhcPs) + +* Output of renamer: + HsTypedSplice (n :: SplicePointName) (e :: HsExpr GhcRn) + +* Output of typechecker: (top-level splices only) + HsTypedSplice (del_splice :: DelayedSplice) (e :: HsExpr GhcTc) + where 'del_splice' is something the zonker can run to produce + the syntax tree to splice in. + See Note [Running typed splices in the zonker] + +Note [Desugaring of brackets] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +In both cases, desugaring happens like this: + * Hs*Bracket is desugared by GHC.HsToCore.Quote.dsBracket using the renamed + expression held in `HsBracketTc` (`type instance X*Bracket GhcTc = HsBracketTc`). It + + a) Extends the ds_meta environment with the PendingSplices + attached to the bracket + + b) Converts the quoted (HsExpr Name) to a CoreExpr that, when + run, will produce a suitable TH expression/type/decl. This + is why we leave the *renamed* expression attached to the bracket: + the quoted expression should not be decorated with all the goop + added by the type checker + + * Each splice carries a unique Name, called a "splice point", thus + ${n}(e). The name is initialised to an (Unqual "splice") when the + splice is created; the renamer gives it a unique. + + * When GHC.HsToCore.Quote (used to desugar the body of the bracket) comes across + a splice, it looks up the splice's Name, n, in the ds_meta envt, + to find an (HsExpr Id) that should be substituted for the splice; + it just desugars it to get a CoreExpr (GHC.HsToCore.Quote.repSplice). + +Example: + Source: f = [| Just $(g 3) |] + The [| |] part is a HsUntypedBracket GhcPs + + Typechecked: f = [| Just ${s7}(g 3) |]{s7 = g Int 3} + The [| |] part is a HsUntypedBracket GhcTc, containing *renamed* + (not typechecked) expression (see Note [The life cycle of a TH quotation]) + The "s7" is the "splice point"; the (g Int 3) part + is a typechecked expression + + Desugared: f = do { s7 <- g Int 3 + ; return (ConE "Data.Maybe.Just" s7) } + +-} + +{- +************************************************************************ +* * +\subsection{Main interface + stubs for the non-GHCI case +* * +************************************************************************ +-} + +tcTypedBracket :: HsExpr GhcRn -> LHsExpr GhcRn -> ExpRhoType -> TcM (HsExpr GhcTc) +tcUntypedBracket :: HsExpr GhcRn -> HsQuote GhcRn -> [PendingRnSplice] -> ExpRhoType + -> TcM (HsExpr GhcTc) +tcTypedSplice :: Name -> LHsExpr GhcRn -> ExpRhoType -> TcM (HsExpr GhcTc) + -- None of these functions add constraints to the LIE + +runAnnotation :: CoreAnnTarget -> LHsExpr GhcRn -> TcM Annotation +{- +************************************************************************ +* * +\subsection{Quoting an expression} +* * +************************************************************************ +-} + +-- See Note [How brackets and nested splices are handled] +tcTypedBracket rn_expr expr res_ty + = addErrCtxt (quotationCtxtDoc expr) $ + do { cur_stage <- getStage + ; ps_ref <- newMutVar [] + ; lie_var <- getConstraintVar -- Any constraints arising from nested splices + -- should get thrown into the constraint set + -- from outside the bracket + + -- Make a new type variable for the type of the overall quote + ; m_var <- mkTyVarTy <$> mkMetaTyVar + -- Make sure the type variable satisfies Quote + ; ev_var <- emitQuoteWanted m_var + -- Bundle them together so they can be used in GHC.HsToCore.Quote for desugaring + -- brackets. + ; let wrapper = QuoteWrapper ev_var m_var + -- Typecheck expr to make sure it is valid. + -- The typechecked expression won't be used, so we just discard it + -- (See Note [The life cycle of a TH quotation] in GHC.Hs.Expr) + -- We'll typecheck it again when we splice it in somewhere + ; (tc_expr, expr_ty) <- setStage (Brack cur_stage (TcPending ps_ref lie_var wrapper)) $ + tcScalingUsage Many $ + -- Scale by Many, TH lifting is currently nonlinear (#18465) + tcInferRhoNC expr + -- NC for no context; tcBracket does that + ; let rep = getRuntimeRep expr_ty + ; meta_ty <- tcTExpTy m_var expr_ty + ; ps' <- readMutVar ps_ref + ; codeco <- tcLookupId unsafeCodeCoerceName + ; bracket_ty <- mkAppTy m_var <$> tcMetaTy expTyConName + ; let brack_tc = HsBracketTc { hsb_quote = ExpBr noExtField expr, hsb_ty = bracket_ty + , hsb_wrap = Just wrapper, hsb_splices = ps' } + -- The tc_expr is stored here so that the expression can be used in HIE files. + brack_expr = HsTypedBracket brack_tc tc_expr + ; tcWrapResultO (Shouldn'tHappenOrigin "TH typed bracket expression") + rn_expr + (unLoc (mkHsApp (mkLHsWrap (applyQuoteWrapper wrapper) + (nlHsTyApp codeco [rep, expr_ty])) + (noLocA brack_expr))) + meta_ty res_ty } + +-- See Note [Typechecking Overloaded Quotes] +tcUntypedBracket rn_expr brack ps res_ty + = do { traceTc "tc_bracket untyped" (ppr brack $$ ppr ps) + + -- Create the type m Exp for expression bracket, m Type for a type + -- bracket and so on. The brack_info is a Maybe because the + -- VarBracket ('a) isn't overloaded, but also shouldn't contain any + -- splices. + ; (brack_info, expected_type) <- brackTy brack -Consider an expression quote, `[| e |]`, its type is `forall m . Quote m => m Exp`. -When we typecheck it we therefore create a template of a metavariable `m` applied to `Exp` and -emit a constraint `Quote m`. All this is done in the `brackTy` function. -`brackTy` also selects the correct contents type for the quotation (Exp, Type, Decs etc). + -- Match the expected type with the type of all the internal + -- splices. They might have further constrained types and if they do + -- we want to reflect that in the overall type of the bracket. + ; ps' <- case quoteWrapperTyVarTy <$> brack_info of + Just m_var -> mapM (tcPendingSplice m_var) ps + Nothing -> assert (null ps) $ return [] -The meta variable and the constraint evidence variable are -returned together in a `QuoteWrapper` and then passed along to two further places -during compilation: + -- Notice that we don't attempt to typecheck the body + -- of the bracket, which is in brack. + ; traceTc "tc_bracket done untyped" (ppr expected_type) -1. Typechecking nested splices (immediately in tcPendingSplice) -2. Desugaring quotations (see GHC.HsToCore.Quote) + -- Unify the overall type of the bracket with the expected result type + ; tcWrapResultO BracketOrigin rn_expr + (HsUntypedBracket (HsBracketTc { hsb_quote = brack, hsb_ty = expected_type + , hsb_wrap = brack_info, hsb_splices = ps' }) + (XQuote noExtField)) + -- (XQuote noExtField): see Note [The life cycle of a TH quotation] in GHC.Hs.Expr + expected_type res_ty -`tcPendingSplice` takes the `m` type variable as an argument and checks -each nested splice against this variable `m`. During this -process the variable `m` can either be fixed to a specific value or further constrained by the -nested splices. + } -Once we have checked all the nested splices, the quote type is checked against -the expected return type. +-- | A type variable with kind * -> * named "m" +mkMetaTyVar :: TcM TyVar +mkMetaTyVar = + newNamedFlexiTyVar (fsLit "m") (mkVisFunTyMany liftedTypeKind liftedTypeKind) -The process is very simple and like typechecking a list where the quotation is -like the container and the splices are the elements of the list which must have -a specific type. -After the typechecking process is completed, the evidence variable for `Quote m` -and the type `m` is stored in a `QuoteWrapper` which is passed through the pipeline -and used when desugaring quotations. +-- | For a type 'm', emit the constraint 'Quote m'. +emitQuoteWanted :: Type -> TcM EvVar +emitQuoteWanted m_var = do + quote_con <- tcLookupTyCon quoteClassName + emitWantedEvVar BracketOrigin $ + mkTyConApp quote_con [m_var] -Typechecking typed quotations is a similar idea but the `QuoteWrapper` is stored -in the `PendingStuff` as the nested splices are gathered up in a different way -to untyped splices. Untyped splices are found in the renamer but typed splices are -not typechecked and extracted until during typechecking. +--------------- +-- | Compute the expected type of a quotation, and also the QuoteWrapper in +-- the case where it is an overloaded quotation. All quotation forms are +-- overloaded aprt from Variable quotations ('foo) +brackTy :: HsQuote GhcRn -> TcM (Maybe QuoteWrapper, Type) +brackTy b = + let mkTy n = do + -- New polymorphic type variable for the bracket + m_var <- mkTyVarTy <$> mkMetaTyVar + -- Emit a Quote constraint for the bracket + ev_var <- emitQuoteWanted m_var + -- Construct the final expected type of the quote, for example + -- m Exp or m Type + final_ty <- mkAppTy m_var <$> tcMetaTy n + -- Return the evidence variable and metavariable to be used during + -- desugaring. + let wrapper = QuoteWrapper ev_var m_var + return (Just wrapper, final_ty) + in + case b of + (VarBr {}) -> (Nothing,) <$> tcMetaTy nameTyConName + -- Result type is Var (not Quote-monadic) + (ExpBr {}) -> mkTy expTyConName -- Result type is m Exp + (TypBr {}) -> mkTy typeTyConName -- Result type is m Type + (DecBrG {}) -> mkTy decsTyConName -- Result type is m [Dec] + (PatBr {}) -> mkTy patTyConName -- Result type is m Pat + (DecBrL {}) -> panic "tcBrackTy: Unexpected DecBrL" --} +--------------- +-- | Typechecking a pending splice from a untyped bracket +tcPendingSplice :: TcType -- Metavariable for the expected overall type of the + -- quotation. + -> PendingRnSplice + -> TcM PendingTcSplice +tcPendingSplice m_var (PendingRnSplice flavour splice_name expr) + -- See Note [Typechecking Overloaded Quotes] + = do { meta_ty <- tcMetaTy meta_ty_name + -- Expected type of splice, e.g. m Exp + ; let expected_type = mkAppTy m_var meta_ty + ; expr' <- tcScalingUsage Many $ tcCheckPolyExpr expr expected_type + -- Scale by Many, TH lifting is currently nonlinear (#18465) + ; return (PendingTcSplice splice_name expr') } + where + meta_ty_name = case flavour of + UntypedExpSplice -> expTyConName + UntypedPatSplice -> patTyConName + UntypedTypeSplice -> typeTyConName + UntypedDeclSplice -> decsTyConName --- | We only want to produce warnings for TH-splices if the user requests so. --- See Note [Warnings for TH splices]. -getThSpliceOrigin :: TcM Origin -getThSpliceOrigin = do - warn <- goptM Opt_EnableThSpliceWarnings - if warn then return FromSource else return Generated +--------------- +-- Takes a m and tau and returns the type m (TExp tau) +tcTExpTy :: TcType -> TcType -> TcM TcType +tcTExpTy m_ty exp_ty + = do { unless (isTauTy exp_ty) $ addErr (err_msg exp_ty) + ; codeCon <- tcLookupTyCon codeTyConName + ; let rep = getRuntimeRep exp_ty + ; return (mkTyConApp codeCon [rep, m_ty, exp_ty]) } + where + err_msg ty + = TcRnUnknownMessage $ mkPlainError noHints $ + vcat [ text "Illegal polytype:" <+> ppr ty + , text "The type of a Typed Template Haskell expression must" <+> + text "not have any quantification." ] -{- Note [Warnings for TH splices] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -We only produce warnings for TH splices when the user requests so -(-fenable-th-splice-warnings). There are multiple reasons: +quotationCtxtDoc :: LHsExpr GhcRn -> SDoc +quotationCtxtDoc br_body + = hang (text "In the Template Haskell quotation") + 2 (thTyBrackets . ppr $ br_body) - * It's not clear that the user that compiles a splice is the author of the code - that produces the warning. Think of the situation where they just splice in - code from a third-party library that produces incomplete pattern matches. - In this scenario, the user isn't even able to fix that warning. - * Gathering information for producing the warnings (pattern-match check - warnings in particular) is costly. There's no point in doing so if the user - is not interested in those warnings. -That's why we store Origin flags in the Haskell AST. The functions from ThToHs -take such a flag and depending on whether TH splice warnings were enabled or -not, we pass FromSource (if the user requests warnings) or Generated -(otherwise). This is implemented in getThSpliceOrigin. + -- The whole of the rest of the file is the else-branch (ie stage2 only) -For correct pattern-match warnings it's crucial that we annotate the Origin -consistently (#17270). In the future we could offer the Origin as part of the -TH AST. That would enable us to give quotes from the current module get -FromSource origin, and/or third library authors to tag certain parts of -generated code as FromSource to enable warnings. -That effort is tracked in #14838. --} {- ************************************************************************ @@ -604,21 +821,19 @@ That effort is tracked in #14838. ************************************************************************ -} -tcSpliceExpr splice@(HsTypedSplice _ _ name expr) res_ty - = addErrCtxt (spliceCtxtDoc splice) $ +tcTypedSplice splice_name expr res_ty + = addErrCtxt (typedSpliceCtxtDoc splice_name expr) $ setSrcSpan (getLocA expr) $ do { stage <- getStage ; case stage of Splice {} -> tcTopSplice expr res_ty - Brack pop_stage pend -> tcNestedSplice pop_stage pend name expr res_ty + Brack pop_stage pend -> tcNestedSplice pop_stage pend splice_name expr res_ty RunSplice _ -> -- See Note [RunSplice ThLevel] in "GHC.Tc.Types". pprPanic ("tcSpliceExpr: attempted to typecheck a splice when " ++ - "running another splice") (ppr splice) + "running another splice") (pprTypedSplice (Just splice_name) expr) Comp -> tcTopSplice expr res_ty } -tcSpliceExpr splice _ - = pprPanic "tcSpliceExpr" (ppr splice) {- Note [Collecting modFinalizers in typed splices] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -630,6 +845,59 @@ environment (with 'addModFinalizersWithLclEnv'). -} +------------------ +tcTopSplice :: LHsExpr GhcRn -> ExpRhoType -> TcM (HsExpr GhcTc) +tcTopSplice expr res_ty + = do { -- Typecheck the expression, + -- making sure it has type Q (T res_ty) + res_ty <- expTypeToType res_ty + ; q_type <- tcMetaTy qTyConName + -- Top level splices must still be of type Q (TExp a) + ; meta_exp_ty <- tcTExpTy q_type res_ty + ; q_expr <- tcTopSpliceExpr Typed $ + tcCheckMonoExpr expr meta_exp_ty + ; lcl_env <- getLclEnv + ; let delayed_splice + = DelayedSplice lcl_env expr res_ty q_expr + ; return (HsTypedSplice delayed_splice q_expr) + + } + +------------------- +tcTopSpliceExpr :: SpliceType -> TcM (LHsExpr GhcTc) -> TcM (LHsExpr GhcTc) +-- Note [How top-level splices are handled] +-- Type check an expression that is the body of a top-level splice +-- (the caller will compile and run it) +-- Note that set the level to Splice, regardless of the original level, +-- before typechecking the expression. For example: +-- f x = $( ...$(g 3) ... ) +-- The recursive call to tcCheckPolyExpr will simply expand the +-- inner escape before dealing with the outer one + +tcTopSpliceExpr isTypedSplice tc_action + = checkNoErrs $ -- checkNoErrs: must not try to run the thing + -- if the type checker fails! + unsetGOptM Opt_DeferTypeErrors $ + -- Don't defer type errors. Not only are we + -- going to run this code, but we do an unsafe + -- coerce, so we get a seg-fault if, say we + -- splice a type into a place where an expression + -- is expected (#7276) + setStage (Splice isTypedSplice) $ + do { -- Typecheck the expression + (mb_expr', wanted) <- tryCaptureConstraints tc_action + -- If tc_action fails (perhaps because of insoluble constraints) + -- we want to capture and report those constraints, else we may + -- just get a silent failure (#20179). Hence the 'try' part. + + ; const_binds <- simplifyTop wanted + + ; case mb_expr' of + Nothing -> failM -- In this case simplifyTop should have + -- reported some errors + Just expr' -> return $ mkHsDictLet (EvBinds const_binds) expr' } + +------------------ tcNestedSplice :: ThStage -> PendingStuff -> Name -> LHsExpr GhcRn -> ExpRhoType -> TcM (HsExpr GhcTc) -- See Note [How brackets and nested splices are handled] @@ -649,35 +917,13 @@ tcNestedSplice pop_stage (TcPending ps_var lie_var q@(QuoteWrapper _ m_var)) spl ; writeMutVar ps_var (PendingTcSplice splice_name expr'' : ps) -- The returned expression is ignored; it's in the pending splices - -- But we still return a plausible expression - -- (a) in case we print it in debug messages, and - -- (b) because we test whether it is tagToEnum in Tc.Gen.Expr.tcApp - ; return (HsSpliceE noAnn $ - HsSpliced noExtField (ThModFinalizers []) $ - HsSplicedExpr (unLoc expr'')) } - + ; return stubNestedSplice } tcNestedSplice _ _ splice_name _ _ = pprPanic "tcNestedSplice: rename stage found" (ppr splice_name) -tcTopSplice :: LHsExpr GhcRn -> ExpRhoType -> TcM (HsExpr GhcTc) -tcTopSplice expr res_ty - = do { -- Typecheck the expression, - -- making sure it has type Q (T res_ty) - res_ty <- expTypeToType res_ty - ; q_type <- tcMetaTy qTyConName - -- Top level splices must still be of type Q (TExp a) - ; meta_exp_ty <- tcTExpTy q_type res_ty - ; q_expr <- tcTopSpliceExpr Typed $ - tcCheckMonoExpr expr meta_exp_ty - ; lcl_env <- getLclEnv - ; let delayed_splice - = DelayedSplice lcl_env expr res_ty q_expr - ; return (HsSpliceE noAnn (XSplice (HsSplicedT delayed_splice))) - - } - +------------------ -- This is called in the zonker -- See Note [Running typed splices in the zonker] runTopSplice :: DelayedSplice -> TcM (HsExpr GhcTc) @@ -715,15 +961,15 @@ runTopSplice (DelayedSplice lcl_env orig_expr res_ty q_expr) {- ************************************************************************ * * -\subsection{Error messages} + * * ************************************************************************ -} -spliceCtxtDoc :: HsSplice GhcRn -> SDoc -spliceCtxtDoc splice +typedSpliceCtxtDoc :: SplicePointName -> LHsExpr GhcRn -> SDoc +typedSpliceCtxtDoc n splice = hang (text "In the Template Haskell splice") - 2 (pprSplice splice) + 2 (pprTypedSplice (Just n) splice) spliceResultDoc :: LHsExpr GhcTc -> SDoc spliceResultDoc expr @@ -731,39 +977,14 @@ spliceResultDoc expr , nest 2 (char '$' <> ppr expr) , text "To see what the splice expanded to, use -ddump-splices"] -------------------- -tcTopSpliceExpr :: SpliceType -> TcM (LHsExpr GhcTc) -> TcM (LHsExpr GhcTc) --- Note [How top-level splices are handled] --- Type check an expression that is the body of a top-level splice --- (the caller will compile and run it) --- Note that set the level to Splice, regardless of the original level, --- before typechecking the expression. For example: --- f x = $( ...$(g 3) ... ) --- The recursive call to tcCheckPolyExpr will simply expand the --- inner escape before dealing with the outer one - -tcTopSpliceExpr isTypedSplice tc_action - = checkNoErrs $ -- checkNoErrs: must not try to run the thing - -- if the type checker fails! - unsetGOptM Opt_DeferTypeErrors $ - -- Don't defer type errors. Not only are we - -- going to run this code, but we do an unsafe - -- coerce, so we get a seg-fault if, say we - -- splice a type into a place where an expression - -- is expected (#7276) - setStage (Splice isTypedSplice) $ - do { -- Typecheck the expression - (mb_expr', wanted) <- tryCaptureConstraints tc_action - -- If tc_action fails (perhaps because of insoluble constraints) - -- we want to capture and report those constraints, else we may - -- just get a silent failure (#20179). Hence the 'try' part. - - ; const_binds <- simplifyTop wanted +stubNestedSplice :: HsExpr GhcTc +-- Used when we need a (LHsExpr GhcTc) that we are never going +-- to look at. We could use "panic" but that's confusing if we ever +-- do a debug-print. The warning is because this should never happen +-- /except/ when doing debug prints. +stubNestedSplice = warnPprTrace True "stubNestedSplice" empty $ + HsLit noComments (mkHsString "stubNestedSplice") - ; case mb_expr' of - Nothing -> failM -- In this case simplifyTop should have - -- reported some errors - Just expr' -> return $ mkHsDictLet (EvBinds const_binds) expr' } {- ************************************************************************ @@ -1774,6 +1995,14 @@ lookupName is_type_name s Nothing -> mkRdrUnqual occ Just mod -> mkRdrQual (mkModuleName mod) occ +-- | We only want to produce warnings for TH-splices if the user requests so. +-- See Note [Warnings for TH splices]. +getThSpliceOrigin :: TcM Origin +getThSpliceOrigin = do + warn <- goptM Opt_EnableThSpliceWarnings + if warn then return FromSource else return Generated + + getThing :: TH.Name -> TcM TcTyThing getThing th_name = do { name <- lookupThName th_name diff --git a/compiler/GHC/Tc/Gen/Splice.hs-boot b/compiler/GHC/Tc/Gen/Splice.hs-boot index c4cd5f70df..d3aca85c6f 100644 --- a/compiler/GHC/Tc/Gen/Splice.hs-boot +++ b/compiler/GHC/Tc/Gen/Splice.hs-boot @@ -10,13 +10,13 @@ import GHC.Tc.Utils.TcType ( ExpRhoType ) import GHC.Types.Annotations ( Annotation, CoreAnnTarget ) import GHC.Hs.Extension ( GhcRn, GhcPs, GhcTc ) -import GHC.Hs ( HsSplice, HsQuote, HsExpr, LHsExpr, LHsType, - LPat, LHsDecl, ThModFinalizers ) +import GHC.Hs ( HsQuote, HsExpr, LHsExpr, LHsType, LPat, LHsDecl, ThModFinalizers ) import qualified Language.Haskell.TH as TH -tcSpliceExpr :: HsSplice GhcRn - -> ExpRhoType - -> TcM (HsExpr GhcTc) +tcTypedSplice :: Name + -> LHsExpr GhcRn + -> ExpRhoType + -> TcM (HsExpr GhcTc) tcTypedBracket :: HsExpr GhcRn -> LHsExpr GhcRn -- cgit v1.2.1