RnSplice.hs 36.7 KB
Newer Older
1
{-# LANGUAGE CPP #-}
2
{-# LANGUAGE TypeFamilies #-}
3
{-# LANGUAGE ViewPatterns #-}
4

5
module RnSplice (
6 7 8
        rnTopSpliceDecls,
        rnSpliceType, rnSpliceExpr, rnSplicePat, rnSpliceDecl,
        rnBracket,
gmainland's avatar
gmainland committed
9
        checkThLocalName
10
        , traceSplice, SpliceInfo(..)
11 12
  ) where

13
#include "HsVersions.h"
14

15 16
import GhcPrelude

17 18 19 20
import Name
import NameSet
import HsSyn
import RdrName
gmainland's avatar
gmainland committed
21 22
import TcRnMonad

23
import RnEnv
24 25
import RnUtils          ( HsDocContext(..), newLocalBndrRn )
import RnUnbound        ( isUnboundName )
26
import RnSource         ( rnSrcDecls, findSplice )
27
import RnPat            ( rnPat )
28
import BasicTypes       ( TopLevelFlag, isTopLevel, SourceText(..) )
29 30 31 32 33 34 35 36 37 38
import Outputable
import Module
import SrcLoc
import RnTypes          ( rnLHsType )

import Control.Monad    ( unless, when )

import {-# SOURCE #-} RnExpr   ( rnLExpr )

import TcEnv            ( checkWellStaged )
39
import THNames          ( liftName )
40

41
import DynFlags
42
import FastString
43 44
import ErrUtils         ( dumpIfSet_dyn_printer )
import TcEnv            ( tcMetaTy )
45
import Hooks
46 47
import THNames          ( quoteExpName, quotePatName, quoteDecName, quoteTypeName
                        , decsQTyConName, expQTyConName, patQTyConName, typeQTyConName, )
48

eir@cis.upenn.edu's avatar
eir@cis.upenn.edu committed
49
import {-# SOURCE #-} TcExpr   ( tcPolyExpr )
50 51 52 53 54 55 56 57
import {-# SOURCE #-} TcSplice
    ( runMetaD
    , runMetaE
    , runMetaP
    , runMetaT
    , tcTopSpliceExpr
    )

58 59
import TcHsSyn

60 61
import GHCi.RemoteTypes ( ForeignRef )
import qualified Language.Haskell.TH as TH (Q)
gmainland's avatar
gmainland committed
62

63 64
import qualified GHC.LanguageExtensions as LangExt

65 66 67 68 69 70 71 72
{-
************************************************************************
*                                                                      *
        Template Haskell brackets
*                                                                      *
************************************************************************
-}

73
rnBracket :: HsExpr GhcPs -> HsBracket GhcPs -> RnM (HsExpr GhcRn, FreeVars)
74 75
rnBracket e br_body
  = addErrCtxt (quotationCtxtDoc br_body) $
76
    do { -- Check that -XTemplateHaskellQuotes is enabled and available
77
         thQuotesEnabled <- xoptM LangExt.TemplateHaskellQuotes
78
       ; unless thQuotesEnabled $
79 80
           failWith ( vcat
                      [ text "Syntax error on" <+> ppr e
81 82
                      , text ("Perhaps you intended to use TemplateHaskell"
                              ++ " or TemplateHaskellQuotes") ] )
83 84 85 86

         -- Check for nested brackets
       ; cur_stage <- getStage
       ; case cur_stage of
87 88 89 90
           { Splice Typed   -> checkTc (isTypedBracket br_body)
                                       illegalUntypedBracket
           ; Splice Untyped -> checkTc (not (isTypedBracket br_body))
                                       illegalTypedBracket
91 92 93 94
           ; RunSplice _    ->
               -- See Note [RunSplice ThLevel] in "TcRnTypes".
               pprPanic "rnBracket: Renaming bracket when running a splice"
                        (ppr e)
95 96
           ; Comp           -> return ()
           ; Brack {}       -> failWithTc illegalBracket
97 98 99 100 101 102
           }

         -- Brackets are desugared to code that mentions the TH package
       ; recordThUse

       ; case isTypedBracket br_body of
103
            True  -> do { traceRn "Renaming typed TH bracket" empty
104 105 106
                        ; (body', fvs_e) <-
                          setStage (Brack cur_stage RnPendingTyped) $
                                   rn_bracket cur_stage br_body
107
                        ; return (HsBracket noExt body', fvs_e) }
108

109
            False -> do { traceRn "Renaming untyped TH bracket" empty
110 111 112 113
                        ; ps_var <- newMutVar []
                        ; (body', fvs_e) <-
                          setStage (Brack cur_stage (RnPendingUntyped ps_var)) $
                                   rn_bracket cur_stage br_body
114
                        ; pendings <- readMutVar ps_var
115
                        ; return (HsRnBracketOut noExt 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 121 122
  = do { name <- lookupOccRn rdr_name
       ; this_mod <- getModule

123 124
       ; when (flg && nameIsLocalOrFrom this_mod name) $
             -- Type variables can be quoted in TH. See #5721.
125 126 127 128 129 130 131 132 133
                 do { mb_bind_lvl <- lookupLocalOccThLvl_maybe name
                    ; case mb_bind_lvl of
                        { Nothing -> return ()      -- Can happen for data constructors,
                                                    -- but nothing needs to be done for them

                        ; Just (top_lvl, bind_lvl)  -- See Note [Quoting names]
                             | isTopLevel top_lvl
                             -> when (isExternalName name) (keepAlive name)
                             | otherwise
134 135 136
                             -> do { traceRn "rn_bracket VarBr"
                                      (ppr name <+> ppr bind_lvl
                                                <+> ppr outer_stage)
137 138 139 140
                                   ; checkTc (thLevel outer_stage + 1 == bind_lvl)
                                             (quotedNameStageErr br) }
                        }
                    }
141
       ; return (VarBr x flg name, unitFV name) }
142

143 144
rn_bracket _ (ExpBr x e) = do { (e', fvs) <- rnLExpr e
                            ; return (ExpBr x e', fvs) }
145

146 147
rn_bracket _ (PatBr x p)
  = rnPat ThPatQuote p $ \ p' -> return (PatBr x p', emptyFVs)
148

149 150
rn_bracket _ (TypBr x t) = do { (t', fvs) <- rnLHsType TypBrCtx t
                              ; return (TypBr x t', fvs) }
151

152
rn_bracket _ (DecBrL x decls)
153 154 155 156 157 158
  = do { group <- groupDecls decls
       ; gbl_env  <- getGblEnv
       ; let new_gbl_env = gbl_env { tcg_dus = emptyDUs }
                          -- The emptyDUs is so that we just collect uses for this
                          -- group alone in the call to rnSrcDecls below
       ; (tcg_env, group') <- setGblEnv new_gbl_env $
Simon Peyton Jones's avatar
Simon Peyton Jones committed
159
                              rnSrcDecls group
160 161

              -- Discard the tcg_env; it contains only extra info about fixity
162 163
        ; traceRn "rn_bracket dec" (ppr (tcg_dus tcg_env) $$
                   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 168 169 170 171 172 173 174 175 176 177
    groupDecls decls
      = do { (group, mb_splice) <- findSplice decls
           ; case mb_splice of
           { Nothing -> return group
           ; Just (splice, rest) ->
               do { group' <- groupDecls rest
                  ; let group'' = appendGroups group group'
                  ; return group'' { hs_splcds = noLoc splice : hs_splcds group' }
                  }
           }}

178
rn_bracket _ (DecBrG {}) = panic "rn_bracket: unexpected DecBrG"
179

180 181 182 183
rn_bracket _ (TExpBr x e) = do { (e', fvs) <- rnLExpr e
                               ; return (TExpBr x e', fvs) }

rn_bracket _ (XBracket {}) = panic "rn_bracket: unexpected XBracket"
184

185
quotationCtxtDoc :: HsBracket GhcPs -> SDoc
186
quotationCtxtDoc br_body
187
  = hang (text "In the Template Haskell quotation")
188 189 190
         2 (ppr br_body)

illegalBracket :: SDoc
191 192 193
illegalBracket =
    text "Template Haskell brackets cannot be nested" <+>
    text "(without intervening splices)"
194

195
illegalTypedBracket :: SDoc
196 197
illegalTypedBracket =
    text "Typed brackets may only appear in typed splices."
198 199

illegalUntypedBracket :: SDoc
200 201
illegalUntypedBracket =
    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
Gabor Greif's avatar
Gabor Greif committed
206
        , text "must be used at the same stage at which it is bound" ]
207

208

Austin Seipp's avatar
Austin Seipp committed
209 210 211
{-
*********************************************************
*                                                      *
212
                Splices
Austin Seipp's avatar
Austin Seipp committed
213 214
*                                                      *
*********************************************************
215

216 217 218
Note [Free variables of typed splices]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Consider renaming this:
219 220 221
        f = ...
        h = ...$(thing "f")...

222 223 224 225 226 227 228 229 230
where the splice is a *typed* splice.  The splice can expand into
literally anything, so when we do dependency analysis we must assume
that it might mention 'f'.  So we simply treat all locally-defined
names as mentioned by any splice.  This is terribly brutal, but I
don't see what else to do.  For example, it'll mean that every
locally-defined thing will appear to be used, so no unused-binding
warnings.  But if we miss the dependency, then we might typecheck 'h'
before 'f', and that will crash the type checker because 'f' isn't in
scope.
231 232 233 234 235 236

Currently, I'm not treating a splice as also mentioning every import,
which is a bit inconsistent -- but there are a lot of them.  We might
thereby get some bogus unused-import warnings, but we won't crash the
type checker.  Not very satisfactory really.

237 238 239 240 241 242
Note [Renamer errors]
~~~~~~~~~~~~~~~~~~~~~
It's important to wrap renamer calls in checkNoErrs, because the
renamer does not fail for out of scope variables etc. Instead it
returns a bogus term/type, so that it can report more than one error.
We don't want the type checker to see these bogus unbound variables.
Austin Seipp's avatar
Austin Seipp committed
243
-}
244

245 246 247 248 249
rnSpliceGen :: (HsSplice GhcRn -> RnM (a, FreeVars))
                                            -- Outside brackets, run splice
            -> (HsSplice GhcRn -> (PendingRnSplice, a))
                                            -- Inside brackets, make it pending
            -> HsSplice GhcPs
250
            -> RnM (a, FreeVars)
251 252
rnSpliceGen run_splice pend_splice splice
  = addErrCtxt (spliceCtxt splice) $ do
253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270
    { stage <- getStage
    ; case stage of
        Brack pop_stage RnPendingTyped
          -> do { checkTc is_typed_splice illegalUntypedSplice
                ; (splice', fvs) <- setStage pop_stage $
                                    rnSplice splice
                ; let (_pending_splice, result) = pend_splice splice'
                ; return (result, fvs) }

        Brack pop_stage (RnPendingUntyped ps_var)
          -> do { checkTc (not is_typed_splice) illegalTypedSplice
                ; (splice', fvs) <- setStage pop_stage $
                                    rnSplice splice
                ; let (pending_splice, result) = pend_splice splice'
                ; ps <- readMutVar ps_var
                ; writeMutVar ps_var (pending_splice : ps)
                ; return (result, fvs) }

271
        _ ->  do { (splice', fvs1) <- checkNoErrs $
272
                                      setStage (Splice splice_type) $
273
                                      rnSplice splice
274 275 276
                   -- checkNoErrs: don't attempt to run the splice if
                   -- renaming it failed; otherwise we get a cascade of
                   -- errors from e.g. unbound variables
277 278
                 ; (result, fvs2) <- run_splice splice'
                 ; return (result, fvs1 `plusFV` fvs2) } }
279 280
   where
     is_typed_splice = isTypedSplice splice
281 282 283
     splice_type = if is_typed_splice
                   then Typed
                   else Untyped
284 285

------------------
286 287 288 289 290

-- | Returns the result of running a splice and the modFinalizers collected
-- during the execution.
--
-- See Note [Delaying modFinalizers in untyped splices].
291
runRnSplice :: UntypedSpliceFlavour
292
            -> (LHsExpr GhcTc -> TcRn res)
293 294
            -> (res -> SDoc)    -- How to pretty-print res
                                -- Usually just ppr, but not for [Decl]
295
            -> HsSplice GhcRn   -- Always untyped
296
            -> TcRn (res, [ForeignRef (TH.Q ())])
297 298 299 300
runRnSplice flavour run_meta ppr_res splice
  = do { splice' <- getHooked runRnSpliceHook return >>= ($ splice)

       ; let the_expr = case splice' of
301 302 303 304
                HsUntypedSplice _ _ _ e   ->  e
                HsQuasiQuote _ _ q qs str -> mkQuasiQuoteExpr flavour q qs str
                HsTypedSplice {}          -> pprPanic "runRnSplice" (ppr splice)
                HsSpliced {}              -> pprPanic "runRnSplice" (ppr splice)
305
                HsSplicedT {}             -> pprPanic "runRnSplice" (ppr splice)
306
                XSplice {}                -> pprPanic "runRnSplice" (ppr splice)
307 308 309

             -- Typecheck the expression
       ; meta_exp_ty   <- tcMetaTy meta_ty_name
310 311 312
       ; zonked_q_expr <- zonkTopLExpr =<<
                            tcTopSpliceExpr Untyped
                              (tcPolyExpr the_expr meta_exp_ty)
313 314

             -- Run the expression
315 316 317 318
       ; mod_finalizers_ref <- newTcRef []
       ; result <- setStage (RunSplice mod_finalizers_ref) $
                     run_meta zonked_q_expr
       ; mod_finalizers <- readTcRef mod_finalizers_ref
319 320 321 322 323
       ; traceSplice (SpliceInfo { spliceDescription = what
                                 , spliceIsDecl      = is_decl
                                 , spliceSource      = Just the_expr
                                 , spliceGenerated   = ppr_res result })

324
       ; return (result, mod_finalizers) }
325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342

  where
    meta_ty_name = case flavour of
                       UntypedExpSplice  -> expQTyConName
                       UntypedPatSplice  -> patQTyConName
                       UntypedTypeSplice -> typeQTyConName
                       UntypedDeclSplice -> decsQTyConName
    what = case flavour of
                  UntypedExpSplice  -> "expression"
                  UntypedPatSplice  -> "pattern"
                  UntypedTypeSplice -> "type"
                  UntypedDeclSplice -> "declarations"
    is_decl = case flavour of
                 UntypedDeclSplice -> True
                 _                 -> False

------------------
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 349 350
  = PendingRnSplice flavour n (mkQuasiQuoteExpr flavour quoter q_span quote)
makePending _ splice@(HsTypedSplice {})
  = pprPanic "makePending" (ppr splice)
351 352
makePending _ splice@(HsSpliced {})
  = pprPanic "makePending" (ppr splice)
353 354
makePending _ splice@(HsSplicedT {})
  = pprPanic "makePending" (ppr splice)
355 356
makePending _ splice@(XSplice {})
  = pprPanic "makePending" (ppr splice)
357 358

------------------
359 360
mkQuasiQuoteExpr :: UntypedSpliceFlavour -> Name -> SrcSpan -> FastString
                 -> LHsExpr GhcRn
361 362 363
-- Return the expression (quoter "...quote...")
-- which is what we must run in a quasi-quote
mkQuasiQuoteExpr flavour quoter q_span quote
364 365
  = cL q_span $ HsApp noExt (cL q_span
              $ HsApp noExt (cL q_span (HsVar noExt (cL q_span quote_selector)))
366
                            quoterExpr)
367 368
                     quoteExpr
  where
369 370
    quoterExpr = cL q_span $! HsVar noExt $! (cL q_span quoter)
    quoteExpr  = cL q_span $! HsLit noExt $! HsString NoSourceText quote
371 372 373 374 375
    quote_selector = case flavour of
                       UntypedExpSplice  -> quoteExpName
                       UntypedPatSplice  -> quotePatName
                       UntypedTypeSplice -> quoteTypeName
                       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 382
  = do  { checkTH expr "Template Haskell typed splice"
        ; loc  <- getSrcSpanM
383
        ; n' <- newLocalBndrRn (cL loc splice_name)
384
        ; (expr', fvs) <- rnLExpr expr
385
        ; return (HsTypedSplice x hasParen n' expr', fvs) }
386

387
rnSplice (HsUntypedSplice x hasParen splice_name expr)
388
  = do  { checkTH expr "Template Haskell untyped splice"
389
        ; loc  <- getSrcSpanM
390
        ; n' <- newLocalBndrRn (cL loc splice_name)
391
        ; (expr', fvs) <- rnLExpr expr
392
        ; return (HsUntypedSplice x hasParen n' expr', fvs) }
393

394
rnSplice (HsQuasiQuote x splice_name quoter q_loc quote)
395 396
  = do  { checkTH quoter "Template Haskell quasi-quote"
        ; loc  <- getSrcSpanM
397
        ; splice_name' <- newLocalBndrRn (cL loc splice_name)
398 399 400 401 402 403 404

          -- Rename the quoter; akin to the HsVar case of rnExpr
        ; quoter' <- lookupOccRn quoter
        ; this_mod <- getModule
        ; when (nameIsLocalOrFrom this_mod quoter') $
          checkThLocalName quoter'

405 406
        ; return (HsQuasiQuote x splice_name' quoter' q_loc quote
                                                             , unitFV quoter') }
407

408
rnSplice splice@(HsSpliced {}) = pprPanic "rnSplice" (ppr splice)
409
rnSplice splice@(HsSplicedT {}) = pprPanic "rnSplice" (ppr splice)
410
rnSplice splice@(XSplice {})   = pprPanic "rnSplice" (ppr splice)
411

412
---------------------
413
rnSpliceExpr :: HsSplice GhcPs -> RnM (HsExpr GhcRn, FreeVars)
414 415
rnSpliceExpr splice
  = rnSpliceGen run_expr_splice pend_expr_splice splice
gmainland's avatar
gmainland committed
416
  where
417
    pend_expr_splice :: HsSplice GhcRn -> (PendingRnSplice, HsExpr GhcRn)
418
    pend_expr_splice rn_splice
419
        = (makePending UntypedExpSplice rn_splice, HsSpliceE noExt rn_splice)
420

421
    run_expr_splice :: HsSplice GhcRn -> RnM (HsExpr GhcRn, FreeVars)
422 423
    run_expr_splice rn_splice
      | 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 428 429 430
           ; gbl_rdr <- getGlobalRdrEnv
           ; let gbl_names = mkNameSet [gre_name gre | gre <- globalRdrEnvElts gbl_rdr
                                                     , isLocalGRE gre]
                 lcl_names = mkNameSet (localRdrEnvElts lcl_rdr)
gmainland's avatar
gmainland committed
431

432
           ; return (HsSpliceE noExt 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 437
           ; (rn_expr, mod_finalizers) <-
                runRnSplice UntypedExpSplice runMetaE ppr rn_splice
438
           ; (lexpr3, fvs) <- checkNoErrs (rnLExpr rn_expr)
439
             -- See Note [Delaying modFinalizers in untyped splices].
440 441
           ; return ( HsPar noExt $ HsSpliceE noExt
                            . HsSpliced noExt (ThModFinalizers mod_finalizers)
442 443 444 445
                            . HsSplicedExpr <$>
                            lexpr3
                    , fvs)
           }
446

447 448 449
{- Note [Running splices in the Renamer]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

450
Splices used to be run in the typechecker, which led to (#4364). Since the
451 452 453
renamer must decide which expressions depend on which others, and it cannot
reliably do this for arbitrary splices, we used to conservatively say that
splices depend on all other expressions in scope. Unfortunately, this led to
454
the problem of cyclic type declarations seen in (#4364). Instead, by
455 456 457 458
running splices in the renamer, we side-step the problem of determining
dependencies: by the time the dependency analysis happens, any splices have
already been run, and expression dependencies can be determined as usual.

459
However, see (#9813), for an example where we would like to run splices
460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479
*after* performing dependency analysis (that is, after renaming). It would be
desirable to typecheck "non-splicy" expressions (those expressions that do not
contain splices directly or via dependence on an expression that does) before
"splicy" expressions, such that types/expressions within the same declaration
group would be available to `reify` calls, for example consider the following:

> module M where
>   data D = C
>   f = 1
>   g = $(mapM reify ['f, 'D, ''C] ...)

Compilation of this example fails since D/C/f are not in the type environment
and thus cannot be reified as they have not been typechecked by the time the
splice is renamed and thus run.

These requirements are at odds: we do not want to run splices in the renamer as
we wish to first determine dependencies and typecheck certain expressions,
making them available to reify, but cannot accurately determine dependencies
without running splices in the renamer!

480
Indeed, the conclusion of (#9813) was that it is not worth the complexity
481 482 483 484 485 486 487 488
to try and
 a) implement and maintain the code for renaming/typechecking non-splicy
    expressions before splicy expressions,
 b) explain to TH users which expressions are/not available to reify at any
    given point.

-}

489 490 491 492
{- Note [Delaying modFinalizers in untyped splices]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

When splices run in the renamer, 'reify' does not have access to the local
493
type environment (#11832, [1]).
494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527

For instance, in

> let x = e in $(reify (mkName "x") >>= runIO . print >> [| return () |])

'reify' cannot find @x@, because the local type environment is not yet
populated. To address this, we allow 'reify' execution to be deferred with
'addModFinalizer'.

> let x = e in $(do addModFinalizer (reify (mkName "x") >>= runIO . print)
                    [| return () |]
                )

The finalizer is run with the local type environment when type checking is
complete.

Since the local type environment is not available in the renamer, we annotate
the tree at the splice point [2] with @HsSpliceE (HsSpliced finalizers e)@ where
@e@ is the result of splicing and @finalizers@ are the finalizers that have been
collected during evaluation of the splice [3]. In our example,

> HsLet
>   (x = e)
>   (HsSpliceE $ HsSpliced [reify (mkName "x") >>= runIO . print]
>                          (HsSplicedExpr $ return ())
>   )

When the typechecker finds the annotation, it inserts the finalizers in the
global environment and exposes the current local environment to them [4, 5, 6].

> addModFinalizersWithLclEnv [reify (mkName "x") >>= runIO . print]

References:

528
[1] https://gitlab.haskell.org/ghc/ghc/wikis/template-haskell/reify
529 530 531 532 533 534 535 536
[2] 'rnSpliceExpr'
[3] 'TcSplice.qAddModFinalizer'
[4] 'TcExpr.tcExpr' ('HsSpliceE' ('HsSpliced' ...))
[5] 'TcHsType.tc_hs_type' ('HsSpliceTy' ('HsSpliced' ...))
[6] 'TcPat.tc_pat' ('SplicePat' ('HsSpliced' ...))

-}

537
----------------------
538 539
rnSpliceType :: HsSplice GhcPs -> RnM (HsType GhcRn, FreeVars)
rnSpliceType splice
540
  = rnSpliceGen run_type_splice pend_type_splice splice
541
  where
542
    pend_type_splice rn_splice
543 544
       = ( makePending UntypedTypeSplice rn_splice
         , HsSpliceTy noExt rn_splice)
gmainland's avatar
gmainland committed
545

546
    run_type_splice rn_splice
547
      = do { traceRn "rnSpliceType: untyped type splice" empty
548 549
           ; (hs_ty2, mod_finalizers) <-
                runRnSplice UntypedTypeSplice runMetaT ppr rn_splice
550 551 552
           ; (hs_ty3, fvs) <- do { let doc = SpliceTypeCtx hs_ty2
                                 ; checkNoErrs $ rnLHsType doc hs_ty2 }
                                    -- checkNoErrs: see Note [Renamer errors]
553
             -- See Note [Delaying modFinalizers in untyped splices].
554 555
           ; return ( HsParTy noExt $ HsSpliceTy noExt
                              . HsSpliced noExt (ThModFinalizers mod_finalizers)
556 557 558 559
                              . HsSplicedTy <$>
                              hs_ty3
                    , fvs
                    ) }
560 561
              -- Wrap the result of the splice in parens so that we don't
              -- lose the outermost location set by runQuasiQuote (#7918)
thomasw's avatar
thomasw committed
562

563 564
{- Note [Partial Type Splices]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
thomasw's avatar
thomasw committed
565 566 567
Partial Type Signatures are partially supported in TH type splices: only
anonymous wild cards are allowed.

568 569
  -- ToDo: SLPJ says: I don't understand all this

thomasw's avatar
thomasw committed
570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588
Normally, named wild cards are collected before renaming a (partial) type
signature. However, TH type splices are run during renaming, i.e. after the
initial traversal, leading to out of scope errors for named wild cards. We
can't just extend the initial traversal to collect the named wild cards in TH
type splices, as we'd need to expand them, which is supposed to happen only
once, during renaming.

Similarly, the extra-constraints wild card is handled right before renaming
too, and is therefore also not supported in a TH type splice. Another reason
to forbid extra-constraints wild cards in TH type splices is that a single
signature can contain many TH type splices, whereas it mustn't contain more
than one extra-constraints wild card. Enforcing would this be hard the way
things are currently organised.

Anonymous wild cards pose no problem, because they start out without names and
are given names during renaming. These names are collected right after
renaming. The names generated for anonymous wild cards in TH type splices will
thus be collected as well.

589
For more details about renaming wild cards, see RnTypes.rnHsSigWcType
thomasw's avatar
thomasw committed
590 591 592 593 594 595 596 597

Note that partial type signatures are fully supported in TH declaration
splices, e.g.:

     [d| foo :: _ => _
         foo x y = x == y |]

This is because in this case, the partial type signature can be treated as a
598
whole signature, instead of as an arbitrary type.
thomasw's avatar
thomasw committed
599 600 601

-}

602

603 604
----------------------
-- | Rename a splice pattern. See Note [rnSplicePat]
605
rnSplicePat :: HsSplice GhcPs -> RnM ( Either (Pat GhcPs) (Pat GhcRn)
606 607 608 609
                                       , FreeVars)
rnSplicePat splice
  = rnSpliceGen run_pat_splice pend_pat_splice splice
  where
610 611
    pend_pat_splice :: HsSplice GhcRn ->
                       (PendingRnSplice, Either b (Pat GhcRn))
612
    pend_pat_splice rn_splice
613 614
      = (makePending UntypedPatSplice rn_splice
        , Right (SplicePat noExt rn_splice))
615

616 617
    run_pat_splice :: HsSplice GhcRn ->
                      RnM (Either (Pat GhcPs) (Pat GhcRn), FreeVars)
618
    run_pat_splice rn_splice
619
      = do { traceRn "rnSplicePat: untyped pattern splice" empty
620 621 622
           ; (pat, mod_finalizers) <-
                runRnSplice UntypedPatSplice runMetaP ppr rn_splice
             -- See Note [Delaying modFinalizers in untyped splices].
623
           ; return ( Left $ ParPat noExt $ ((SplicePat noExt)
624
                              . HsSpliced noExt (ThModFinalizers mod_finalizers)
625
                              . HsSplicedPat)  `onHasSrcSpan`
626
                              pat
627 628
                    , emptyFVs
                    ) }
629 630
              -- Wrap the result of the quasi-quoter in parens so that we don't
              -- lose the outermost location set by runQuasiQuote (#7918)
631

632
----------------------
633
rnSpliceDecl :: SpliceDecl GhcPs -> RnM (SpliceDecl GhcRn, FreeVars)
634
rnSpliceDecl (SpliceDecl _ (dL->L loc splice) flg)
635 636 637
  = rnSpliceGen run_decl_splice pend_decl_splice splice
  where
    pend_decl_splice rn_splice
638
       = ( makePending UntypedDeclSplice rn_splice
639
         , SpliceDecl noExt (cL loc rn_splice) flg)
640

641
    run_decl_splice rn_splice = pprPanic "rnSpliceDecl" (ppr rn_splice)
642
rnSpliceDecl (XSpliceDecl _) = panic "rnSpliceDecl"
643

644
rnTopSpliceDecls :: HsSplice GhcPs -> RnM ([LHsDecl GhcPs], FreeVars)
645 646
-- Declaration splice at the very top level of the module
rnTopSpliceDecls splice
647 648
   = do  { (rn_splice, fvs) <- checkNoErrs $
                               setStage (Splice Untyped) $
649
                               rnSplice splice
650 651
           -- As always, be sure to checkNoErrs above lest we end up with
           -- holes making it to typechecking, hence #12584.
652 653 654 655 656 657 658
           --
           -- Note that we cannot call checkNoErrs for the whole duration
           -- of rnTopSpliceDecls. The reason is that checkNoErrs changes
           -- the local environment to temporarily contain a new
           -- reference to store errors, and add_mod_finalizers would
           -- cause this reference to be stored after checkNoErrs finishes.
           -- This is checked by test TH_finalizer.
659
         ; traceRn "rnTopSpliceDecls: untyped declaration splice" empty
660 661
         ; (decls, mod_finalizers) <- checkNoErrs $
               runRnSplice UntypedDeclSplice runMetaD ppr_decls rn_splice
662
         ; add_mod_finalizers_now mod_finalizers
663 664
         ; return (decls,fvs) }
   where
665
     ppr_decls :: [LHsDecl GhcPs] -> SDoc
666
     ppr_decls ds = vcat (map ppr ds)
667

668 669 670 671 672 673 674 675
     -- Adds finalizers to the global environment instead of delaying them
     -- to the type checker.
     --
     -- Declaration splices do not have an interesting local environment so
     -- there is no point in delaying them.
     --
     -- See Note [Delaying modFinalizers in untyped splices].
     add_mod_finalizers_now :: [ForeignRef (TH.Q ())] -> TcRn ()
676
     add_mod_finalizers_now []             = return ()
677 678
     add_mod_finalizers_now mod_finalizers = do
       th_modfinalizers_var <- fmap tcg_th_modfinalizers getGblEnv
679
       env <- getLclEnv
680
       updTcRef th_modfinalizers_var $ \fins ->
681
         (env, ThModFinalizers mod_finalizers) : fins
682 683


Austin Seipp's avatar
Austin Seipp committed
684
{-
685 686 687 688 689 690 691 692 693 694 695 696 697 698
Note [rnSplicePat]
~~~~~~~~~~~~~~~~~~
Renaming a pattern splice is a bit tricky, because we need the variables
bound in the pattern to be in scope in the RHS of the pattern. This scope
management is effectively done by using continuation-passing style in
RnPat, through the CpsRn monad. We don't wish to be in that monad here
(it would create import cycles and generally conflict with renaming other
splices), so we really want to return a (Pat RdrName) -- the result of
running the splice -- which can then be further renamed in RnPat, in
the CpsRn monad.

The problem is that if we're renaming a splice within a bracket, we
*don't* want to run the splice now. We really do just want to rename
it to an HsSplice Name. Of course, then we can't know what variables
699 700 701 702
are bound within the splice. So we accept any unbound variables and
rename them again when the bracket is spliced in.  If a variable is brought
into scope by a pattern splice all is fine.  If it is not then an error is
reported.
703 704 705 706 707

In any case, when we're done in rnSplicePat, we'll either have a
Pat RdrName (the result of running a top-level splice) or a Pat Name
(the renamed nested splice). Thus, the awkward return type of
rnSplicePat.
Austin Seipp's avatar
Austin Seipp committed
708
-}
709

710
spliceCtxt :: HsSplice GhcPs -> SDoc
711
spliceCtxt splice
712
  = hang (text "In the" <+> what) 2 (ppr splice)
713 714
  where
    what = case splice of
715 716 717
             HsUntypedSplice {} -> text "untyped splice:"
             HsTypedSplice   {} -> text "typed splice:"
             HsQuasiQuote    {} -> text "quasi-quotation:"
718
             HsSpliced       {} -> text "spliced expression:"
719
             HsSplicedT      {} -> text "spliced expression:"
720
             XSplice         {} -> text "spliced expression:"
721 722 723 724

-- | The splice data to be logged
data SpliceInfo
  = SpliceInfo
725 726 727 728 729 730
    { spliceDescription  :: String
    , spliceSource       :: Maybe (LHsExpr GhcRn) -- Nothing <=> top-level decls
                                                  --        added by addTopDecls
    , spliceIsDecl       :: Bool    -- True <=> put the generate code in a file
                                    --          when -dth-dec-file is on
    , spliceGenerated    :: SDoc
731
    }
732 733 734 735 736
        -- Note that 'spliceSource' is *renamed* but not *typechecked*
        -- Reason (a) less typechecking crap
        --        (b) data constructors after type checking have been
        --            changed to their *wrappers*, and that makes them
        --            print always fully qualified
737 738 739 740

-- | outputs splice information for 2 flags which have different output formats:
-- `-ddump-splices` and `-dth-dec-file`
traceSplice :: SpliceInfo -> TcM ()
741 742 743
traceSplice (SpliceInfo { spliceDescription = sd, spliceSource = mb_src
                        , spliceGenerated = gen, spliceIsDecl = is_decl })
  = do { loc <- case mb_src of
744 745
                   Nothing           -> getSrcSpanM
                   Just (dL->L loc _) -> return loc
746 747 748 749 750 751
       ; traceOptTcRn Opt_D_dump_splices (spliceDebugDoc loc)

       ; when is_decl $  -- Raw material for -dth-dec-file
         do { dflags <- getDynFlags
            ; liftIO $ dumpIfSet_dyn_printer alwaysQualify dflags Opt_D_th_dec_file
                                             (spliceCodeDoc loc) } }
752 753
  where
    -- `-ddump-splices`
754 755 756 757 758 759 760 761
    spliceDebugDoc :: SrcSpan -> SDoc
    spliceDebugDoc loc
      = let code = case mb_src of
                     Nothing -> ending
                     Just e  -> nest 2 (ppr e) : ending
            ending = [ text "======>", nest 2 gen ]
        in  hang (ppr loc <> colon <+> text "Splicing" <+> text sd)
               2 (sep code)
762 763

    -- `-dth-dec-file`
764 765 766 767
    spliceCodeDoc :: SrcSpan -> SDoc
    spliceCodeDoc loc
      = vcat [ text "--" <+> ppr loc <> colon <+> text "Splicing" <+> text sd
             , gen ]
gmainland's avatar
gmainland committed
768

769
illegalTypedSplice :: SDoc
770
illegalTypedSplice = text "Typed splices may not appear in untyped brackets"
771 772

illegalUntypedSplice :: SDoc
773
illegalUntypedSplice = text "Untyped splices may not appear in typed brackets"
774

775
checkThLocalName :: Name -> RnM ()
Austin Seipp's avatar
Austin Seipp committed
776
checkThLocalName name
777 778 779 780
  | isUnboundName name   -- Do not report two errors for
  = return ()            --   $(not_in_scope args)

  | otherwise
781
  = do  { traceRn "checkThLocalName" (ppr name)
782 783 784 785 786
        ; mb_local_use <- getStageAndBindLevel name
        ; case mb_local_use of {
             Nothing -> return () ;  -- Not a locally-bound thing
             Just (top_lvl, bind_lvl, use_stage) ->
    do  { let use_lvl = thLevel use_stage
gmainland's avatar
gmainland committed
787
        ; checkWellStaged (quotes (ppr name)) bind_lvl use_lvl
788 789 790
        ; traceRn "checkThLocalName" (ppr name <+> ppr bind_lvl
                                               <+> ppr use_stage
                                               <+> ppr use_lvl)
791
        ; checkCrossStageLifting top_lvl bind_lvl use_stage use_lvl name } } }
gmainland's avatar
gmainland committed
792 793

--------------------------------------
794 795
checkCrossStageLifting :: TopLevelFlag -> ThLevel -> ThStage -> ThLevel
                       -> Name -> TcM ()
gmainland's avatar
gmainland committed
796 797 798 799
-- We are inside brackets, and (use_lvl > bind_lvl)
-- Now we must check whether there's a cross-stage lift to do
-- Examples   \x -> [| x |]
--            [| map |]
800 801 802
--
-- This code is similar to checkCrossStageLifting in TcExpr, but
-- this is only run on *untyped* brackets.
gmainland's avatar
gmainland committed
803

804 805 806 807 808 809 810 811 812
checkCrossStageLifting top_lvl bind_lvl use_stage use_lvl name
  | Brack _ (RnPendingUntyped ps_var) <- use_stage   -- Only for untyped brackets
  , use_lvl > bind_lvl                               -- Cross-stage condition
  = check_cross_stage_lifting top_lvl name ps_var
  | otherwise
  = return ()

check_cross_stage_lifting :: TopLevelFlag -> Name -> TcRef [PendingRnSplice] -> TcM ()
check_cross_stage_lifting top_lvl name ps_var
813 814
  | isTopLevel top_lvl
        -- Top-level identifiers in this module,
gmainland's avatar
gmainland committed
815 816 817 818 819 820
        -- (which have External Names)
        -- are just like the imported case:
        -- no need for the 'lifting' treatment
        -- E.g.  this is fine:
        --   f x = x
        --   g y = [| f 3 |]
821 822 823
  = when (isExternalName name) (keepAlive name)
    -- See Note [Keeping things alive for Template Haskell]

gmainland's avatar
gmainland committed
824 825 826 827 828
  | otherwise
  =     -- Nested identifiers, such as 'x' in
        -- E.g. \x -> [| h x |]
        -- We must behave as if the reference to x was
        --      h $(lift x)
829
        -- We use 'x' itself as the SplicePointName, used by
gmainland's avatar
gmainland committed
830 831
        -- the desugarer to stitch it all back together.
        -- If 'x' occurs many times we may get many identical
832
        -- bindings of the same SplicePointName, but that doesn't
gmainland's avatar
gmainland committed
833
        -- matter, although it's a mite untidy.
834
    do  { traceRn "checkCrossStageLifting" (ppr name)
835 836 837 838 839 840

          -- Construct the (lift x) expression
        ; let lift_expr   = nlHsApp (nlHsVar liftName) (nlHsVar name)
              pend_splice = PendingRnSplice UntypedExpSplice name lift_expr

          -- Update the pending splices
gmainland's avatar
gmainland committed
841
        ; ps <- readMutVar ps_var
842
        ; writeMutVar ps_var (pend_splice : ps) }
843

Austin Seipp's avatar
Austin Seipp committed
844
{-
845 846 847 848 849 850 851 852 853 854 855 856 857 858
Note [Keeping things alive for Template Haskell]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Consider
  f x = x+1
  g y = [| f 3 |]

Here 'f' is referred to from inside the bracket, which turns into data
and mentions only f's *name*, not 'f' itself. So we need some other
way to keep 'f' alive, lest it get dropped as dead code.  That's what
keepAlive does. It puts it in the keep-alive set, which subsequently
ensures that 'f' stays as a top level binding.

This must be done by the renamer, not the type checker (as of old),
because the type checker doesn't typecheck the body of untyped
859
brackets (#8540).
860 861 862 863 864 865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901 902 903

A thing can have a bind_lvl of outerLevel, but have an internal name:
   foo = [d| op = 3
             bop = op + 1 |]
Here the bind_lvl of 'op' is (bogusly) outerLevel, even though it is
bound inside a bracket.  That is because we don't even even record
binding levels for top-level things; the binding levels are in the
LocalRdrEnv.

So the occurrence of 'op' in the rhs of 'bop' looks a bit like a
cross-stage thing, but it isn't really.  And in fact we never need
to do anything here for top-level bound things, so all is fine, if
a bit hacky.

For these chaps (which have Internal Names) we don't want to put
them in the keep-alive set.

Note [Quoting names]
~~~~~~~~~~~~~~~~~~~~
A quoted name 'n is a bit like a quoted expression [| n |], except that we
have no cross-stage lifting (c.f. TcExpr.thBrackId).  So, after incrementing
the use-level to account for the brackets, the cases are:

        bind > use                      Error
        bind = use+1                    OK
        bind < use
                Imported things         OK
                Top-level things        OK
                Non-top-level           Error

where 'use' is the binding level of the 'n quote. (So inside the implied
bracket the level would be use+1.)

Examples:

  f 'map        -- OK; also for top-level defns of this module

  \x. f 'x      -- Not ok (bind = 1, use = 1)
                -- (whereas \x. f [| x |] might have been ok, by
                --                               cross-stage lifting

  \y. [| \x. $(f 'y) |] -- Not ok (bind =1, use = 1)

  [| \x. $(f 'x) |]     -- OK (bind = 2, use = 1)
Austin Seipp's avatar
Austin Seipp committed
904
-}