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