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