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