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