Expose enabled language extensions to TH
[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 ( tcMonoExpr )
49 import {-# SOURCE #-} TcSplice ( runMetaD, runMetaE, runMetaP, runMetaT, tcTopSpliceExpr )
50 #endif
51
52 import qualified GHC.LanguageExtensions as LangExt
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 LangExt.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 ; checkNoErrs $ rnLHsType doc hs_ty2 }
425 -- checkNoErrs: see Note [Renamer errors]
426 ; return (HsParTy hs_ty3, fvs) }
427 -- Wrap the result of the splice in parens so that we don't
428 -- lose the outermost location set by runQuasiQuote (#7918)
429
430 {- Note [Partial Type Splices]
431 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
432 Partial Type Signatures are partially supported in TH type splices: only
433 anonymous wild cards are allowed.
434
435 -- ToDo: SLPJ says: I don't understand all this
436
437 Normally, named wild cards are collected before renaming a (partial) type
438 signature. However, TH type splices are run during renaming, i.e. after the
439 initial traversal, leading to out of scope errors for named wild cards. We
440 can't just extend the initial traversal to collect the named wild cards in TH
441 type splices, as we'd need to expand them, which is supposed to happen only
442 once, during renaming.
443
444 Similarly, the extra-constraints wild card is handled right before renaming
445 too, and is therefore also not supported in a TH type splice. Another reason
446 to forbid extra-constraints wild cards in TH type splices is that a single
447 signature can contain many TH type splices, whereas it mustn't contain more
448 than one extra-constraints wild card. Enforcing would this be hard the way
449 things are currently organised.
450
451 Anonymous wild cards pose no problem, because they start out without names and
452 are given names during renaming. These names are collected right after
453 renaming. The names generated for anonymous wild cards in TH type splices will
454 thus be collected as well.
455
456 For more details about renaming wild cards, see RnTypes.rnHsSigWcType
457
458 Note that partial type signatures are fully supported in TH declaration
459 splices, e.g.:
460
461 [d| foo :: _ => _
462 foo x y = x == y |]
463
464 This is because in this case, the partial type signature can be treated as a
465 whole signature, instead of as an arbitrary type.
466
467 -}
468
469
470 ----------------------
471 -- | Rename a splice pattern. See Note [rnSplicePat]
472 rnSplicePat :: HsSplice RdrName -> RnM ( Either (Pat RdrName) (Pat Name)
473 , FreeVars)
474 rnSplicePat splice
475 = rnSpliceGen run_pat_splice pend_pat_splice splice
476 where
477 pend_pat_splice rn_splice
478 = (makePending UntypedPatSplice rn_splice, Right (SplicePat rn_splice))
479
480 run_pat_splice rn_splice
481 = do { traceRn (text "rnSplicePat: untyped pattern splice")
482 ; pat <- runRnSplice UntypedPatSplice runMetaP ppr rn_splice
483 ; return (Left (ParPat pat), emptyFVs) }
484 -- Wrap the result of the quasi-quoter in parens so that we don't
485 -- lose the outermost location set by runQuasiQuote (#7918)
486
487 ----------------------
488 rnSpliceDecl :: SpliceDecl RdrName -> RnM (SpliceDecl Name, FreeVars)
489 rnSpliceDecl (SpliceDecl (L loc splice) flg)
490 = rnSpliceGen run_decl_splice pend_decl_splice splice
491 where
492 pend_decl_splice rn_splice
493 = (makePending UntypedDeclSplice rn_splice, SpliceDecl (L loc rn_splice) flg)
494
495 run_decl_splice rn_splice = pprPanic "rnSpliceDecl" (ppr rn_splice)
496
497 rnTopSpliceDecls :: HsSplice RdrName -> RnM ([LHsDecl RdrName], FreeVars)
498 -- Declaration splice at the very top level of the module
499 rnTopSpliceDecls splice
500 = do { (rn_splice, fvs) <- setStage (Splice Untyped) $
501 rnSplice splice
502 ; traceRn (text "rnTopSpliceDecls: untyped declaration splice")
503 ; decls <- runRnSplice UntypedDeclSplice runMetaD ppr_decls rn_splice
504 ; return (decls,fvs) }
505 where
506 ppr_decls :: [LHsDecl RdrName] -> SDoc
507 ppr_decls ds = vcat (map ppr ds)
508
509 {-
510 Note [rnSplicePat]
511 ~~~~~~~~~~~~~~~~~~
512 Renaming a pattern splice is a bit tricky, because we need the variables
513 bound in the pattern to be in scope in the RHS of the pattern. This scope
514 management is effectively done by using continuation-passing style in
515 RnPat, through the CpsRn monad. We don't wish to be in that monad here
516 (it would create import cycles and generally conflict with renaming other
517 splices), so we really want to return a (Pat RdrName) -- the result of
518 running the splice -- which can then be further renamed in RnPat, in
519 the CpsRn monad.
520
521 The problem is that if we're renaming a splice within a bracket, we
522 *don't* want to run the splice now. We really do just want to rename
523 it to an HsSplice Name. Of course, then we can't know what variables
524 are bound within the splice. So we accept any unbound variables and
525 rename them again when the bracket is spliced in. If a variable is brought
526 into scope by a pattern splice all is fine. If it is not then an error is
527 reported.
528
529 In any case, when we're done in rnSplicePat, we'll either have a
530 Pat RdrName (the result of running a top-level splice) or a Pat Name
531 (the renamed nested splice). Thus, the awkward return type of
532 rnSplicePat.
533 -}
534
535 spliceCtxt :: HsSplice RdrName -> SDoc
536 spliceCtxt splice
537 = hang (ptext (sLit "In the") <+> what) 2 (ppr splice)
538 where
539 what = case splice of
540 HsUntypedSplice {} -> ptext (sLit "untyped splice:")
541 HsTypedSplice {} -> ptext (sLit "typed splice:")
542 HsQuasiQuote {} -> ptext (sLit "quasi-quotation:")
543
544 -- | The splice data to be logged
545 data SpliceInfo
546 = SpliceInfo
547 { spliceDescription :: String
548 , spliceSource :: Maybe (LHsExpr Name) -- Nothing <=> top-level decls
549 -- added by addTopDecls
550 , spliceIsDecl :: Bool -- True <=> put the generate code in a file
551 -- when -dth-dec-file is on
552 , spliceGenerated :: SDoc
553 }
554 -- Note that 'spliceSource' is *renamed* but not *typechecked*
555 -- Reason (a) less typechecking crap
556 -- (b) data constructors after type checking have been
557 -- changed to their *wrappers*, and that makes them
558 -- print always fully qualified
559
560 -- | outputs splice information for 2 flags which have different output formats:
561 -- `-ddump-splices` and `-dth-dec-file`
562 traceSplice :: SpliceInfo -> TcM ()
563 traceSplice (SpliceInfo { spliceDescription = sd, spliceSource = mb_src
564 , spliceGenerated = gen, spliceIsDecl = is_decl })
565 = do { loc <- case mb_src of
566 Nothing -> getSrcSpanM
567 Just (L loc _) -> return loc
568 ; traceOptTcRn Opt_D_dump_splices (spliceDebugDoc loc)
569
570 ; when is_decl $ -- Raw material for -dth-dec-file
571 do { dflags <- getDynFlags
572 ; liftIO $ dumpIfSet_dyn_printer alwaysQualify dflags Opt_D_th_dec_file
573 (spliceCodeDoc loc) } }
574 where
575 -- `-ddump-splices`
576 spliceDebugDoc :: SrcSpan -> SDoc
577 spliceDebugDoc loc
578 = let code = case mb_src of
579 Nothing -> ending
580 Just e -> nest 2 (ppr e) : ending
581 ending = [ text "======>", nest 2 gen ]
582 in hang (ppr loc <> colon <+> text "Splicing" <+> text sd)
583 2 (sep code)
584
585 -- `-dth-dec-file`
586 spliceCodeDoc :: SrcSpan -> SDoc
587 spliceCodeDoc loc
588 = vcat [ text "--" <+> ppr loc <> colon <+> text "Splicing" <+> text sd
589 , gen ]
590
591 illegalTypedSplice :: SDoc
592 illegalTypedSplice = ptext (sLit "Typed splices may not appear in untyped brackets")
593
594 illegalUntypedSplice :: SDoc
595 illegalUntypedSplice = ptext (sLit "Untyped splices may not appear in typed brackets")
596
597 -- spliceResultDoc :: OutputableBndr id => LHsExpr id -> SDoc
598 -- spliceResultDoc expr
599 -- = vcat [ hang (ptext (sLit "In the splice:"))
600 -- 2 (char '$' <> pprParendExpr expr)
601 -- , ptext (sLit "To see what the splice expanded to, use -ddump-splices") ]
602 #endif
603
604 checkThLocalName :: Name -> RnM ()
605 checkThLocalName name
606 | isUnboundName name -- Do not report two errors for
607 = return () -- $(not_in_scope args)
608
609 | otherwise
610 = do { traceRn (text "checkThLocalName" <+> ppr name)
611 ; mb_local_use <- getStageAndBindLevel name
612 ; case mb_local_use of {
613 Nothing -> return () ; -- Not a locally-bound thing
614 Just (top_lvl, bind_lvl, use_stage) ->
615 do { let use_lvl = thLevel use_stage
616 ; checkWellStaged (quotes (ppr name)) bind_lvl use_lvl
617 ; traceRn (text "checkThLocalName" <+> ppr name <+> ppr bind_lvl <+> ppr use_stage <+> ppr use_lvl)
618 ; checkCrossStageLifting top_lvl bind_lvl use_stage use_lvl name } } }
619
620 --------------------------------------
621 checkCrossStageLifting :: TopLevelFlag -> ThLevel -> ThStage -> ThLevel
622 -> Name -> TcM ()
623 -- We are inside brackets, and (use_lvl > bind_lvl)
624 -- Now we must check whether there's a cross-stage lift to do
625 -- Examples \x -> [| x |]
626 -- [| map |]
627 --
628 -- This code is similar to checkCrossStageLifting in TcExpr, but
629 -- this is only run on *untyped* brackets.
630
631 checkCrossStageLifting top_lvl bind_lvl use_stage use_lvl name
632 | Brack _ (RnPendingUntyped ps_var) <- use_stage -- Only for untyped brackets
633 , use_lvl > bind_lvl -- Cross-stage condition
634 = check_cross_stage_lifting top_lvl name ps_var
635 | otherwise
636 = return ()
637
638 check_cross_stage_lifting :: TopLevelFlag -> Name -> TcRef [PendingRnSplice] -> TcM ()
639 check_cross_stage_lifting top_lvl name ps_var
640 | isTopLevel top_lvl
641 -- Top-level identifiers in this module,
642 -- (which have External Names)
643 -- are just like the imported case:
644 -- no need for the 'lifting' treatment
645 -- E.g. this is fine:
646 -- f x = x
647 -- g y = [| f 3 |]
648 = when (isExternalName name) (keepAlive name)
649 -- See Note [Keeping things alive for Template Haskell]
650
651 | otherwise
652 = -- Nested identifiers, such as 'x' in
653 -- E.g. \x -> [| h x |]
654 -- We must behave as if the reference to x was
655 -- h $(lift x)
656 -- We use 'x' itself as the SplicePointName, used by
657 -- the desugarer to stitch it all back together.
658 -- If 'x' occurs many times we may get many identical
659 -- bindings of the same SplicePointName, but that doesn't
660 -- matter, although it's a mite untidy.
661 do { traceRn (text "checkCrossStageLifting" <+> ppr name)
662
663 -- Construct the (lift x) expression
664 ; let lift_expr = nlHsApp (nlHsVar liftName) (nlHsVar name)
665 pend_splice = PendingRnSplice UntypedExpSplice name lift_expr
666
667 -- Update the pending splices
668 ; ps <- readMutVar ps_var
669 ; writeMutVar ps_var (pend_splice : ps) }
670
671 {-
672 Note [Keeping things alive for Template Haskell]
673 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
674 Consider
675 f x = x+1
676 g y = [| f 3 |]
677
678 Here 'f' is referred to from inside the bracket, which turns into data
679 and mentions only f's *name*, not 'f' itself. So we need some other
680 way to keep 'f' alive, lest it get dropped as dead code. That's what
681 keepAlive does. It puts it in the keep-alive set, which subsequently
682 ensures that 'f' stays as a top level binding.
683
684 This must be done by the renamer, not the type checker (as of old),
685 because the type checker doesn't typecheck the body of untyped
686 brackets (Trac #8540).
687
688 A thing can have a bind_lvl of outerLevel, but have an internal name:
689 foo = [d| op = 3
690 bop = op + 1 |]
691 Here the bind_lvl of 'op' is (bogusly) outerLevel, even though it is
692 bound inside a bracket. That is because we don't even even record
693 binding levels for top-level things; the binding levels are in the
694 LocalRdrEnv.
695
696 So the occurrence of 'op' in the rhs of 'bop' looks a bit like a
697 cross-stage thing, but it isn't really. And in fact we never need
698 to do anything here for top-level bound things, so all is fine, if
699 a bit hacky.
700
701 For these chaps (which have Internal Names) we don't want to put
702 them in the keep-alive set.
703
704 Note [Quoting names]
705 ~~~~~~~~~~~~~~~~~~~~
706 A quoted name 'n is a bit like a quoted expression [| n |], except that we
707 have no cross-stage lifting (c.f. TcExpr.thBrackId). So, after incrementing
708 the use-level to account for the brackets, the cases are:
709
710 bind > use Error
711 bind = use+1 OK
712 bind < use
713 Imported things OK
714 Top-level things OK
715 Non-top-level Error
716
717 where 'use' is the binding level of the 'n quote. (So inside the implied
718 bracket the level would be use+1.)
719
720 Examples:
721
722 f 'map -- OK; also for top-level defns of this module
723
724 \x. f 'x -- Not ok (bind = 1, use = 1)
725 -- (whereas \x. f [| x |] might have been ok, by
726 -- cross-stage lifting
727
728 \y. [| \x. $(f 'y) |] -- Not ok (bind =1, use = 1)
729
730 [| \x. $(f 'x) |] -- OK (bind = 2, use = 1)
731 -}