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