6adee1c735d3a899789d90b3f91086699d57859b
[ghc.git] / compiler / rename / RnSplice.hs
1 {-# LANGUAGE CPP #-}
2 {-# LANGUAGE TypeFamilies #-}
3 {-# LANGUAGE ViewPatterns #-}
4
5 module RnSplice (
6 rnTopSpliceDecls,
7 rnSpliceType, rnSpliceExpr, rnSplicePat, rnSpliceDecl,
8 rnBracket,
9 checkThLocalName
10 , traceSplice, SpliceInfo(..)
11 ) where
12
13 #include "HsVersions.h"
14
15 import GhcPrelude
16
17 import Name
18 import NameSet
19 import HsSyn
20 import RdrName
21 import TcRnMonad
22
23 import RnEnv
24 import RnUtils ( HsDocContext(..), newLocalBndrRn )
25 import RnUnbound ( isUnboundName )
26 import RnSource ( rnSrcDecls, findSplice )
27 import RnPat ( rnPat )
28 import BasicTypes ( TopLevelFlag, isTopLevel, SourceText(..) )
29 import Outputable
30 import Module
31 import SrcLoc
32 import RnTypes ( rnLHsType )
33
34 import Control.Monad ( unless, when )
35
36 import {-# SOURCE #-} RnExpr ( rnLExpr )
37
38 import TcEnv ( checkWellStaged )
39 import THNames ( liftName )
40
41 import DynFlags
42 import FastString
43 import ErrUtils ( dumpIfSet_dyn_printer )
44 import TcEnv ( tcMetaTy )
45 import Hooks
46 import THNames ( quoteExpName, quotePatName, quoteDecName, quoteTypeName
47 , decsQTyConName, expQTyConName, patQTyConName, typeQTyConName, )
48
49 import {-# SOURCE #-} TcExpr ( tcPolyExpr )
50 import {-# SOURCE #-} TcSplice
51 ( runMetaD
52 , runMetaE
53 , runMetaP
54 , runMetaT
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 = cL q_span $ HsApp noExt (cL q_span
359 $ HsApp noExt (cL q_span (HsVar noExt (cL q_span quote_selector)))
360 quoterExpr)
361 quoteExpr
362 where
363 quoterExpr = cL q_span $! HsVar noExt $! (cL q_span quoter)
364 quoteExpr = cL 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 (cL 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 (cL 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 (cL 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 :: HsSplice GhcRn ->
604 (PendingRnSplice, Either b (Pat GhcRn))
605 pend_pat_splice rn_splice
606 = (makePending UntypedPatSplice rn_splice
607 , Right (SplicePat noExt rn_splice))
608
609 run_pat_splice :: HsSplice GhcRn ->
610 RnM (Either (Pat GhcPs) (Pat GhcRn), FreeVars)
611 run_pat_splice rn_splice
612 = do { traceRn "rnSplicePat: untyped pattern splice" empty
613 ; (pat, mod_finalizers) <-
614 runRnSplice UntypedPatSplice runMetaP ppr rn_splice
615 -- See Note [Delaying modFinalizers in untyped splices].
616 ; return ( Left $ ParPat noExt $ ((SplicePat noExt)
617 . HsSpliced noExt (ThModFinalizers mod_finalizers)
618 . HsSplicedPat) `onHasSrcSpan`
619 pat
620 , emptyFVs
621 ) }
622 -- Wrap the result of the quasi-quoter in parens so that we don't
623 -- lose the outermost location set by runQuasiQuote (#7918)
624
625 ----------------------
626 rnSpliceDecl :: SpliceDecl GhcPs -> RnM (SpliceDecl GhcRn, FreeVars)
627 rnSpliceDecl (SpliceDecl _ (dL->L loc splice) flg)
628 = rnSpliceGen run_decl_splice pend_decl_splice splice
629 where
630 pend_decl_splice rn_splice
631 = ( makePending UntypedDeclSplice rn_splice
632 , SpliceDecl noExt (cL loc rn_splice) flg)
633
634 run_decl_splice rn_splice = pprPanic "rnSpliceDecl" (ppr rn_splice)
635 rnSpliceDecl (XSpliceDecl _) = panic "rnSpliceDecl"
636
637 rnTopSpliceDecls :: HsSplice GhcPs -> RnM ([LHsDecl GhcPs], FreeVars)
638 -- Declaration splice at the very top level of the module
639 rnTopSpliceDecls splice
640 = do { (rn_splice, fvs) <- checkNoErrs $
641 setStage (Splice Untyped) $
642 rnSplice splice
643 -- As always, be sure to checkNoErrs above lest we end up with
644 -- holes making it to typechecking, hence #12584.
645 --
646 -- Note that we cannot call checkNoErrs for the whole duration
647 -- of rnTopSpliceDecls. The reason is that checkNoErrs changes
648 -- the local environment to temporarily contain a new
649 -- reference to store errors, and add_mod_finalizers would
650 -- cause this reference to be stored after checkNoErrs finishes.
651 -- This is checked by test TH_finalizer.
652 ; traceRn "rnTopSpliceDecls: untyped declaration splice" empty
653 ; (decls, mod_finalizers) <- checkNoErrs $
654 runRnSplice UntypedDeclSplice runMetaD ppr_decls rn_splice
655 ; add_mod_finalizers_now mod_finalizers
656 ; return (decls,fvs) }
657 where
658 ppr_decls :: [LHsDecl GhcPs] -> SDoc
659 ppr_decls ds = vcat (map ppr ds)
660
661 -- Adds finalizers to the global environment instead of delaying them
662 -- to the type checker.
663 --
664 -- Declaration splices do not have an interesting local environment so
665 -- there is no point in delaying them.
666 --
667 -- See Note [Delaying modFinalizers in untyped splices].
668 add_mod_finalizers_now :: [ForeignRef (TH.Q ())] -> TcRn ()
669 add_mod_finalizers_now [] = return ()
670 add_mod_finalizers_now mod_finalizers = do
671 th_modfinalizers_var <- fmap tcg_th_modfinalizers getGblEnv
672 env <- getLclEnv
673 updTcRef th_modfinalizers_var $ \fins ->
674 (env, ThModFinalizers mod_finalizers) : fins
675
676
677 {-
678 Note [rnSplicePat]
679 ~~~~~~~~~~~~~~~~~~
680 Renaming a pattern splice is a bit tricky, because we need the variables
681 bound in the pattern to be in scope in the RHS of the pattern. This scope
682 management is effectively done by using continuation-passing style in
683 RnPat, through the CpsRn monad. We don't wish to be in that monad here
684 (it would create import cycles and generally conflict with renaming other
685 splices), so we really want to return a (Pat RdrName) -- the result of
686 running the splice -- which can then be further renamed in RnPat, in
687 the CpsRn monad.
688
689 The problem is that if we're renaming a splice within a bracket, we
690 *don't* want to run the splice now. We really do just want to rename
691 it to an HsSplice Name. Of course, then we can't know what variables
692 are bound within the splice. So we accept any unbound variables and
693 rename them again when the bracket is spliced in. If a variable is brought
694 into scope by a pattern splice all is fine. If it is not then an error is
695 reported.
696
697 In any case, when we're done in rnSplicePat, we'll either have a
698 Pat RdrName (the result of running a top-level splice) or a Pat Name
699 (the renamed nested splice). Thus, the awkward return type of
700 rnSplicePat.
701 -}
702
703 spliceCtxt :: HsSplice GhcPs -> SDoc
704 spliceCtxt splice
705 = hang (text "In the" <+> what) 2 (ppr splice)
706 where
707 what = case splice of
708 HsUntypedSplice {} -> text "untyped splice:"
709 HsTypedSplice {} -> text "typed splice:"
710 HsQuasiQuote {} -> text "quasi-quotation:"
711 HsSpliced {} -> text "spliced expression:"
712 XSplice {} -> text "spliced expression:"
713
714 -- | The splice data to be logged
715 data SpliceInfo
716 = SpliceInfo
717 { spliceDescription :: String
718 , spliceSource :: Maybe (LHsExpr GhcRn) -- Nothing <=> top-level decls
719 -- added by addTopDecls
720 , spliceIsDecl :: Bool -- True <=> put the generate code in a file
721 -- when -dth-dec-file is on
722 , spliceGenerated :: SDoc
723 }
724 -- Note that 'spliceSource' is *renamed* but not *typechecked*
725 -- Reason (a) less typechecking crap
726 -- (b) data constructors after type checking have been
727 -- changed to their *wrappers*, and that makes them
728 -- print always fully qualified
729
730 -- | outputs splice information for 2 flags which have different output formats:
731 -- `-ddump-splices` and `-dth-dec-file`
732 traceSplice :: SpliceInfo -> TcM ()
733 traceSplice (SpliceInfo { spliceDescription = sd, spliceSource = mb_src
734 , spliceGenerated = gen, spliceIsDecl = is_decl })
735 = do { loc <- case mb_src of
736 Nothing -> getSrcSpanM
737 Just (dL->L loc _) -> return loc
738 ; traceOptTcRn Opt_D_dump_splices (spliceDebugDoc loc)
739
740 ; when is_decl $ -- Raw material for -dth-dec-file
741 do { dflags <- getDynFlags
742 ; liftIO $ dumpIfSet_dyn_printer alwaysQualify dflags Opt_D_th_dec_file
743 (spliceCodeDoc loc) } }
744 where
745 -- `-ddump-splices`
746 spliceDebugDoc :: SrcSpan -> SDoc
747 spliceDebugDoc loc
748 = let code = case mb_src of
749 Nothing -> ending
750 Just e -> nest 2 (ppr e) : ending
751 ending = [ text "======>", nest 2 gen ]
752 in hang (ppr loc <> colon <+> text "Splicing" <+> text sd)
753 2 (sep code)
754
755 -- `-dth-dec-file`
756 spliceCodeDoc :: SrcSpan -> SDoc
757 spliceCodeDoc loc
758 = vcat [ text "--" <+> ppr loc <> colon <+> text "Splicing" <+> text sd
759 , gen ]
760
761 illegalTypedSplice :: SDoc
762 illegalTypedSplice = text "Typed splices may not appear in untyped brackets"
763
764 illegalUntypedSplice :: SDoc
765 illegalUntypedSplice = text "Untyped splices may not appear in typed brackets"
766
767 checkThLocalName :: Name -> RnM ()
768 checkThLocalName name
769 | isUnboundName name -- Do not report two errors for
770 = return () -- $(not_in_scope args)
771
772 | otherwise
773 = do { traceRn "checkThLocalName" (ppr name)
774 ; mb_local_use <- getStageAndBindLevel name
775 ; case mb_local_use of {
776 Nothing -> return () ; -- Not a locally-bound thing
777 Just (top_lvl, bind_lvl, use_stage) ->
778 do { let use_lvl = thLevel use_stage
779 ; checkWellStaged (quotes (ppr name)) bind_lvl use_lvl
780 ; traceRn "checkThLocalName" (ppr name <+> ppr bind_lvl
781 <+> ppr use_stage
782 <+> ppr use_lvl)
783 ; checkCrossStageLifting top_lvl bind_lvl use_stage use_lvl name } } }
784
785 --------------------------------------
786 checkCrossStageLifting :: TopLevelFlag -> ThLevel -> ThStage -> ThLevel
787 -> Name -> TcM ()
788 -- We are inside brackets, and (use_lvl > bind_lvl)
789 -- Now we must check whether there's a cross-stage lift to do
790 -- Examples \x -> [| x |]
791 -- [| map |]
792 --
793 -- This code is similar to checkCrossStageLifting in TcExpr, but
794 -- this is only run on *untyped* brackets.
795
796 checkCrossStageLifting top_lvl bind_lvl use_stage use_lvl name
797 | Brack _ (RnPendingUntyped ps_var) <- use_stage -- Only for untyped brackets
798 , use_lvl > bind_lvl -- Cross-stage condition
799 = check_cross_stage_lifting top_lvl name ps_var
800 | otherwise
801 = return ()
802
803 check_cross_stage_lifting :: TopLevelFlag -> Name -> TcRef [PendingRnSplice] -> TcM ()
804 check_cross_stage_lifting top_lvl name ps_var
805 | isTopLevel top_lvl
806 -- Top-level identifiers in this module,
807 -- (which have External Names)
808 -- are just like the imported case:
809 -- no need for the 'lifting' treatment
810 -- E.g. this is fine:
811 -- f x = x
812 -- g y = [| f 3 |]
813 = when (isExternalName name) (keepAlive name)
814 -- See Note [Keeping things alive for Template Haskell]
815
816 | otherwise
817 = -- Nested identifiers, such as 'x' in
818 -- E.g. \x -> [| h x |]
819 -- We must behave as if the reference to x was
820 -- h $(lift x)
821 -- We use 'x' itself as the SplicePointName, used by
822 -- the desugarer to stitch it all back together.
823 -- If 'x' occurs many times we may get many identical
824 -- bindings of the same SplicePointName, but that doesn't
825 -- matter, although it's a mite untidy.
826 do { traceRn "checkCrossStageLifting" (ppr name)
827
828 -- Construct the (lift x) expression
829 ; let lift_expr = nlHsApp (nlHsVar liftName) (nlHsVar name)
830 pend_splice = PendingRnSplice UntypedExpSplice name lift_expr
831
832 -- Update the pending splices
833 ; ps <- readMutVar ps_var
834 ; writeMutVar ps_var (pend_splice : ps) }
835
836 {-
837 Note [Keeping things alive for Template Haskell]
838 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
839 Consider
840 f x = x+1
841 g y = [| f 3 |]
842
843 Here 'f' is referred to from inside the bracket, which turns into data
844 and mentions only f's *name*, not 'f' itself. So we need some other
845 way to keep 'f' alive, lest it get dropped as dead code. That's what
846 keepAlive does. It puts it in the keep-alive set, which subsequently
847 ensures that 'f' stays as a top level binding.
848
849 This must be done by the renamer, not the type checker (as of old),
850 because the type checker doesn't typecheck the body of untyped
851 brackets (Trac #8540).
852
853 A thing can have a bind_lvl of outerLevel, but have an internal name:
854 foo = [d| op = 3
855 bop = op + 1 |]
856 Here the bind_lvl of 'op' is (bogusly) outerLevel, even though it is
857 bound inside a bracket. That is because we don't even even record
858 binding levels for top-level things; the binding levels are in the
859 LocalRdrEnv.
860
861 So the occurrence of 'op' in the rhs of 'bop' looks a bit like a
862 cross-stage thing, but it isn't really. And in fact we never need
863 to do anything here for top-level bound things, so all is fine, if
864 a bit hacky.
865
866 For these chaps (which have Internal Names) we don't want to put
867 them in the keep-alive set.
868
869 Note [Quoting names]
870 ~~~~~~~~~~~~~~~~~~~~
871 A quoted name 'n is a bit like a quoted expression [| n |], except that we
872 have no cross-stage lifting (c.f. TcExpr.thBrackId). So, after incrementing
873 the use-level to account for the brackets, the cases are:
874
875 bind > use Error
876 bind = use+1 OK
877 bind < use
878 Imported things OK
879 Top-level things OK
880 Non-top-level Error
881
882 where 'use' is the binding level of the 'n quote. (So inside the implied
883 bracket the level would be use+1.)
884
885 Examples:
886
887 f 'map -- OK; also for top-level defns of this module
888
889 \x. f 'x -- Not ok (bind = 1, use = 1)
890 -- (whereas \x. f [| x |] might have been ok, by
891 -- cross-stage lifting
892
893 \y. [| \x. $(f 'y) |] -- Not ok (bind =1, use = 1)
894
895 [| \x. $(f 'x) |] -- OK (bind = 2, use = 1)
896 -}