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