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