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