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