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