never executed always true always false
1
2 {-# LANGUAGE TypeFamilies #-}
3
4 {-# OPTIONS_GHC -Wno-incomplete-record-updates #-}
5
6 module GHC.Rename.Splice (
7 rnTopSpliceDecls,
8 rnSpliceType, rnSpliceExpr, rnSplicePat, rnSpliceDecl,
9 rnBracket,
10 checkThLocalName
11 , traceSplice, SpliceInfo(..)
12 ) where
13
14 import GHC.Prelude
15
16 import GHC.Types.Name
17 import GHC.Types.Name.Set
18 import GHC.Hs
19 import GHC.Types.Name.Reader
20 import GHC.Tc.Errors.Types
21 import GHC.Tc.Utils.Monad
22 import GHC.Driver.Env.Types
23
24 import GHC.Rename.Env
25 import GHC.Rename.Utils ( HsDocContext(..), newLocalBndrRn )
26 import GHC.Rename.Unbound ( isUnboundName )
27 import GHC.Rename.Module ( rnSrcDecls, findSplice )
28 import GHC.Rename.Pat ( rnPat )
29 import GHC.Types.Error
30 import GHC.Types.Basic ( TopLevelFlag, isTopLevel )
31 import GHC.Types.SourceText ( SourceText(..) )
32 import GHC.Utils.Outputable
33 import GHC.Unit.Module
34 import GHC.Types.SrcLoc
35 import GHC.Rename.HsType ( rnLHsType )
36
37 import Control.Monad ( unless, when )
38
39 import {-# SOURCE #-} GHC.Rename.Expr ( rnLExpr )
40
41 import GHC.Tc.Utils.Env ( checkWellStaged, tcMetaTy )
42
43 import GHC.Driver.Session
44 import GHC.Data.FastString
45 import GHC.Utils.Logger
46 import GHC.Utils.Panic
47 import GHC.Driver.Hooks
48 import GHC.Builtin.Names.TH ( decsQTyConName, expQTyConName, liftName
49 , patQTyConName, quoteDecName, quoteExpName
50 , quotePatName, quoteTypeName, typeQTyConName)
51
52 import {-# SOURCE #-} GHC.Tc.Gen.Expr ( tcCheckPolyExpr )
53 import {-# SOURCE #-} GHC.Tc.Gen.Splice
54 ( runMetaD
55 , runMetaE
56 , runMetaP
57 , runMetaT
58 , tcTopSpliceExpr
59 )
60
61 import GHC.Tc.Utils.Zonk
62
63 import GHCi.RemoteTypes ( ForeignRef )
64 import qualified Language.Haskell.TH as TH (Q)
65
66 import qualified GHC.LanguageExtensions as LangExt
67
68 {-
69 ************************************************************************
70 * *
71 Template Haskell brackets
72 * *
73 ************************************************************************
74 -}
75
76 rnBracket :: HsExpr GhcPs -> HsBracket GhcPs -> RnM (HsExpr GhcRn, FreeVars)
77 rnBracket e br_body
78 = addErrCtxt (quotationCtxtDoc br_body) $
79 do { -- Check that -XTemplateHaskellQuotes is enabled and available
80 thQuotesEnabled <- xoptM LangExt.TemplateHaskellQuotes
81 ; unless thQuotesEnabled $
82 failWith ( TcRnUnknownMessage $ mkPlainError noHints $ vcat
83 [ text "Syntax error on" <+> ppr e
84 , text ("Perhaps you intended to use TemplateHaskell"
85 ++ " or TemplateHaskellQuotes") ] )
86
87 -- Check for nested brackets
88 ; cur_stage <- getStage
89 ; case cur_stage of
90 { Splice Typed -> checkTc (isTypedBracket br_body)
91 illegalUntypedBracket
92 ; Splice Untyped -> checkTc (not (isTypedBracket br_body))
93 illegalTypedBracket
94 ; RunSplice _ ->
95 -- See Note [RunSplice ThLevel] in GHC.Tc.Types.
96 pprPanic "rnBracket: Renaming bracket when running a splice"
97 (ppr e)
98 ; Comp -> return ()
99 ; Brack {} -> failWithTc illegalBracket
100 }
101
102 -- Brackets are desugared to code that mentions the TH package
103 ; recordThUse
104
105 ; case isTypedBracket br_body of
106 True -> do { traceRn "Renaming typed TH bracket" empty
107 ; (body', fvs_e) <-
108 setStage (Brack cur_stage RnPendingTyped) $
109 rn_bracket cur_stage br_body
110 ; return (HsBracket noAnn body', fvs_e) }
111
112 False -> do { traceRn "Renaming untyped TH bracket" empty
113 ; ps_var <- newMutVar []
114 ; (body', fvs_e) <-
115 -- See Note [Rebindable syntax and Template Haskell]
116 unsetXOptM LangExt.RebindableSyntax $
117 setStage (Brack cur_stage (RnPendingUntyped ps_var)) $
118 rn_bracket cur_stage br_body
119 ; pendings <- readMutVar ps_var
120 ; return (HsRnBracketOut noExtField body' pendings, fvs_e) }
121 }
122
123 rn_bracket :: ThStage -> HsBracket GhcPs -> RnM (HsBracket GhcRn, FreeVars)
124 rn_bracket outer_stage br@(VarBr x flg rdr_name)
125 = do { name <- lookupOccRn (unLoc rdr_name)
126 ; this_mod <- getModule
127
128 ; when (flg && nameIsLocalOrFrom this_mod name) $
129 -- Type variables can be quoted in TH. See #5721.
130 do { mb_bind_lvl <- lookupLocalOccThLvl_maybe name
131 ; case mb_bind_lvl of
132 { Nothing -> return () -- Can happen for data constructors,
133 -- but nothing needs to be done for them
134
135 ; Just (top_lvl, bind_lvl) -- See Note [Quoting names]
136 | isTopLevel top_lvl
137 -> when (isExternalName name) (keepAlive name)
138 | otherwise
139 -> do { traceRn "rn_bracket VarBr"
140 (ppr name <+> ppr bind_lvl
141 <+> ppr outer_stage)
142 ; checkTc (thLevel outer_stage + 1 == bind_lvl)
143 (quotedNameStageErr br) }
144 }
145 }
146 ; return (VarBr x flg (noLocA name), unitFV name) }
147
148 rn_bracket _ (ExpBr x e) = do { (e', fvs) <- rnLExpr e
149 ; return (ExpBr x e', fvs) }
150
151 rn_bracket _ (PatBr x p)
152 = rnPat ThPatQuote p $ \ p' -> return (PatBr x p', emptyFVs)
153
154 rn_bracket _ (TypBr x t) = do { (t', fvs) <- rnLHsType TypBrCtx t
155 ; return (TypBr x t', fvs) }
156
157 rn_bracket _ (DecBrL x decls)
158 = do { group <- groupDecls decls
159 ; gbl_env <- getGblEnv
160 ; let new_gbl_env = gbl_env { tcg_dus = emptyDUs }
161 -- The emptyDUs is so that we just collect uses for this
162 -- group alone in the call to rnSrcDecls below
163 ; (tcg_env, group') <- setGblEnv new_gbl_env $
164 rnSrcDecls group
165
166 -- Discard the tcg_env; it contains only extra info about fixity
167 ; traceRn "rn_bracket dec" (ppr (tcg_dus tcg_env) $$
168 ppr (duUses (tcg_dus tcg_env)))
169 ; return (DecBrG x group', duUses (tcg_dus tcg_env)) }
170 where
171 groupDecls :: [LHsDecl GhcPs] -> RnM (HsGroup GhcPs)
172 groupDecls decls
173 = do { (group, mb_splice) <- findSplice decls
174 ; case mb_splice of
175 { Nothing -> return group
176 ; Just (splice, rest) ->
177 do { group' <- groupDecls rest
178 ; let group'' = appendGroups group group'
179 ; return group'' { hs_splcds = noLocA splice : hs_splcds group' }
180 }
181 }}
182
183 rn_bracket _ (DecBrG {}) = panic "rn_bracket: unexpected DecBrG"
184
185 rn_bracket _ (TExpBr x e) = do { (e', fvs) <- rnLExpr e
186 ; return (TExpBr x e', fvs) }
187
188 quotationCtxtDoc :: HsBracket GhcPs -> SDoc
189 quotationCtxtDoc br_body
190 = hang (text "In the Template Haskell quotation")
191 2 (ppr br_body)
192
193 illegalBracket :: TcRnMessage
194 illegalBracket = TcRnUnknownMessage $ mkPlainError noHints $
195 text "Template Haskell brackets cannot be nested" <+>
196 text "(without intervening splices)"
197
198 illegalTypedBracket :: TcRnMessage
199 illegalTypedBracket = TcRnUnknownMessage $ mkPlainError noHints $
200 text "Typed brackets may only appear in typed splices."
201
202 illegalUntypedBracket :: TcRnMessage
203 illegalUntypedBracket = TcRnUnknownMessage $ mkPlainError noHints $
204 text "Untyped brackets may only appear in untyped splices."
205
206 quotedNameStageErr :: HsBracket GhcPs -> TcRnMessage
207 quotedNameStageErr br
208 = TcRnUnknownMessage $ mkPlainError noHints $
209 sep [ text "Stage error: the non-top-level quoted name" <+> ppr br
210 , text "must be used at the same stage at which it is bound" ]
211
212
213 {-
214 *********************************************************
215 * *
216 Splices
217 * *
218 *********************************************************
219
220 Note [Free variables of typed splices]
221 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
222 Consider renaming this:
223 f = ...
224 h = ...$(thing "f")...
225
226 where the splice is a *typed* splice. The splice can expand into
227 literally anything, so when we do dependency analysis we must assume
228 that it might mention 'f'. So we simply treat all locally-defined
229 names as mentioned by any splice. This is terribly brutal, but I
230 don't see what else to do. For example, it'll mean that every
231 locally-defined thing will appear to be used, so no unused-binding
232 warnings. But if we miss the dependency, then we might typecheck 'h'
233 before 'f', and that will crash the type checker because 'f' isn't in
234 scope.
235
236 Currently, I'm not treating a splice as also mentioning every import,
237 which is a bit inconsistent -- but there are a lot of them. We might
238 thereby get some bogus unused-import warnings, but we won't crash the
239 type checker. Not very satisfactory really.
240
241 Note [Renamer errors]
242 ~~~~~~~~~~~~~~~~~~~~~
243 It's important to wrap renamer calls in checkNoErrs, because the
244 renamer does not fail for out of scope variables etc. Instead it
245 returns a bogus term/type, so that it can report more than one error.
246 We don't want the type checker to see these bogus unbound variables.
247 -}
248
249 rnSpliceGen :: (HsSplice GhcRn -> RnM (a, FreeVars))
250 -- Outside brackets, run splice
251 -> (HsSplice GhcRn -> (PendingRnSplice, a))
252 -- Inside brackets, make it pending
253 -> HsSplice GhcPs
254 -> RnM (a, FreeVars)
255 rnSpliceGen run_splice pend_splice splice
256 = addErrCtxt (spliceCtxt splice) $ do
257 { stage <- getStage
258 ; case stage of
259 Brack pop_stage RnPendingTyped
260 -> do { checkTc is_typed_splice illegalUntypedSplice
261 ; (splice', fvs) <- setStage pop_stage $
262 rnSplice splice
263 ; let (_pending_splice, result) = pend_splice splice'
264 ; return (result, fvs) }
265
266 Brack pop_stage (RnPendingUntyped ps_var)
267 -> do { checkTc (not is_typed_splice) illegalTypedSplice
268 ; (splice', fvs) <- setStage pop_stage $
269 rnSplice splice
270 ; let (pending_splice, result) = pend_splice splice'
271 ; ps <- readMutVar ps_var
272 ; writeMutVar ps_var (pending_splice : ps)
273 ; return (result, fvs) }
274
275 _ -> do { checkTopSpliceAllowed splice
276 ; (splice', fvs1) <- checkNoErrs $
277 setStage (Splice splice_type) $
278 rnSplice splice
279 -- checkNoErrs: don't attempt to run the splice if
280 -- renaming it failed; otherwise we get a cascade of
281 -- errors from e.g. unbound variables
282 ; (result, fvs2) <- run_splice splice'
283 ; return (result, fvs1 `plusFV` fvs2) } }
284 where
285 is_typed_splice = isTypedSplice splice
286 splice_type = if is_typed_splice
287 then Typed
288 else Untyped
289
290
291 -- Nested splices are fine without TemplateHaskell because they
292 -- are not executed until the top-level splice is run.
293 checkTopSpliceAllowed :: HsSplice GhcPs -> RnM ()
294 checkTopSpliceAllowed splice = do
295 let (herald, ext) = spliceExtension splice
296 extEnabled <- xoptM ext
297 unless extEnabled
298 (failWith $ TcRnUnknownMessage $ mkPlainError noHints $
299 text herald <+> text "are not permitted without" <+> ppr ext)
300 where
301 spliceExtension :: HsSplice GhcPs -> (String, LangExt.Extension)
302 spliceExtension (HsQuasiQuote {}) = ("Quasi-quotes", LangExt.QuasiQuotes)
303 spliceExtension (HsTypedSplice {}) = ("Top-level splices", LangExt.TemplateHaskell)
304 spliceExtension (HsUntypedSplice {}) = ("Top-level splices", LangExt.TemplateHaskell)
305 spliceExtension s@(HsSpliced {}) = pprPanic "spliceExtension" (ppr s)
306
307 ------------------
308
309 -- | Returns the result of running a splice and the modFinalizers collected
310 -- during the execution.
311 --
312 -- See Note [Delaying modFinalizers in untyped splices].
313 runRnSplice :: UntypedSpliceFlavour
314 -> (LHsExpr GhcTc -> TcRn res)
315 -> (res -> SDoc) -- How to pretty-print res
316 -- Usually just ppr, but not for [Decl]
317 -> HsSplice GhcRn -- Always untyped
318 -> TcRn (res, [ForeignRef (TH.Q ())])
319 runRnSplice flavour run_meta ppr_res splice
320 = do { hooks <- hsc_hooks <$> getTopEnv
321 ; splice' <- case runRnSpliceHook hooks of
322 Nothing -> return splice
323 Just h -> h splice
324
325 ; let the_expr = case splice' of
326 HsUntypedSplice _ _ _ e -> e
327 HsQuasiQuote _ _ q qs str -> mkQuasiQuoteExpr flavour q qs str
328 HsTypedSplice {} -> pprPanic "runRnSplice" (ppr splice)
329 HsSpliced {} -> pprPanic "runRnSplice" (ppr splice)
330
331 -- Typecheck the expression
332 ; meta_exp_ty <- tcMetaTy meta_ty_name
333 ; zonked_q_expr <- zonkTopLExpr =<<
334 tcTopSpliceExpr Untyped
335 (tcCheckPolyExpr the_expr meta_exp_ty)
336
337 -- Run the expression
338 ; mod_finalizers_ref <- newTcRef []
339 ; result <- setStage (RunSplice mod_finalizers_ref) $
340 run_meta zonked_q_expr
341 ; mod_finalizers <- readTcRef mod_finalizers_ref
342 ; traceSplice (SpliceInfo { spliceDescription = what
343 , spliceIsDecl = is_decl
344 , spliceSource = Just the_expr
345 , spliceGenerated = ppr_res result })
346
347 ; return (result, mod_finalizers) }
348
349 where
350 meta_ty_name = case flavour of
351 UntypedExpSplice -> expQTyConName
352 UntypedPatSplice -> patQTyConName
353 UntypedTypeSplice -> typeQTyConName
354 UntypedDeclSplice -> decsQTyConName
355 what = case flavour of
356 UntypedExpSplice -> "expression"
357 UntypedPatSplice -> "pattern"
358 UntypedTypeSplice -> "type"
359 UntypedDeclSplice -> "declarations"
360 is_decl = case flavour of
361 UntypedDeclSplice -> True
362 _ -> False
363
364 ------------------
365 makePending :: UntypedSpliceFlavour
366 -> HsSplice GhcRn
367 -> PendingRnSplice
368 makePending flavour (HsUntypedSplice _ _ n e)
369 = PendingRnSplice flavour n e
370 makePending flavour (HsQuasiQuote _ n quoter q_span quote)
371 = PendingRnSplice flavour n (mkQuasiQuoteExpr flavour quoter q_span quote)
372 makePending _ splice@(HsTypedSplice {})
373 = pprPanic "makePending" (ppr splice)
374 makePending _ splice@(HsSpliced {})
375 = pprPanic "makePending" (ppr splice)
376
377 ------------------
378 mkQuasiQuoteExpr :: UntypedSpliceFlavour -> Name -> SrcSpan -> FastString
379 -> LHsExpr GhcRn
380 -- Return the expression (quoter "...quote...")
381 -- which is what we must run in a quasi-quote
382 mkQuasiQuoteExpr flavour quoter q_span' quote
383 = L q_span $ HsApp noComments (L q_span
384 $ HsApp noComments (L q_span
385 (HsVar noExtField (L (la2na q_span) quote_selector)))
386 quoterExpr)
387 quoteExpr
388 where
389 q_span = noAnnSrcSpan q_span'
390 quoterExpr = L q_span $! HsVar noExtField $! (L (la2na q_span) quoter)
391 quoteExpr = L q_span $! HsLit noComments $! HsString NoSourceText quote
392 quote_selector = case flavour of
393 UntypedExpSplice -> quoteExpName
394 UntypedPatSplice -> quotePatName
395 UntypedTypeSplice -> quoteTypeName
396 UntypedDeclSplice -> quoteDecName
397
398 ---------------------
399 rnSplice :: HsSplice GhcPs -> RnM (HsSplice GhcRn, FreeVars)
400 -- Not exported...used for all
401 rnSplice (HsTypedSplice x hasParen splice_name expr)
402 = do { loc <- getSrcSpanM
403 ; n' <- newLocalBndrRn (L (noAnnSrcSpan loc) splice_name)
404 ; (expr', fvs) <- rnLExpr expr
405 ; return (HsTypedSplice x hasParen n' expr', fvs) }
406
407 rnSplice (HsUntypedSplice x hasParen splice_name expr)
408 = do { loc <- getSrcSpanM
409 ; n' <- newLocalBndrRn (L (noAnnSrcSpan loc) splice_name)
410 ; (expr', fvs) <- rnLExpr expr
411 ; return (HsUntypedSplice x hasParen n' expr', fvs) }
412
413 rnSplice (HsQuasiQuote x splice_name quoter q_loc quote)
414 = do { loc <- getSrcSpanM
415 ; splice_name' <- newLocalBndrRn (L (noAnnSrcSpan loc) splice_name)
416
417 -- Rename the quoter; akin to the HsVar case of rnExpr
418 ; quoter' <- lookupOccRn quoter
419 ; this_mod <- getModule
420 ; when (nameIsLocalOrFrom this_mod quoter') $
421 checkThLocalName quoter'
422
423 ; return (HsQuasiQuote x splice_name' quoter' q_loc quote
424 , unitFV quoter') }
425
426 rnSplice splice@(HsSpliced {}) = pprPanic "rnSplice" (ppr splice)
427
428 ---------------------
429 rnSpliceExpr :: HsSplice GhcPs -> RnM (HsExpr GhcRn, FreeVars)
430 rnSpliceExpr splice
431 = rnSpliceGen run_expr_splice pend_expr_splice splice
432 where
433 pend_expr_splice :: HsSplice GhcRn -> (PendingRnSplice, HsExpr GhcRn)
434 pend_expr_splice rn_splice
435 = (makePending UntypedExpSplice rn_splice, HsSpliceE noAnn rn_splice)
436
437 run_expr_splice :: HsSplice GhcRn -> RnM (HsExpr GhcRn, FreeVars)
438 run_expr_splice rn_splice
439 | isTypedSplice rn_splice -- Run it later, in the type checker
440 = do { -- Ugh! See Note [Splices] above
441 traceRn "rnSpliceExpr: typed expression splice" empty
442 ; lcl_rdr <- getLocalRdrEnv
443 ; gbl_rdr <- getGlobalRdrEnv
444 ; let gbl_names = mkNameSet [greMangledName gre | gre <- globalRdrEnvElts gbl_rdr
445 , isLocalGRE gre]
446 lcl_names = mkNameSet (localRdrEnvElts lcl_rdr)
447
448 ; return (HsSpliceE noAnn rn_splice, lcl_names `plusFV` gbl_names) }
449
450 | otherwise -- Run it here, see Note [Running splices in the Renamer]
451 = do { traceRn "rnSpliceExpr: untyped expression splice" empty
452 ; (rn_expr, mod_finalizers) <-
453 runRnSplice UntypedExpSplice runMetaE ppr rn_splice
454 ; (lexpr3, fvs) <- checkNoErrs (rnLExpr rn_expr)
455 -- See Note [Delaying modFinalizers in untyped splices].
456 ; let e = HsSpliceE noAnn
457 . HsSpliced noExtField (ThModFinalizers mod_finalizers)
458 . HsSplicedExpr
459 <$> lexpr3
460 ; return (gHsPar e, fvs)
461 }
462
463 {- Note [Running splices in the Renamer]
464 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
465
466 Splices used to be run in the typechecker, which led to (#4364). Since the
467 renamer must decide which expressions depend on which others, and it cannot
468 reliably do this for arbitrary splices, we used to conservatively say that
469 splices depend on all other expressions in scope. Unfortunately, this led to
470 the problem of cyclic type declarations seen in (#4364). Instead, by
471 running splices in the renamer, we side-step the problem of determining
472 dependencies: by the time the dependency analysis happens, any splices have
473 already been run, and expression dependencies can be determined as usual.
474
475 However, see (#9813), for an example where we would like to run splices
476 *after* performing dependency analysis (that is, after renaming). It would be
477 desirable to typecheck "non-splicy" expressions (those expressions that do not
478 contain splices directly or via dependence on an expression that does) before
479 "splicy" expressions, such that types/expressions within the same declaration
480 group would be available to `reify` calls, for example consider the following:
481
482 > module M where
483 > data D = C
484 > f = 1
485 > g = $(mapM reify ['f, 'D, ''C] ...)
486
487 Compilation of this example fails since D/C/f are not in the type environment
488 and thus cannot be reified as they have not been typechecked by the time the
489 splice is renamed and thus run.
490
491 These requirements are at odds: we do not want to run splices in the renamer as
492 we wish to first determine dependencies and typecheck certain expressions,
493 making them available to reify, but cannot accurately determine dependencies
494 without running splices in the renamer!
495
496 Indeed, the conclusion of (#9813) was that it is not worth the complexity
497 to try and
498 a) implement and maintain the code for renaming/typechecking non-splicy
499 expressions before splicy expressions,
500 b) explain to TH users which expressions are/not available to reify at any
501 given point.
502
503 -}
504
505 {- Note [Rebindable syntax and Template Haskell]
506 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
507 When processing Template Haskell quotes with Rebindable Syntax (RS) enabled,
508 there are two possibilities: apply the RS rules to the quotes or don't.
509
510 One might expect that with {-# LANGUAGE RebindableSyntax #-} at the top of a
511 module, any 'if' expression would end up being turned into a call to whatever
512 'ifThenElse' function is in scope, regardless of whether the said if expression
513 appears in "normal" Haskell code or in a TH quote. This however comes with its
514 problems. Consider the following code:
515
516 {-# LANGUAGE TemplateHaskell, RebindableSyntax #-}
517
518 module X where
519
520 import Prelude ( Monad(..), Bool(..), print, ($) )
521 import Language.Haskell.TH.Syntax
522
523 $( do stuff <- [| if True then 10 else 15 |]
524 runIO $ print stuff
525 return [] )
526
527 If we apply the RS rules, then GHC would complain about not having suitable
528 fromInteger/ifThenElse functions in scope. But this quote is just a bit of
529 Haskell syntax that has yet to be used, or, to put it differently, placed
530 (spliced) in some context where the said functions might be available. More
531 generally, untyped TH quotes are meant to work with yet-unbound identifiers.
532 This tends to show that untyped TH and Rebindable Syntax overall don't play
533 well together. Users still have the option to splice "normal" if expressions
534 into modules where RS is enabled, to turn them into applications of
535 an 'ifThenElse' function of their choice.
536
537 Typed TH (TTH) quotes, on the other hand, come with different constraints. They
538 don't quite have this "delayed" nature: we typecheck them while processing
539 them, and TTH users expect RS to Just Work in their quotes, exactly like it does
540 outside of the quotes. There, we do not have to accept unbound identifiers and
541 we can apply the RS rules both in the typechecking and desugaring of the quotes
542 without triggering surprising/bad behaviour for users. For instance, the
543 following code is expected to be rejected (because of the lack of suitable
544 'fromInteger'/'ifThenElse' functions in scope):
545
546 {-# LANGUAGE TemplateHaskell, RebindableSyntax #-}
547
548 module X where
549
550 import Prelude ( Monad(..), Bool(..), print, ($) )
551 import Language.Haskell.TH.Syntax
552
553 $$( do stuff <- [|| if True then 10 else 15 ||]
554 runIO $ print stuff
555 return [] )
556
557 The conclusion is that even if RS is enabled for a given module, GHC disables it
558 when processing untyped TH quotes from that module, to avoid the aforementioned
559 problems, but keeps it on while processing typed TH quotes.
560
561 This note and approach originated in #18102.
562
563 -}
564
565 {- Note [Delaying modFinalizers in untyped splices]
566 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
567
568 When splices run in the renamer, 'reify' does not have access to the local
569 type environment (#11832, [1]).
570
571 For instance, in
572
573 > let x = e in $(reify (mkName "x") >>= runIO . print >> [| return () |])
574
575 'reify' cannot find @x@, because the local type environment is not yet
576 populated. To address this, we allow 'reify' execution to be deferred with
577 'addModFinalizer'.
578
579 > let x = e in $(do addModFinalizer (reify (mkName "x") >>= runIO . print)
580 [| return () |]
581 )
582
583 The finalizer is run with the local type environment when type checking is
584 complete.
585
586 Since the local type environment is not available in the renamer, we annotate
587 the tree at the splice point [2] with @HsSpliceE (HsSpliced finalizers e)@ where
588 @e@ is the result of splicing and @finalizers@ are the finalizers that have been
589 collected during evaluation of the splice [3]. In our example,
590
591 > HsLet
592 > (x = e)
593 > (HsSpliceE $ HsSpliced [reify (mkName "x") >>= runIO . print]
594 > (HsSplicedExpr $ return ())
595 > )
596
597 When the typechecker finds the annotation, it inserts the finalizers in the
598 global environment and exposes the current local environment to them [4, 5, 6].
599
600 > addModFinalizersWithLclEnv [reify (mkName "x") >>= runIO . print]
601
602 References:
603
604 [1] https://gitlab.haskell.org/ghc/ghc/wikis/template-haskell/reify
605 [2] 'rnSpliceExpr'
606 [3] 'GHC.Tc.Gen.Splice.qAddModFinalizer'
607 [4] 'GHC.Tc.Gen.Expr.tcExpr' ('HsSpliceE' ('HsSpliced' ...))
608 [5] 'GHC.Tc.Gen.HsType.tc_hs_type' ('HsSpliceTy' ('HsSpliced' ...))
609 [6] 'GHC.Tc.Gen.Pat.tc_pat' ('SplicePat' ('HsSpliced' ...))
610
611 -}
612
613 ----------------------
614 rnSpliceType :: HsSplice GhcPs -> RnM (HsType GhcRn, FreeVars)
615 rnSpliceType splice
616 = rnSpliceGen run_type_splice pend_type_splice splice
617 where
618 pend_type_splice rn_splice
619 = ( makePending UntypedTypeSplice rn_splice
620 , HsSpliceTy noExtField rn_splice)
621
622 run_type_splice rn_splice
623 = do { traceRn "rnSpliceType: untyped type splice" empty
624 ; (hs_ty2, mod_finalizers) <-
625 runRnSplice UntypedTypeSplice runMetaT ppr rn_splice
626 ; (hs_ty3, fvs) <- do { let doc = SpliceTypeCtx hs_ty2
627 ; checkNoErrs $ rnLHsType doc hs_ty2 }
628 -- checkNoErrs: see Note [Renamer errors]
629 -- See Note [Delaying modFinalizers in untyped splices].
630 ; return ( HsParTy noAnn
631 $ HsSpliceTy noExtField
632 . HsSpliced noExtField (ThModFinalizers mod_finalizers)
633 . HsSplicedTy <$>
634 hs_ty3
635 , fvs
636 ) }
637 -- Wrap the result of the splice in parens so that we don't
638 -- lose the outermost location set by runQuasiQuote (#7918)
639
640 {- Note [Partial Type Splices]
641 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
642 Partial Type Signatures are partially supported in TH type splices: only
643 anonymous wild cards are allowed.
644
645 -- ToDo: SLPJ says: I don't understand all this
646
647 Normally, named wild cards are collected before renaming a (partial) type
648 signature. However, TH type splices are run during renaming, i.e. after the
649 initial traversal, leading to out of scope errors for named wild cards. We
650 can't just extend the initial traversal to collect the named wild cards in TH
651 type splices, as we'd need to expand them, which is supposed to happen only
652 once, during renaming.
653
654 Similarly, the extra-constraints wild card is handled right before renaming
655 too, and is therefore also not supported in a TH type splice. Another reason
656 to forbid extra-constraints wild cards in TH type splices is that a single
657 signature can contain many TH type splices, whereas it mustn't contain more
658 than one extra-constraints wild card. Enforcing would this be hard the way
659 things are currently organised.
660
661 Anonymous wild cards pose no problem, because they start out without names and
662 are given names during renaming. These names are collected right after
663 renaming. The names generated for anonymous wild cards in TH type splices will
664 thus be collected as well.
665
666 For more details about renaming wild cards, see GHC.Rename.HsType.rnHsSigWcType
667
668 Note that partial type signatures are fully supported in TH declaration
669 splices, e.g.:
670
671 [d| foo :: _ => _
672 foo x y = x == y |]
673
674 This is because in this case, the partial type signature can be treated as a
675 whole signature, instead of as an arbitrary type.
676
677 -}
678
679
680 ----------------------
681 -- | Rename a splice pattern. See Note [rnSplicePat]
682 rnSplicePat :: HsSplice GhcPs -> RnM ( Either (Pat GhcPs) (Pat GhcRn)
683 , FreeVars)
684 rnSplicePat splice
685 = rnSpliceGen run_pat_splice pend_pat_splice splice
686 where
687 pend_pat_splice :: HsSplice GhcRn ->
688 (PendingRnSplice, Either b (Pat GhcRn))
689 pend_pat_splice rn_splice
690 = (makePending UntypedPatSplice rn_splice
691 , Right (SplicePat noExtField rn_splice))
692
693 run_pat_splice :: HsSplice GhcRn ->
694 RnM (Either (Pat GhcPs) (Pat GhcRn), FreeVars)
695 run_pat_splice rn_splice
696 = do { traceRn "rnSplicePat: untyped pattern splice" empty
697 ; (pat, mod_finalizers) <-
698 runRnSplice UntypedPatSplice runMetaP ppr rn_splice
699 -- See Note [Delaying modFinalizers in untyped splices].
700 ; let p = SplicePat noExtField
701 . HsSpliced noExtField (ThModFinalizers mod_finalizers)
702 . HsSplicedPat
703 <$> pat
704 ; return (Left $ gParPat p, emptyFVs) }
705 -- Wrap the result of the quasi-quoter in parens so that we don't
706 -- lose the outermost location set by runQuasiQuote (#7918)
707
708 ----------------------
709 rnSpliceDecl :: SpliceDecl GhcPs -> RnM (SpliceDecl GhcRn, FreeVars)
710 rnSpliceDecl (SpliceDecl _ (L loc splice) flg)
711 = rnSpliceGen run_decl_splice pend_decl_splice splice
712 where
713 pend_decl_splice rn_splice
714 = ( makePending UntypedDeclSplice rn_splice
715 , SpliceDecl noExtField (L loc rn_splice) flg)
716
717 run_decl_splice rn_splice = pprPanic "rnSpliceDecl" (ppr rn_splice)
718
719 rnTopSpliceDecls :: HsSplice GhcPs -> RnM ([LHsDecl GhcPs], FreeVars)
720 -- Declaration splice at the very top level of the module
721 rnTopSpliceDecls splice
722 = do { checkTopSpliceAllowed splice
723 ; (rn_splice, fvs) <- checkNoErrs $
724 setStage (Splice Untyped) $
725 rnSplice splice
726 -- As always, be sure to checkNoErrs above lest we end up with
727 -- holes making it to typechecking, hence #12584.
728 --
729 -- Note that we cannot call checkNoErrs for the whole duration
730 -- of rnTopSpliceDecls. The reason is that checkNoErrs changes
731 -- the local environment to temporarily contain a new
732 -- reference to store errors, and add_mod_finalizers would
733 -- cause this reference to be stored after checkNoErrs finishes.
734 -- This is checked by test TH_finalizer.
735 ; traceRn "rnTopSpliceDecls: untyped declaration splice" empty
736 ; (decls, mod_finalizers) <- checkNoErrs $
737 runRnSplice UntypedDeclSplice runMetaD ppr_decls rn_splice
738 ; add_mod_finalizers_now mod_finalizers
739 ; return (decls,fvs) }
740 where
741 ppr_decls :: [LHsDecl GhcPs] -> SDoc
742 ppr_decls ds = vcat (map ppr ds)
743
744 -- Adds finalizers to the global environment instead of delaying them
745 -- to the type checker.
746 --
747 -- Declaration splices do not have an interesting local environment so
748 -- there is no point in delaying them.
749 --
750 -- See Note [Delaying modFinalizers in untyped splices].
751 add_mod_finalizers_now :: [ForeignRef (TH.Q ())] -> TcRn ()
752 add_mod_finalizers_now [] = return ()
753 add_mod_finalizers_now mod_finalizers = do
754 th_modfinalizers_var <- fmap tcg_th_modfinalizers getGblEnv
755 env <- getLclEnv
756 updTcRef th_modfinalizers_var $ \fins ->
757 (env, ThModFinalizers mod_finalizers) : fins
758
759
760 {-
761 Note [rnSplicePat]
762 ~~~~~~~~~~~~~~~~~~
763 Renaming a pattern splice is a bit tricky, because we need the variables
764 bound in the pattern to be in scope in the RHS of the pattern. This scope
765 management is effectively done by using continuation-passing style in
766 GHC.Rename.Pat, through the CpsRn monad. We don't wish to be in that monad here
767 (it would create import cycles and generally conflict with renaming other
768 splices), so we really want to return a (Pat RdrName) -- the result of
769 running the splice -- which can then be further renamed in GHC.Rename.Pat, in
770 the CpsRn monad.
771
772 The problem is that if we're renaming a splice within a bracket, we
773 *don't* want to run the splice now. We really do just want to rename
774 it to an HsSplice Name. Of course, then we can't know what variables
775 are bound within the splice. So we accept any unbound variables and
776 rename them again when the bracket is spliced in. If a variable is brought
777 into scope by a pattern splice all is fine. If it is not then an error is
778 reported.
779
780 In any case, when we're done in rnSplicePat, we'll either have a
781 Pat RdrName (the result of running a top-level splice) or a Pat Name
782 (the renamed nested splice). Thus, the awkward return type of
783 rnSplicePat.
784 -}
785
786 spliceCtxt :: HsSplice GhcPs -> SDoc
787 spliceCtxt splice
788 = hang (text "In the" <+> what) 2 (ppr splice)
789 where
790 what = case splice of
791 HsUntypedSplice {} -> text "untyped splice:"
792 HsTypedSplice {} -> text "typed splice:"
793 HsQuasiQuote {} -> text "quasi-quotation:"
794 HsSpliced {} -> text "spliced expression:"
795
796 -- | The splice data to be logged
797 data SpliceInfo
798 = SpliceInfo
799 { spliceDescription :: String
800 , spliceSource :: Maybe (LHsExpr GhcRn) -- Nothing <=> top-level decls
801 -- added by addTopDecls
802 , spliceIsDecl :: Bool -- True <=> put the generate code in a file
803 -- when -dth-dec-file is on
804 , spliceGenerated :: SDoc
805 }
806 -- Note that 'spliceSource' is *renamed* but not *typechecked*
807 -- Reason (a) less typechecking crap
808 -- (b) data constructors after type checking have been
809 -- changed to their *wrappers*, and that makes them
810 -- print always fully qualified
811
812 -- | outputs splice information for 2 flags which have different output formats:
813 -- `-ddump-splices` and `-dth-dec-file`
814 traceSplice :: SpliceInfo -> TcM ()
815 traceSplice (SpliceInfo { spliceDescription = sd, spliceSource = mb_src
816 , spliceGenerated = gen, spliceIsDecl = is_decl })
817 = do loc <- case mb_src of
818 Nothing -> getSrcSpanM
819 Just (L loc _) -> return (locA loc)
820 traceOptTcRn Opt_D_dump_splices (spliceDebugDoc loc)
821
822 when is_decl $ do -- Raw material for -dth-dec-file
823 logger <- getLogger
824 liftIO $ putDumpFileMaybe logger Opt_D_th_dec_file "" FormatHaskell (spliceCodeDoc loc)
825 where
826 -- `-ddump-splices`
827 spliceDebugDoc :: SrcSpan -> SDoc
828 spliceDebugDoc loc
829 = let code = case mb_src of
830 Nothing -> ending
831 Just e -> nest 2 (ppr (stripParensLHsExpr e)) : ending
832 ending = [ text "======>", nest 2 gen ]
833 in hang (ppr loc <> colon <+> text "Splicing" <+> text sd)
834 2 (sep code)
835
836 -- `-dth-dec-file`
837 spliceCodeDoc :: SrcSpan -> SDoc
838 spliceCodeDoc loc
839 = vcat [ text "--" <+> ppr loc <> colon <+> text "Splicing" <+> text sd
840 , gen ]
841
842 illegalTypedSplice :: TcRnMessage
843 illegalTypedSplice = TcRnUnknownMessage $ mkPlainError noHints $
844 text "Typed splices may not appear in untyped brackets"
845
846 illegalUntypedSplice :: TcRnMessage
847 illegalUntypedSplice = TcRnUnknownMessage $ mkPlainError noHints $
848 text "Untyped splices may not appear in typed brackets"
849
850 checkThLocalName :: Name -> RnM ()
851 checkThLocalName name
852 | isUnboundName name -- Do not report two errors for
853 = return () -- $(not_in_scope args)
854
855 | otherwise
856 = do { traceRn "checkThLocalName" (ppr name)
857 ; mb_local_use <- getStageAndBindLevel name
858 ; case mb_local_use of {
859 Nothing -> return () ; -- Not a locally-bound thing
860 Just (top_lvl, bind_lvl, use_stage) ->
861 do { let use_lvl = thLevel use_stage
862 ; checkWellStaged (quotes (ppr name)) bind_lvl use_lvl
863 ; traceRn "checkThLocalName" (ppr name <+> ppr bind_lvl
864 <+> ppr use_stage
865 <+> ppr use_lvl)
866 ; checkCrossStageLifting top_lvl bind_lvl use_stage use_lvl name } } }
867
868 --------------------------------------
869 checkCrossStageLifting :: TopLevelFlag -> ThLevel -> ThStage -> ThLevel
870 -> Name -> TcM ()
871 -- We are inside brackets, and (use_lvl > bind_lvl)
872 -- Now we must check whether there's a cross-stage lift to do
873 -- Examples \x -> [| x |]
874 -- [| map |]
875 --
876 -- This code is similar to checkCrossStageLifting in GHC.Tc.Gen.Expr, but
877 -- this is only run on *untyped* brackets.
878
879 checkCrossStageLifting top_lvl bind_lvl use_stage use_lvl name
880 | Brack _ (RnPendingUntyped ps_var) <- use_stage -- Only for untyped brackets
881 , use_lvl > bind_lvl -- Cross-stage condition
882 = check_cross_stage_lifting top_lvl name ps_var
883 | otherwise
884 = return ()
885
886 check_cross_stage_lifting :: TopLevelFlag -> Name -> TcRef [PendingRnSplice] -> TcM ()
887 check_cross_stage_lifting top_lvl name ps_var
888 | isTopLevel top_lvl
889 -- Top-level identifiers in this module,
890 -- (which have External Names)
891 -- are just like the imported case:
892 -- no need for the 'lifting' treatment
893 -- E.g. this is fine:
894 -- f x = x
895 -- g y = [| f 3 |]
896 = when (isExternalName name) (keepAlive name)
897 -- See Note [Keeping things alive for Template Haskell]
898
899 | otherwise
900 = -- Nested identifiers, such as 'x' in
901 -- E.g. \x -> [| h x |]
902 -- We must behave as if the reference to x was
903 -- h $(lift x)
904 -- We use 'x' itself as the SplicePointName, used by
905 -- the desugarer to stitch it all back together.
906 -- If 'x' occurs many times we may get many identical
907 -- bindings of the same SplicePointName, but that doesn't
908 -- matter, although it's a mite untidy.
909 do { traceRn "checkCrossStageLifting" (ppr name)
910
911 -- Construct the (lift x) expression
912 ; let lift_expr = nlHsApp (nlHsVar liftName) (nlHsVar name)
913 pend_splice = PendingRnSplice UntypedExpSplice name lift_expr
914
915 -- Warning for implicit lift (#17804)
916 ; addDetailedDiagnostic (TcRnImplicitLift name)
917
918 -- Update the pending splices
919 ; ps <- readMutVar ps_var
920 ; writeMutVar ps_var (pend_splice : ps) }
921
922 {-
923 Note [Keeping things alive for Template Haskell]
924 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
925 Consider
926 f x = x+1
927 g y = [| f 3 |]
928
929 Here 'f' is referred to from inside the bracket, which turns into data
930 and mentions only f's *name*, not 'f' itself. So we need some other
931 way to keep 'f' alive, lest it get dropped as dead code. That's what
932 keepAlive does. It puts it in the keep-alive set, which subsequently
933 ensures that 'f' stays as a top level binding.
934
935 This must be done by the renamer, not the type checker (as of old),
936 because the type checker doesn't typecheck the body of untyped
937 brackets (#8540).
938
939 A thing can have a bind_lvl of outerLevel, but have an internal name:
940 foo = [d| op = 3
941 bop = op + 1 |]
942 Here the bind_lvl of 'op' is (bogusly) outerLevel, even though it is
943 bound inside a bracket. That is because we don't even record
944 binding levels for top-level things; the binding levels are in the
945 LocalRdrEnv.
946
947 So the occurrence of 'op' in the rhs of 'bop' looks a bit like a
948 cross-stage thing, but it isn't really. And in fact we never need
949 to do anything here for top-level bound things, so all is fine, if
950 a bit hacky.
951
952 For these chaps (which have Internal Names) we don't want to put
953 them in the keep-alive set.
954
955 Note [Quoting names]
956 ~~~~~~~~~~~~~~~~~~~~
957 A quoted name 'n is a bit like a quoted expression [| n |], except that we
958 have no cross-stage lifting (c.f. GHC.Tc.Gen.Expr.thBrackId). So, after incrementing
959 the use-level to account for the brackets, the cases are:
960
961 bind > use Error
962 bind = use+1 OK
963 bind < use
964 Imported things OK
965 Top-level things OK
966 Non-top-level Error
967
968 where 'use' is the binding level of the 'n quote. (So inside the implied
969 bracket the level would be use+1.)
970
971 Examples:
972
973 f 'map -- OK; also for top-level defns of this module
974
975 \x. f 'x -- Not ok (bind = 1, use = 1)
976 -- (whereas \x. f [| x |] might have been ok, by
977 -- cross-stage lifting
978
979 \y. [| \x. $(f 'y) |] -- Not ok (bind =1, use = 1)
980
981 [| \x. $(f 'x) |] -- OK (bind = 2, use = 1)
982 -}