RnExpr: Actually fail if patterns found in expression
[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 [Delaying modFinalizers in untyped splices]
446 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
447
448 When splices run in the renamer, 'reify' does not have access to the local
449 type environment (Trac #11832, [1]).
450
451 For instance, in
452
453 > let x = e in $(reify (mkName "x") >>= runIO . print >> [| return () |])
454
455 'reify' cannot find @x@, because the local type environment is not yet
456 populated. To address this, we allow 'reify' execution to be deferred with
457 'addModFinalizer'.
458
459 > let x = e in $(do addModFinalizer (reify (mkName "x") >>= runIO . print)
460 [| return () |]
461 )
462
463 The finalizer is run with the local type environment when type checking is
464 complete.
465
466 Since the local type environment is not available in the renamer, we annotate
467 the tree at the splice point [2] with @HsSpliceE (HsSpliced finalizers e)@ where
468 @e@ is the result of splicing and @finalizers@ are the finalizers that have been
469 collected during evaluation of the splice [3]. In our example,
470
471 > HsLet
472 > (x = e)
473 > (HsSpliceE $ HsSpliced [reify (mkName "x") >>= runIO . print]
474 > (HsSplicedExpr $ return ())
475 > )
476
477 When the typechecker finds the annotation, it inserts the finalizers in the
478 global environment and exposes the current local environment to them [4, 5, 6].
479
480 > addModFinalizersWithLclEnv [reify (mkName "x") >>= runIO . print]
481
482 References:
483
484 [1] https://ghc.haskell.org/trac/ghc/wiki/TemplateHaskell/Reify
485 [2] 'rnSpliceExpr'
486 [3] 'TcSplice.qAddModFinalizer'
487 [4] 'TcExpr.tcExpr' ('HsSpliceE' ('HsSpliced' ...))
488 [5] 'TcHsType.tc_hs_type' ('HsSpliceTy' ('HsSpliced' ...))
489 [6] 'TcPat.tc_pat' ('SplicePat' ('HsSpliced' ...))
490
491 -}
492
493 ----------------------
494 rnSpliceType :: HsSplice RdrName -> PostTc Name Kind
495 -> RnM (HsType Name, FreeVars)
496 rnSpliceType splice k
497 = rnSpliceGen run_type_splice pend_type_splice splice
498 where
499 pend_type_splice rn_splice
500 = (makePending UntypedTypeSplice rn_splice, HsSpliceTy rn_splice k)
501
502 run_type_splice rn_splice
503 = do { traceRn (text "rnSpliceType: untyped type splice")
504 ; (hs_ty2, mod_finalizers) <-
505 runRnSplice UntypedTypeSplice runMetaT ppr rn_splice
506 ; (hs_ty3, fvs) <- do { let doc = SpliceTypeCtx hs_ty2
507 ; checkNoErrs $ rnLHsType doc hs_ty2 }
508 -- checkNoErrs: see Note [Renamer errors]
509 -- See Note [Delaying modFinalizers in untyped splices].
510 ; return ( HsParTy $ flip HsSpliceTy k
511 . HsSpliced (ThModFinalizers mod_finalizers)
512 . HsSplicedTy <$>
513 hs_ty3
514 , fvs
515 ) }
516 -- Wrap the result of the splice in parens so that we don't
517 -- lose the outermost location set by runQuasiQuote (#7918)
518
519 {- Note [Partial Type Splices]
520 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
521 Partial Type Signatures are partially supported in TH type splices: only
522 anonymous wild cards are allowed.
523
524 -- ToDo: SLPJ says: I don't understand all this
525
526 Normally, named wild cards are collected before renaming a (partial) type
527 signature. However, TH type splices are run during renaming, i.e. after the
528 initial traversal, leading to out of scope errors for named wild cards. We
529 can't just extend the initial traversal to collect the named wild cards in TH
530 type splices, as we'd need to expand them, which is supposed to happen only
531 once, during renaming.
532
533 Similarly, the extra-constraints wild card is handled right before renaming
534 too, and is therefore also not supported in a TH type splice. Another reason
535 to forbid extra-constraints wild cards in TH type splices is that a single
536 signature can contain many TH type splices, whereas it mustn't contain more
537 than one extra-constraints wild card. Enforcing would this be hard the way
538 things are currently organised.
539
540 Anonymous wild cards pose no problem, because they start out without names and
541 are given names during renaming. These names are collected right after
542 renaming. The names generated for anonymous wild cards in TH type splices will
543 thus be collected as well.
544
545 For more details about renaming wild cards, see RnTypes.rnHsSigWcType
546
547 Note that partial type signatures are fully supported in TH declaration
548 splices, e.g.:
549
550 [d| foo :: _ => _
551 foo x y = x == y |]
552
553 This is because in this case, the partial type signature can be treated as a
554 whole signature, instead of as an arbitrary type.
555
556 -}
557
558
559 ----------------------
560 -- | Rename a splice pattern. See Note [rnSplicePat]
561 rnSplicePat :: HsSplice RdrName -> RnM ( Either (Pat RdrName) (Pat Name)
562 , FreeVars)
563 rnSplicePat splice
564 = rnSpliceGen run_pat_splice pend_pat_splice splice
565 where
566 pend_pat_splice rn_splice
567 = (makePending UntypedPatSplice rn_splice, Right (SplicePat rn_splice))
568
569 run_pat_splice rn_splice
570 = do { traceRn (text "rnSplicePat: untyped pattern splice")
571 ; (pat, mod_finalizers) <-
572 runRnSplice UntypedPatSplice runMetaP ppr rn_splice
573 -- See Note [Delaying modFinalizers in untyped splices].
574 ; return ( Left $ ParPat $ SplicePat
575 . HsSpliced (ThModFinalizers mod_finalizers)
576 . HsSplicedPat <$>
577 pat
578 , emptyFVs
579 ) }
580 -- Wrap the result of the quasi-quoter in parens so that we don't
581 -- lose the outermost location set by runQuasiQuote (#7918)
582
583 ----------------------
584 rnSpliceDecl :: SpliceDecl RdrName -> RnM (SpliceDecl Name, FreeVars)
585 rnSpliceDecl (SpliceDecl (L loc splice) flg)
586 = rnSpliceGen run_decl_splice pend_decl_splice splice
587 where
588 pend_decl_splice rn_splice
589 = (makePending UntypedDeclSplice rn_splice, SpliceDecl (L loc rn_splice) flg)
590
591 run_decl_splice rn_splice = pprPanic "rnSpliceDecl" (ppr rn_splice)
592
593 rnTopSpliceDecls :: HsSplice RdrName -> RnM ([LHsDecl RdrName], FreeVars)
594 -- Declaration splice at the very top level of the module
595 rnTopSpliceDecls splice
596 = do { (rn_splice, fvs) <- checkNoErrs $
597 setStage (Splice Untyped) $
598 rnSplice splice
599 -- As always, be sure to checkNoErrs above lest we end up with
600 -- holes making it to typechecking, hence #12584.
601 ; traceRn (text "rnTopSpliceDecls: untyped declaration splice")
602 ; (decls, mod_finalizers) <-
603 runRnSplice UntypedDeclSplice runMetaD ppr_decls rn_splice
604 ; add_mod_finalizers_now mod_finalizers
605 ; return (decls,fvs) }
606 where
607 ppr_decls :: [LHsDecl RdrName] -> SDoc
608 ppr_decls ds = vcat (map ppr ds)
609
610 -- Adds finalizers to the global environment instead of delaying them
611 -- to the type checker.
612 --
613 -- Declaration splices do not have an interesting local environment so
614 -- there is no point in delaying them.
615 --
616 -- See Note [Delaying modFinalizers in untyped splices].
617 add_mod_finalizers_now :: [ForeignRef (TH.Q ())] -> TcRn ()
618 add_mod_finalizers_now [] = return ()
619 add_mod_finalizers_now mod_finalizers = do
620 th_modfinalizers_var <- fmap tcg_th_modfinalizers getGblEnv
621 updTcRef th_modfinalizers_var $ \fins ->
622 runRemoteModFinalizers (ThModFinalizers mod_finalizers) : fins
623
624
625 {-
626 Note [rnSplicePat]
627 ~~~~~~~~~~~~~~~~~~
628 Renaming a pattern splice is a bit tricky, because we need the variables
629 bound in the pattern to be in scope in the RHS of the pattern. This scope
630 management is effectively done by using continuation-passing style in
631 RnPat, through the CpsRn monad. We don't wish to be in that monad here
632 (it would create import cycles and generally conflict with renaming other
633 splices), so we really want to return a (Pat RdrName) -- the result of
634 running the splice -- which can then be further renamed in RnPat, in
635 the CpsRn monad.
636
637 The problem is that if we're renaming a splice within a bracket, we
638 *don't* want to run the splice now. We really do just want to rename
639 it to an HsSplice Name. Of course, then we can't know what variables
640 are bound within the splice. So we accept any unbound variables and
641 rename them again when the bracket is spliced in. If a variable is brought
642 into scope by a pattern splice all is fine. If it is not then an error is
643 reported.
644
645 In any case, when we're done in rnSplicePat, we'll either have a
646 Pat RdrName (the result of running a top-level splice) or a Pat Name
647 (the renamed nested splice). Thus, the awkward return type of
648 rnSplicePat.
649 -}
650
651 spliceCtxt :: HsSplice RdrName -> SDoc
652 spliceCtxt splice
653 = hang (text "In the" <+> what) 2 (ppr splice)
654 where
655 what = case splice of
656 HsUntypedSplice {} -> text "untyped splice:"
657 HsTypedSplice {} -> text "typed splice:"
658 HsQuasiQuote {} -> text "quasi-quotation:"
659 HsSpliced {} -> text "spliced expression:"
660
661 -- | The splice data to be logged
662 data SpliceInfo
663 = SpliceInfo
664 { spliceDescription :: String
665 , spliceSource :: Maybe (LHsExpr Name) -- Nothing <=> top-level decls
666 -- added by addTopDecls
667 , spliceIsDecl :: Bool -- True <=> put the generate code in a file
668 -- when -dth-dec-file is on
669 , spliceGenerated :: SDoc
670 }
671 -- Note that 'spliceSource' is *renamed* but not *typechecked*
672 -- Reason (a) less typechecking crap
673 -- (b) data constructors after type checking have been
674 -- changed to their *wrappers*, and that makes them
675 -- print always fully qualified
676
677 -- | outputs splice information for 2 flags which have different output formats:
678 -- `-ddump-splices` and `-dth-dec-file`
679 traceSplice :: SpliceInfo -> TcM ()
680 traceSplice (SpliceInfo { spliceDescription = sd, spliceSource = mb_src
681 , spliceGenerated = gen, spliceIsDecl = is_decl })
682 = do { loc <- case mb_src of
683 Nothing -> getSrcSpanM
684 Just (L loc _) -> return loc
685 ; traceOptTcRn Opt_D_dump_splices (spliceDebugDoc loc)
686
687 ; when is_decl $ -- Raw material for -dth-dec-file
688 do { dflags <- getDynFlags
689 ; liftIO $ dumpIfSet_dyn_printer alwaysQualify dflags Opt_D_th_dec_file
690 (spliceCodeDoc loc) } }
691 where
692 -- `-ddump-splices`
693 spliceDebugDoc :: SrcSpan -> SDoc
694 spliceDebugDoc loc
695 = let code = case mb_src of
696 Nothing -> ending
697 Just e -> nest 2 (ppr e) : ending
698 ending = [ text "======>", nest 2 gen ]
699 in hang (ppr loc <> colon <+> text "Splicing" <+> text sd)
700 2 (sep code)
701
702 -- `-dth-dec-file`
703 spliceCodeDoc :: SrcSpan -> SDoc
704 spliceCodeDoc loc
705 = vcat [ text "--" <+> ppr loc <> colon <+> text "Splicing" <+> text sd
706 , gen ]
707
708 illegalTypedSplice :: SDoc
709 illegalTypedSplice = text "Typed splices may not appear in untyped brackets"
710
711 illegalUntypedSplice :: SDoc
712 illegalUntypedSplice = text "Untyped splices may not appear in typed brackets"
713
714 -- spliceResultDoc :: OutputableBndr id => LHsExpr id -> SDoc
715 -- spliceResultDoc expr
716 -- = vcat [ hang (text "In the splice:")
717 -- 2 (char '$' <> pprParendExpr expr)
718 -- , text "To see what the splice expanded to, use -ddump-splices" ]
719 #endif
720
721 checkThLocalName :: Name -> RnM ()
722 checkThLocalName name
723 | isUnboundName name -- Do not report two errors for
724 = return () -- $(not_in_scope args)
725
726 | otherwise
727 = do { traceRn (text "checkThLocalName" <+> ppr name)
728 ; mb_local_use <- getStageAndBindLevel name
729 ; case mb_local_use of {
730 Nothing -> return () ; -- Not a locally-bound thing
731 Just (top_lvl, bind_lvl, use_stage) ->
732 do { let use_lvl = thLevel use_stage
733 ; checkWellStaged (quotes (ppr name)) bind_lvl use_lvl
734 ; traceRn (text "checkThLocalName" <+> ppr name <+> ppr bind_lvl <+> ppr use_stage <+> ppr use_lvl)
735 ; checkCrossStageLifting top_lvl bind_lvl use_stage use_lvl name } } }
736
737 --------------------------------------
738 checkCrossStageLifting :: TopLevelFlag -> ThLevel -> ThStage -> ThLevel
739 -> Name -> TcM ()
740 -- We are inside brackets, and (use_lvl > bind_lvl)
741 -- Now we must check whether there's a cross-stage lift to do
742 -- Examples \x -> [| x |]
743 -- [| map |]
744 --
745 -- This code is similar to checkCrossStageLifting in TcExpr, but
746 -- this is only run on *untyped* brackets.
747
748 checkCrossStageLifting top_lvl bind_lvl use_stage use_lvl name
749 | Brack _ (RnPendingUntyped ps_var) <- use_stage -- Only for untyped brackets
750 , use_lvl > bind_lvl -- Cross-stage condition
751 = check_cross_stage_lifting top_lvl name ps_var
752 | otherwise
753 = return ()
754
755 check_cross_stage_lifting :: TopLevelFlag -> Name -> TcRef [PendingRnSplice] -> TcM ()
756 check_cross_stage_lifting top_lvl name ps_var
757 | isTopLevel top_lvl
758 -- Top-level identifiers in this module,
759 -- (which have External Names)
760 -- are just like the imported case:
761 -- no need for the 'lifting' treatment
762 -- E.g. this is fine:
763 -- f x = x
764 -- g y = [| f 3 |]
765 = when (isExternalName name) (keepAlive name)
766 -- See Note [Keeping things alive for Template Haskell]
767
768 | otherwise
769 = -- Nested identifiers, such as 'x' in
770 -- E.g. \x -> [| h x |]
771 -- We must behave as if the reference to x was
772 -- h $(lift x)
773 -- We use 'x' itself as the SplicePointName, used by
774 -- the desugarer to stitch it all back together.
775 -- If 'x' occurs many times we may get many identical
776 -- bindings of the same SplicePointName, but that doesn't
777 -- matter, although it's a mite untidy.
778 do { traceRn (text "checkCrossStageLifting" <+> ppr name)
779
780 -- Construct the (lift x) expression
781 ; let lift_expr = nlHsApp (nlHsVar liftName) (nlHsVar name)
782 pend_splice = PendingRnSplice UntypedExpSplice name lift_expr
783
784 -- Update the pending splices
785 ; ps <- readMutVar ps_var
786 ; writeMutVar ps_var (pend_splice : ps) }
787
788 {-
789 Note [Keeping things alive for Template Haskell]
790 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
791 Consider
792 f x = x+1
793 g y = [| f 3 |]
794
795 Here 'f' is referred to from inside the bracket, which turns into data
796 and mentions only f's *name*, not 'f' itself. So we need some other
797 way to keep 'f' alive, lest it get dropped as dead code. That's what
798 keepAlive does. It puts it in the keep-alive set, which subsequently
799 ensures that 'f' stays as a top level binding.
800
801 This must be done by the renamer, not the type checker (as of old),
802 because the type checker doesn't typecheck the body of untyped
803 brackets (Trac #8540).
804
805 A thing can have a bind_lvl of outerLevel, but have an internal name:
806 foo = [d| op = 3
807 bop = op + 1 |]
808 Here the bind_lvl of 'op' is (bogusly) outerLevel, even though it is
809 bound inside a bracket. That is because we don't even even record
810 binding levels for top-level things; the binding levels are in the
811 LocalRdrEnv.
812
813 So the occurrence of 'op' in the rhs of 'bop' looks a bit like a
814 cross-stage thing, but it isn't really. And in fact we never need
815 to do anything here for top-level bound things, so all is fine, if
816 a bit hacky.
817
818 For these chaps (which have Internal Names) we don't want to put
819 them in the keep-alive set.
820
821 Note [Quoting names]
822 ~~~~~~~~~~~~~~~~~~~~
823 A quoted name 'n is a bit like a quoted expression [| n |], except that we
824 have no cross-stage lifting (c.f. TcExpr.thBrackId). So, after incrementing
825 the use-level to account for the brackets, the cases are:
826
827 bind > use Error
828 bind = use+1 OK
829 bind < use
830 Imported things OK
831 Top-level things OK
832 Non-top-level Error
833
834 where 'use' is the binding level of the 'n quote. (So inside the implied
835 bracket the level would be use+1.)
836
837 Examples:
838
839 f 'map -- OK; also for top-level defns of this module
840
841 \x. f 'x -- Not ok (bind = 1, use = 1)
842 -- (whereas \x. f [| x |] might have been ok, by
843 -- cross-stage lifting
844
845 \y. [| \x. $(f 'y) |] -- Not ok (bind =1, use = 1)
846
847 [| \x. $(f 'x) |] -- OK (bind = 2, use = 1)
848 -}