20933125ee841a2cc4ead950fa49ba1f7e4c676b
[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 DynFlags
30 import RnTypes ( rnLHsType )
31
32 import Control.Monad ( unless, when )
33
34 import {-# SOURCE #-} RnExpr ( rnLExpr )
35
36 import PrelNames ( isUnboundName )
37 import TcEnv ( checkWellStaged )
38 import THNames ( liftName )
39
40 #ifdef GHCI
41 import FastString
42 import ErrUtils ( dumpIfSet_dyn_printer )
43 import TcEnv ( tcMetaTy )
44 import Hooks
45 import Var ( Id )
46 import THNames ( quoteExpName, quotePatName, quoteDecName, quoteTypeName
47 , decsQTyConName, expQTyConName, patQTyConName, typeQTyConName, )
48 import RnTypes ( collectWildCards )
49
50 import {-# SOURCE #-} TcExpr ( tcMonoExpr )
51 import {-# SOURCE #-} TcSplice ( runMetaD, runMetaE, runMetaP, runMetaT, tcTopSpliceExpr )
52 #endif
53
54 {-
55 ************************************************************************
56 * *
57 Template Haskell brackets
58 * *
59 ************************************************************************
60 -}
61
62 rnBracket :: HsExpr RdrName -> HsBracket RdrName -> RnM (HsExpr Name, FreeVars)
63 rnBracket e br_body
64 = addErrCtxt (quotationCtxtDoc br_body) $
65 do { -- Check that -XTemplateHaskellQuotes is enabled and available
66 thQuotesEnabled <- xoptM Opt_TemplateHaskellQuotes
67 ; unless thQuotesEnabled $
68 failWith ( vcat
69 [ text "Syntax error on" <+> ppr e
70 , text ("Perhaps you intended to use TemplateHaskell"
71 ++ " or TemplateHaskellQuotes") ] )
72
73 -- Check for nested brackets
74 ; cur_stage <- getStage
75 ; case cur_stage of
76 { Splice Typed -> checkTc (isTypedBracket br_body)
77 illegalUntypedBracket
78 ; Splice Untyped -> checkTc (not (isTypedBracket br_body))
79 illegalTypedBracket
80 ; Comp -> return ()
81 ; Brack {} -> failWithTc illegalBracket
82 }
83
84 -- Brackets are desugared to code that mentions the TH package
85 ; recordThUse
86
87 ; case isTypedBracket br_body of
88 True -> do { traceRn (text "Renaming typed TH bracket")
89 ; (body', fvs_e) <-
90 setStage (Brack cur_stage RnPendingTyped) $
91 rn_bracket cur_stage br_body
92 ; return (HsBracket body', fvs_e) }
93
94 False -> do { traceRn (text "Renaming untyped TH bracket")
95 ; ps_var <- newMutVar []
96 ; (body', fvs_e) <-
97 setStage (Brack cur_stage (RnPendingUntyped ps_var)) $
98 rn_bracket cur_stage br_body
99 ; pendings <- readMutVar ps_var
100 ; return (HsRnBracketOut body' pendings, fvs_e) }
101 }
102
103 rn_bracket :: ThStage -> HsBracket RdrName -> RnM (HsBracket Name, FreeVars)
104 rn_bracket outer_stage br@(VarBr flg rdr_name)
105 = do { name <- lookupOccRn rdr_name
106 ; this_mod <- getModule
107
108 ; when (flg && nameIsLocalOrFrom this_mod name) $
109 -- Type variables can be quoted in TH. See #5721.
110 do { mb_bind_lvl <- lookupLocalOccThLvl_maybe name
111 ; case mb_bind_lvl of
112 { Nothing -> return () -- Can happen for data constructors,
113 -- but nothing needs to be done for them
114
115 ; Just (top_lvl, bind_lvl) -- See Note [Quoting names]
116 | isTopLevel top_lvl
117 -> when (isExternalName name) (keepAlive name)
118 | otherwise
119 -> do { traceRn (text "rn_bracket VarBr" <+> ppr name <+> ppr bind_lvl <+> ppr outer_stage)
120 ; checkTc (thLevel outer_stage + 1 == bind_lvl)
121 (quotedNameStageErr br) }
122 }
123 }
124 ; return (VarBr flg name, unitFV name) }
125
126 rn_bracket _ (ExpBr e) = do { (e', fvs) <- rnLExpr e
127 ; return (ExpBr e', fvs) }
128
129 rn_bracket _ (PatBr p) = rnPat ThPatQuote p $ \ p' -> return (PatBr p', emptyFVs)
130
131 rn_bracket _ (TypBr t) = do { (t', fvs) <- rnLHsType TypBrCtx t
132 ; return (TypBr t', fvs) }
133
134 rn_bracket _ (DecBrL decls)
135 = do { group <- groupDecls decls
136 ; gbl_env <- getGblEnv
137 ; let new_gbl_env = gbl_env { tcg_dus = emptyDUs }
138 -- The emptyDUs is so that we just collect uses for this
139 -- group alone in the call to rnSrcDecls below
140 ; (tcg_env, group') <- setGblEnv new_gbl_env $
141 rnSrcDecls group
142
143 -- Discard the tcg_env; it contains only extra info about fixity
144 ; traceRn (text "rn_bracket dec" <+> (ppr (tcg_dus tcg_env) $$
145 ppr (duUses (tcg_dus tcg_env))))
146 ; return (DecBrG group', duUses (tcg_dus tcg_env)) }
147 where
148 groupDecls :: [LHsDecl RdrName] -> RnM (HsGroup RdrName)
149 groupDecls decls
150 = do { (group, mb_splice) <- findSplice decls
151 ; case mb_splice of
152 { Nothing -> return group
153 ; Just (splice, rest) ->
154 do { group' <- groupDecls rest
155 ; let group'' = appendGroups group group'
156 ; return group'' { hs_splcds = noLoc splice : hs_splcds group' }
157 }
158 }}
159
160 rn_bracket _ (DecBrG _) = panic "rn_bracket: unexpected DecBrG"
161
162 rn_bracket _ (TExpBr e) = do { (e', fvs) <- rnLExpr e
163 ; return (TExpBr e', fvs) }
164
165 quotationCtxtDoc :: HsBracket RdrName -> SDoc
166 quotationCtxtDoc br_body
167 = hang (text "In the Template Haskell quotation")
168 2 (ppr br_body)
169
170 illegalBracket :: SDoc
171 illegalBracket =
172 text "Template Haskell brackets cannot be nested" <+>
173 text "(without intervening splices)"
174
175 illegalTypedBracket :: SDoc
176 illegalTypedBracket =
177 text "Typed brackets may only appear in typed splices."
178
179 illegalUntypedBracket :: SDoc
180 illegalUntypedBracket =
181 text "Untyped brackets may only appear in untyped splices."
182
183 quotedNameStageErr :: HsBracket RdrName -> SDoc
184 quotedNameStageErr br
185 = sep [ text "Stage error: the non-top-level quoted name" <+> ppr br
186 , text "must be used at the same stage at which is is bound" ]
187
188 #ifndef GHCI
189 rnTopSpliceDecls :: HsSplice RdrName -> RnM ([LHsDecl RdrName], FreeVars)
190 rnTopSpliceDecls e = failTH e "Template Haskell top splice"
191
192 rnSpliceType :: HsSplice RdrName -> PostTc Name Kind
193 -> RnM (HsType Name, FreeVars)
194 rnSpliceType e _ = failTH e "Template Haskell type splice"
195
196 rnSpliceExpr :: HsSplice RdrName -> RnM (HsExpr Name, FreeVars)
197 rnSpliceExpr e = failTH e "Template Haskell splice"
198
199 rnSplicePat :: HsSplice RdrName -> RnM (Either (Pat RdrName) (Pat Name), FreeVars)
200 rnSplicePat e = failTH e "Template Haskell pattern splice"
201
202 rnSpliceDecl :: SpliceDecl RdrName -> RnM (SpliceDecl Name, FreeVars)
203 rnSpliceDecl e = failTH e "Template Haskell declaration splice"
204 #else
205
206 {-
207 *********************************************************
208 * *
209 Splices
210 * *
211 *********************************************************
212
213 Note [Free variables of typed splices]
214 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
215 Consider renaming this:
216 f = ...
217 h = ...$(thing "f")...
218
219 where the splice is a *typed* splice. The splice can expand into
220 literally anything, so when we do dependency analysis we must assume
221 that it might mention 'f'. So we simply treat all locally-defined
222 names as mentioned by any splice. This is terribly brutal, but I
223 don't see what else to do. For example, it'll mean that every
224 locally-defined thing will appear to be used, so no unused-binding
225 warnings. But if we miss the dependency, then we might typecheck 'h'
226 before 'f', and that will crash the type checker because 'f' isn't in
227 scope.
228
229 Currently, I'm not treating a splice as also mentioning every import,
230 which is a bit inconsistent -- but there are a lot of them. We might
231 thereby get some bogus unused-import warnings, but we won't crash the
232 type checker. Not very satisfactory really.
233
234 Note [Renamer errors]
235 ~~~~~~~~~~~~~~~~~~~~~
236 It's important to wrap renamer calls in checkNoErrs, because the
237 renamer does not fail for out of scope variables etc. Instead it
238 returns a bogus term/type, so that it can report more than one error.
239 We don't want the type checker to see these bogus unbound variables.
240 -}
241
242 rnSpliceGen :: (HsSplice Name -> RnM (a, FreeVars)) -- Outside brackets, run splice
243 -> (HsSplice Name -> (PendingRnSplice, a)) -- Inside brackets, make it pending
244 -> HsSplice RdrName
245 -> RnM (a, FreeVars)
246 rnSpliceGen run_splice pend_splice splice
247 = addErrCtxt (spliceCtxt splice) $ do
248 { stage <- getStage
249 ; case stage of
250 Brack pop_stage RnPendingTyped
251 -> do { checkTc is_typed_splice illegalUntypedSplice
252 ; (splice', fvs) <- setStage pop_stage $
253 rnSplice splice
254 ; let (_pending_splice, result) = pend_splice splice'
255 ; return (result, fvs) }
256
257 Brack pop_stage (RnPendingUntyped ps_var)
258 -> do { checkTc (not is_typed_splice) illegalTypedSplice
259 ; (splice', fvs) <- setStage pop_stage $
260 rnSplice splice
261 ; let (pending_splice, result) = pend_splice splice'
262 ; ps <- readMutVar ps_var
263 ; writeMutVar ps_var (pending_splice : ps)
264 ; return (result, fvs) }
265
266 _ -> do { (splice', fvs1) <- checkNoErrs $
267 setStage (Splice splice_type) $
268 rnSplice splice
269 -- checkNoErrs: don't attempt to run the splice if
270 -- renaming it failed; otherwise we get a cascade of
271 -- errors from e.g. unbound variables
272 ; (result, fvs2) <- run_splice splice'
273 ; return (result, fvs1 `plusFV` fvs2) } }
274 where
275 is_typed_splice = isTypedSplice splice
276 splice_type = if is_typed_splice
277 then Typed
278 else Untyped
279
280 ------------------
281 runRnSplice :: UntypedSpliceFlavour
282 -> (LHsExpr Id -> TcRn res)
283 -> (res -> SDoc) -- How to pretty-print res
284 -- Usually just ppr, but not for [Decl]
285 -> HsSplice Name -- Always untyped
286 -> TcRn res
287 runRnSplice flavour run_meta ppr_res splice
288 = do { splice' <- getHooked runRnSpliceHook return >>= ($ splice)
289
290 ; let the_expr = case splice' of
291 HsUntypedSplice _ e -> e
292 HsQuasiQuote _ q qs str -> mkQuasiQuoteExpr flavour q qs str
293 HsTypedSplice {} -> pprPanic "runRnSplice" (ppr splice)
294
295 -- Typecheck the expression
296 ; meta_exp_ty <- tcMetaTy meta_ty_name
297 ; zonked_q_expr <- tcTopSpliceExpr Untyped $
298 tcMonoExpr the_expr meta_exp_ty
299
300 -- Run the expression
301 ; result <- run_meta zonked_q_expr
302 ; traceSplice (SpliceInfo { spliceDescription = what
303 , spliceIsDecl = is_decl
304 , spliceSource = Just the_expr
305 , spliceGenerated = ppr_res result })
306
307 ; return result }
308
309 where
310 meta_ty_name = case flavour of
311 UntypedExpSplice -> expQTyConName
312 UntypedPatSplice -> patQTyConName
313 UntypedTypeSplice -> typeQTyConName
314 UntypedDeclSplice -> decsQTyConName
315 what = case flavour of
316 UntypedExpSplice -> "expression"
317 UntypedPatSplice -> "pattern"
318 UntypedTypeSplice -> "type"
319 UntypedDeclSplice -> "declarations"
320 is_decl = case flavour of
321 UntypedDeclSplice -> True
322 _ -> False
323
324 ------------------
325 makePending :: UntypedSpliceFlavour
326 -> HsSplice Name
327 -> PendingRnSplice
328 makePending flavour (HsUntypedSplice n e)
329 = PendingRnSplice flavour n e
330 makePending flavour (HsQuasiQuote n quoter q_span quote)
331 = PendingRnSplice flavour n (mkQuasiQuoteExpr flavour quoter q_span quote)
332 makePending _ splice@(HsTypedSplice {})
333 = pprPanic "makePending" (ppr splice)
334
335 ------------------
336 mkQuasiQuoteExpr :: UntypedSpliceFlavour -> Name -> SrcSpan -> FastString -> LHsExpr Name
337 -- Return the expression (quoter "...quote...")
338 -- which is what we must run in a quasi-quote
339 mkQuasiQuoteExpr flavour quoter q_span quote
340 = L q_span $ HsApp (L q_span $
341 HsApp (L q_span (HsVar (L q_span quote_selector)))
342 quoterExpr)
343 quoteExpr
344 where
345 quoterExpr = L q_span $! HsVar $! (L q_span quoter)
346 quoteExpr = L q_span $! HsLit $! HsString "" quote
347 quote_selector = case flavour of
348 UntypedExpSplice -> quoteExpName
349 UntypedPatSplice -> quotePatName
350 UntypedTypeSplice -> quoteTypeName
351 UntypedDeclSplice -> quoteDecName
352
353 ---------------------
354 rnSplice :: HsSplice RdrName -> RnM (HsSplice Name, FreeVars)
355 -- Not exported...used for all
356 rnSplice (HsTypedSplice splice_name expr)
357 = do { checkTH expr "Template Haskell typed splice"
358 ; loc <- getSrcSpanM
359 ; n' <- newLocalBndrRn (L loc splice_name)
360 ; (expr', fvs) <- rnLExpr expr
361 ; return (HsTypedSplice n' expr', fvs) }
362
363 rnSplice (HsUntypedSplice splice_name expr)
364 = do { checkTH expr "Template Haskell untyped splice"
365 ; loc <- getSrcSpanM
366 ; n' <- newLocalBndrRn (L loc splice_name)
367 ; (expr', fvs) <- rnLExpr expr
368 ; return (HsUntypedSplice n' expr', fvs) }
369
370 rnSplice (HsQuasiQuote splice_name quoter q_loc quote)
371 = do { checkTH quoter "Template Haskell quasi-quote"
372 ; loc <- getSrcSpanM
373 ; splice_name' <- newLocalBndrRn (L loc splice_name)
374
375 -- Rename the quoter; akin to the HsVar case of rnExpr
376 ; quoter' <- lookupOccRn quoter
377 ; this_mod <- getModule
378 ; when (nameIsLocalOrFrom this_mod quoter') $
379 checkThLocalName quoter'
380
381 ; return (HsQuasiQuote splice_name' quoter' q_loc quote, unitFV quoter') }
382
383 ---------------------
384 rnSpliceExpr :: HsSplice RdrName -> RnM (HsExpr Name, FreeVars)
385 rnSpliceExpr splice
386 = rnSpliceGen run_expr_splice pend_expr_splice splice
387 where
388 pend_expr_splice :: HsSplice Name -> (PendingRnSplice, HsExpr Name)
389 pend_expr_splice rn_splice
390 = (makePending UntypedExpSplice rn_splice, HsSpliceE rn_splice)
391
392 run_expr_splice :: HsSplice Name -> RnM (HsExpr Name, FreeVars)
393 run_expr_splice rn_splice
394 | isTypedSplice rn_splice -- Run it later, in the type checker
395 = do { -- Ugh! See Note [Splices] above
396 traceRn (text "rnSpliceExpr: typed expression splice")
397 ; lcl_rdr <- getLocalRdrEnv
398 ; gbl_rdr <- getGlobalRdrEnv
399 ; let gbl_names = mkNameSet [gre_name gre | gre <- globalRdrEnvElts gbl_rdr
400 , isLocalGRE gre]
401 lcl_names = mkNameSet (localRdrEnvElts lcl_rdr)
402
403 ; return (HsSpliceE rn_splice, lcl_names `plusFV` gbl_names) }
404
405 | otherwise -- Run it here
406 = do { traceRn (text "rnSpliceExpr: untyped expression splice")
407 ; rn_expr <- runRnSplice UntypedExpSplice runMetaE ppr rn_splice
408 ; (lexpr3, fvs) <- checkNoErrs (rnLExpr rn_expr)
409 ; return (HsPar lexpr3, fvs) }
410
411 ----------------------
412 rnSpliceType :: HsSplice RdrName -> PostTc Name Kind
413 -> RnM (HsType Name, FreeVars)
414 rnSpliceType splice k
415 = rnSpliceGen run_type_splice pend_type_splice splice
416 where
417 pend_type_splice rn_splice
418 = (makePending UntypedTypeSplice rn_splice, HsSpliceTy rn_splice k)
419
420 run_type_splice rn_splice
421 = do { traceRn (text "rnSpliceType: untyped type splice")
422 ; hs_ty2 <- runRnSplice UntypedTypeSplice runMetaT ppr rn_splice
423 ; (hs_ty3, fvs) <- do { let doc = SpliceTypeCtx hs_ty2
424 ; checkValidPartialTypeSplice doc hs_ty2
425 -- See Note [Partial Type Splices]
426 ; checkNoErrs $ rnLHsType doc hs_ty2 }
427 -- checkNoErrs: see Note [Renamer errors]
428 ; return (HsParTy hs_ty3, fvs) }
429 -- Wrap the result of the splice in parens so that we don't
430 -- lose the outermost location set by runQuasiQuote (#7918)
431 {-
432 Note [Partial Type Splices]
433 ~~~~~~~~~~~~~~~~~~~~~~~~~~~
434
435 Partial Type Signatures are partially supported in TH type splices: only
436 anonymous wild cards are allowed.
437
438 Normally, named wild cards are collected before renaming a (partial) type
439 signature. However, TH type splices are run during renaming, i.e. after the
440 initial traversal, leading to out of scope errors for named wild cards. We
441 can't just extend the initial traversal to collect the named wild cards in TH
442 type splices, as we'd need to expand them, which is supposed to happen only
443 once, during renaming.
444
445 Similarly, the extra-constraints wild card is handled right before renaming
446 too, and is therefore also not supported in a TH type splice. Another reason
447 to forbid extra-constraints wild cards in TH type splices is that a single
448 signature can contain many TH type splices, whereas it mustn't contain more
449 than one extra-constraints wild card. Enforcing would this be hard the way
450 things are currently organised.
451
452 Anonymous wild cards pose no problem, because they start out without names and
453 are given names during renaming. These names are collected right after
454 renaming. The names generated for anonymous wild cards in TH type splices will
455 thus be collected as well.
456
457 For more details about renaming wild cards, see rnLHsTypeWithWildCards.
458
459 Note that partial type signatures are fully supported in TH declaration
460 splices, e.g.:
461
462 [d| foo :: _ => _
463 foo x y = x == y |]
464
465 This is because in this case, the partial type signature can be treated as a
466 whole signature, instead of as an arbitray type.
467
468 -}
469
470 -- | Check that the type splice doesn't contain an extra-constraint wild card.
471 -- See Note [Partial Type Splices]. Named wild cards aren't supported in type
472 -- splices either, but they will be caught during renaming, as they won't be
473 -- in scope.
474 --
475 -- Note that without this check, an error would still be reported, but it
476 -- would tell the user an unexpected wild card was encountered. This message
477 -- is confusing, as it doesn't mention the wild card was unexpected because it
478 -- was an extra-constraints wild card. To avoid confusing, this function
479 -- provides a specific error message for this case.
480 checkValidPartialTypeSplice :: HsDocContext -> LHsType RdrName -> RnM ()
481 checkValidPartialTypeSplice doc ty
482 | (L loc _extraWc : _, _) <- collectWildCards ty
483 = failAt loc $ hang (text "Invalid partial type:") 2 (ppr ty) $$
484 text "An extra-constraints wild card is not allowed in a type splice" $$
485 docOfHsDocContext doc
486 | otherwise
487 = return ()
488
489 ----------------------
490 -- | Rename a splice pattern. See Note [rnSplicePat]
491 rnSplicePat :: HsSplice RdrName -> RnM ( Either (Pat RdrName) (Pat Name)
492 , FreeVars)
493 rnSplicePat splice
494 = rnSpliceGen run_pat_splice pend_pat_splice splice
495 where
496 pend_pat_splice rn_splice
497 = (makePending UntypedPatSplice rn_splice, Right (SplicePat rn_splice))
498
499 run_pat_splice rn_splice
500 = do { traceRn (text "rnSplicePat: untyped pattern splice")
501 ; pat <- runRnSplice UntypedPatSplice runMetaP ppr rn_splice
502 ; return (Left (ParPat pat), emptyFVs) }
503 -- Wrap the result of the quasi-quoter in parens so that we don't
504 -- lose the outermost location set by runQuasiQuote (#7918)
505
506 ----------------------
507 rnSpliceDecl :: SpliceDecl RdrName -> RnM (SpliceDecl Name, FreeVars)
508 rnSpliceDecl (SpliceDecl (L loc splice) flg)
509 = rnSpliceGen run_decl_splice pend_decl_splice splice
510 where
511 pend_decl_splice rn_splice
512 = (makePending UntypedDeclSplice rn_splice, SpliceDecl (L loc rn_splice) flg)
513
514 run_decl_splice rn_splice = pprPanic "rnSpliceDecl" (ppr rn_splice)
515
516 rnTopSpliceDecls :: HsSplice RdrName -> RnM ([LHsDecl RdrName], FreeVars)
517 -- Declaration splice at the very top level of the module
518 rnTopSpliceDecls splice
519 = do { (rn_splice, fvs) <- setStage (Splice Untyped) $
520 rnSplice splice
521 ; traceRn (text "rnTopSpliceDecls: untyped declaration splice")
522 ; decls <- runRnSplice UntypedDeclSplice runMetaD ppr_decls rn_splice
523 ; return (decls,fvs) }
524 where
525 ppr_decls :: [LHsDecl RdrName] -> SDoc
526 ppr_decls ds = vcat (map ppr ds)
527
528 {-
529 Note [rnSplicePat]
530 ~~~~~~~~~~~~~~~~~~
531 Renaming a pattern splice is a bit tricky, because we need the variables
532 bound in the pattern to be in scope in the RHS of the pattern. This scope
533 management is effectively done by using continuation-passing style in
534 RnPat, through the CpsRn monad. We don't wish to be in that monad here
535 (it would create import cycles and generally conflict with renaming other
536 splices), so we really want to return a (Pat RdrName) -- the result of
537 running the splice -- which can then be further renamed in RnPat, in
538 the CpsRn monad.
539
540 The problem is that if we're renaming a splice within a bracket, we
541 *don't* want to run the splice now. We really do just want to rename
542 it to an HsSplice Name. Of course, then we can't know what variables
543 are bound within the splice. So we accept any unbound variables and
544 rename them again when the bracket is spliced in. If a variable is brought
545 into scope by a pattern splice all is fine. If it is not then an error is
546 reported.
547
548 In any case, when we're done in rnSplicePat, we'll either have a
549 Pat RdrName (the result of running a top-level splice) or a Pat Name
550 (the renamed nested splice). Thus, the awkward return type of
551 rnSplicePat.
552 -}
553
554 spliceCtxt :: HsSplice RdrName -> SDoc
555 spliceCtxt splice
556 = hang (ptext (sLit "In the") <+> what) 2 (ppr splice)
557 where
558 what = case splice of
559 HsUntypedSplice {} -> ptext (sLit "untyped splice:")
560 HsTypedSplice {} -> ptext (sLit "typed splice:")
561 HsQuasiQuote {} -> ptext (sLit "quasi-quotation:")
562
563 -- | The splice data to be logged
564 data SpliceInfo
565 = SpliceInfo
566 { spliceDescription :: String
567 , spliceSource :: Maybe (LHsExpr Name) -- Nothing <=> top-level decls
568 -- added by addTopDecls
569 , spliceIsDecl :: Bool -- True <=> put the generate code in a file
570 -- when -dth-dec-file is on
571 , spliceGenerated :: SDoc
572 }
573 -- Note that 'spliceSource' is *renamed* but not *typechecked*
574 -- Reason (a) less typechecking crap
575 -- (b) data constructors after type checking have been
576 -- changed to their *wrappers*, and that makes them
577 -- print always fully qualified
578
579 -- | outputs splice information for 2 flags which have different output formats:
580 -- `-ddump-splices` and `-dth-dec-file`
581 traceSplice :: SpliceInfo -> TcM ()
582 traceSplice (SpliceInfo { spliceDescription = sd, spliceSource = mb_src
583 , spliceGenerated = gen, spliceIsDecl = is_decl })
584 = do { loc <- case mb_src of
585 Nothing -> getSrcSpanM
586 Just (L loc _) -> return loc
587 ; traceOptTcRn Opt_D_dump_splices (spliceDebugDoc loc)
588
589 ; when is_decl $ -- Raw material for -dth-dec-file
590 do { dflags <- getDynFlags
591 ; liftIO $ dumpIfSet_dyn_printer alwaysQualify dflags Opt_D_th_dec_file
592 (spliceCodeDoc loc) } }
593 where
594 -- `-ddump-splices`
595 spliceDebugDoc :: SrcSpan -> SDoc
596 spliceDebugDoc loc
597 = let code = case mb_src of
598 Nothing -> ending
599 Just e -> nest 2 (ppr e) : ending
600 ending = [ text "======>", nest 2 gen ]
601 in hang (ppr loc <> colon <+> text "Splicing" <+> text sd)
602 2 (sep code)
603
604 -- `-dth-dec-file`
605 spliceCodeDoc :: SrcSpan -> SDoc
606 spliceCodeDoc loc
607 = vcat [ text "--" <+> ppr loc <> colon <+> text "Splicing" <+> text sd
608 , gen ]
609
610 illegalTypedSplice :: SDoc
611 illegalTypedSplice = ptext (sLit "Typed splices may not appear in untyped brackets")
612
613 illegalUntypedSplice :: SDoc
614 illegalUntypedSplice = ptext (sLit "Untyped splices may not appear in typed brackets")
615
616 -- spliceResultDoc :: OutputableBndr id => LHsExpr id -> SDoc
617 -- spliceResultDoc expr
618 -- = vcat [ hang (ptext (sLit "In the splice:"))
619 -- 2 (char '$' <> pprParendExpr expr)
620 -- , ptext (sLit "To see what the splice expanded to, use -ddump-splices") ]
621 #endif
622
623 checkThLocalName :: Name -> RnM ()
624 checkThLocalName name
625 | isUnboundName name -- Do not report two errors for
626 = return () -- $(not_in_scope args)
627
628 | otherwise
629 = do { traceRn (text "checkThLocalName" <+> ppr name)
630 ; mb_local_use <- getStageAndBindLevel name
631 ; case mb_local_use of {
632 Nothing -> return () ; -- Not a locally-bound thing
633 Just (top_lvl, bind_lvl, use_stage) ->
634 do { let use_lvl = thLevel use_stage
635 ; checkWellStaged (quotes (ppr name)) bind_lvl use_lvl
636 ; traceRn (text "checkThLocalName" <+> ppr name <+> ppr bind_lvl <+> ppr use_stage <+> ppr use_lvl)
637 ; checkCrossStageLifting top_lvl bind_lvl use_stage use_lvl name } } }
638
639 --------------------------------------
640 checkCrossStageLifting :: TopLevelFlag -> ThLevel -> ThStage -> ThLevel
641 -> Name -> TcM ()
642 -- We are inside brackets, and (use_lvl > bind_lvl)
643 -- Now we must check whether there's a cross-stage lift to do
644 -- Examples \x -> [| x |]
645 -- [| map |]
646 --
647 -- This code is similar to checkCrossStageLifting in TcExpr, but
648 -- this is only run on *untyped* brackets.
649
650 checkCrossStageLifting top_lvl bind_lvl use_stage use_lvl name
651 | Brack _ (RnPendingUntyped ps_var) <- use_stage -- Only for untyped brackets
652 , use_lvl > bind_lvl -- Cross-stage condition
653 = check_cross_stage_lifting top_lvl name ps_var
654 | otherwise
655 = return ()
656
657 check_cross_stage_lifting :: TopLevelFlag -> Name -> TcRef [PendingRnSplice] -> TcM ()
658 check_cross_stage_lifting top_lvl name ps_var
659 | isTopLevel top_lvl
660 -- Top-level identifiers in this module,
661 -- (which have External Names)
662 -- are just like the imported case:
663 -- no need for the 'lifting' treatment
664 -- E.g. this is fine:
665 -- f x = x
666 -- g y = [| f 3 |]
667 = when (isExternalName name) (keepAlive name)
668 -- See Note [Keeping things alive for Template Haskell]
669
670 | otherwise
671 = -- Nested identifiers, such as 'x' in
672 -- E.g. \x -> [| h x |]
673 -- We must behave as if the reference to x was
674 -- h $(lift x)
675 -- We use 'x' itself as the SplicePointName, used by
676 -- the desugarer to stitch it all back together.
677 -- If 'x' occurs many times we may get many identical
678 -- bindings of the same SplicePointName, but that doesn't
679 -- matter, although it's a mite untidy.
680 do { traceRn (text "checkCrossStageLifting" <+> ppr name)
681
682 -- Construct the (lift x) expression
683 ; let lift_expr = nlHsApp (nlHsVar liftName) (nlHsVar name)
684 pend_splice = PendingRnSplice UntypedExpSplice name lift_expr
685
686 -- Update the pending splices
687 ; ps <- readMutVar ps_var
688 ; writeMutVar ps_var (pend_splice : ps) }
689
690 {-
691 Note [Keeping things alive for Template Haskell]
692 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
693 Consider
694 f x = x+1
695 g y = [| f 3 |]
696
697 Here 'f' is referred to from inside the bracket, which turns into data
698 and mentions only f's *name*, not 'f' itself. So we need some other
699 way to keep 'f' alive, lest it get dropped as dead code. That's what
700 keepAlive does. It puts it in the keep-alive set, which subsequently
701 ensures that 'f' stays as a top level binding.
702
703 This must be done by the renamer, not the type checker (as of old),
704 because the type checker doesn't typecheck the body of untyped
705 brackets (Trac #8540).
706
707 A thing can have a bind_lvl of outerLevel, but have an internal name:
708 foo = [d| op = 3
709 bop = op + 1 |]
710 Here the bind_lvl of 'op' is (bogusly) outerLevel, even though it is
711 bound inside a bracket. That is because we don't even even record
712 binding levels for top-level things; the binding levels are in the
713 LocalRdrEnv.
714
715 So the occurrence of 'op' in the rhs of 'bop' looks a bit like a
716 cross-stage thing, but it isn't really. And in fact we never need
717 to do anything here for top-level bound things, so all is fine, if
718 a bit hacky.
719
720 For these chaps (which have Internal Names) we don't want to put
721 them in the keep-alive set.
722
723 Note [Quoting names]
724 ~~~~~~~~~~~~~~~~~~~~
725 A quoted name 'n is a bit like a quoted expression [| n |], except that we
726 have no cross-stage lifting (c.f. TcExpr.thBrackId). So, after incrementing
727 the use-level to account for the brackets, the cases are:
728
729 bind > use Error
730 bind = use+1 OK
731 bind < use
732 Imported things OK
733 Top-level things OK
734 Non-top-level Error
735
736 where 'use' is the binding level of the 'n quote. (So inside the implied
737 bracket the level would be use+1.)
738
739 Examples:
740
741 f 'map -- OK; also for top-level defns of this module
742
743 \x. f 'x -- Not ok (bind = 1, use = 1)
744 -- (whereas \x. f [| x |] might have been ok, by
745 -- cross-stage lifting
746
747 \y. [| \x. $(f 'y) |] -- Not ok (bind =1, use = 1)
748
749 [| \x. $(f 'x) |] -- OK (bind = 2, use = 1)
750 -}