<commit_before>{-# LANGUAGE CPP #-}

module RnSplice (
        rnTopSpliceDecls,
        rnSpliceType, rnSpliceExpr, rnSplicePat, rnSpliceDecl,
        rnBracket,
        checkThLocalName
#ifdef GHCI
        , traceSplice, SpliceInfo(..)
#endif
  ) where

#include "HsVersions.h"

import Name
import NameSet
import HsSyn
import RdrName
import TcRnMonad
import Kind

import RnEnv
import RnSource         ( rnSrcDecls, findSplice )
import RnPat            ( rnPat )
import BasicTypes       ( TopLevelFlag, isTopLevel )
import Outputable
import Module
import SrcLoc
import RnTypes          ( rnLHsType )

import Control.Monad    ( unless, when )

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

import TcEnv            ( checkWellStaged )
import THNames          ( liftName )

#ifdef GHCI
import DynFlags
import FastString
import ErrUtils         ( dumpIfSet_dyn_printer )
import TcEnv            ( tcMetaTy )
import Hooks
import Var              ( Id )
import THNames          ( quoteExpName, quotePatName, quoteDecName, quoteTypeName
                        , decsQTyConName, expQTyConName, patQTyConName, typeQTyConName, )

import {-# SOURCE #-} TcExpr   ( tcPolyExpr )
import {-# SOURCE #-} TcSplice ( runMetaD, runMetaE, runMetaP, runMetaT, tcTopSpliceExpr )
#endif

import qualified GHC.LanguageExtensions as LangExt

{-
************************************************************************
*                                                                      *
        Template Haskell brackets
*                                                                      *
************************************************************************
-}

rnBracket :: HsExpr RdrName -> HsBracket RdrName -> RnM (HsExpr Name, FreeVars)
rnBracket e br_body
  = addErrCtxt (quotationCtxtDoc br_body) $
    do { -- Check that -XTemplateHaskellQuotes is enabled and available
         thQuotesEnabled <- xoptM LangExt.TemplateHaskellQuotes
       ; unless thQuotesEnabled $
           failWith ( vcat
                      [ text "Syntax error on" <+> ppr e
                      , text ("Perhaps you intended to use TemplateHaskell"
                              ++ " or TemplateHaskellQuotes") ] )

         -- Check for nested brackets
       ; cur_stage <- getStage
       ; case cur_stage of
           { Splice Typed   -> checkTc (isTypedBracket br_body)
                                       illegalUntypedBracket
           ; Splice Untyped -> checkTc (not (isTypedBracket br_body))
                                       illegalTypedBracket
           ; Comp           -> return ()
           ; Brack {}       -> failWithTc illegalBracket
           }

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

       ; case isTypedBracket br_body of
            True  -> do { traceRn (text "Renaming typed TH bracket")
                        ; (body', fvs_e) <-
                          setStage (Brack cur_stage RnPendingTyped) $
                                   rn_bracket cur_stage br_body
                        ; return (HsBracket body', fvs_e) }

            False -> do { traceRn (text "Renaming untyped TH bracket")
                        ; ps_var <- newMutVar []
                        ; (body', fvs_e) <-
                          setStage (Brack cur_stage (RnPendingUntyped ps_var)) $
                                   rn_bracket cur_stage br_body
                        ; pendings <- readMutVar ps_var
                        ; return (HsRnBracketOut body' pendings, fvs_e) }
       }

rn_bracket :: ThStage -> HsBracket RdrName -> RnM (HsBracket Name, FreeVars)
rn_bracket outer_stage br@(VarBr flg rdr_name)
  = do { name <- lookupOccRn rdr_name
       ; this_mod <- getModule

       ; when (flg && nameIsLocalOrFrom this_mod name) $
             -- Type variables can be quoted in TH. See #5721.
                 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
                             -> do { traceRn (text "rn_bracket VarBr" <+> ppr name <+> ppr bind_lvl <+> ppr outer_stage)
                                   ; checkTc (thLevel outer_stage + 1 == bind_lvl)
                                             (quotedNameStageErr br) }
                        }
                    }
       ; return (VarBr flg name, unitFV name) }

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

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

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

rn_bracket _ (DecBrL decls)
  = 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 $
                              rnSrcDecls group

              -- Discard the tcg_env; it contains only extra info about fixity
        ; traceRn (text "rn_bracket dec" <+> (ppr (tcg_dus tcg_env) $$
                   ppr (duUses (tcg_dus tcg_env))))
        ; return (DecBrG group', duUses (tcg_dus tcg_env)) }
  where
    groupDecls :: [LHsDecl RdrName] -> RnM (HsGroup RdrName)
    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' }
                  }
           }}

rn_bracket _ (DecBrG _) = panic "rn_bracket: unexpected DecBrG"

rn_bracket _ (TExpBr e) = do { (e', fvs) <- rnLExpr e
                             ; return (TExpBr e', fvs) }

quotationCtxtDoc :: HsBracket RdrName -> SDoc
quotationCtxtDoc br_body
  = hang (text "In the Template Haskell quotation")
         2 (ppr br_body)

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

illegalTypedBracket :: SDoc
illegalTypedBracket =
    text "Typed brackets may only appear in typed splices."

illegalUntypedBracket :: SDoc
illegalUntypedBracket =
    text "Untyped brackets may only appear in untyped splices."

quotedNameStageErr :: HsBracket RdrName -> SDoc
quotedNameStageErr br
  = sep [ text "Stage error: the non-top-level quoted name" <+> ppr br
        , text "must be used at the same stage at which is is bound" ]

#ifndef GHCI
rnTopSpliceDecls :: HsSplice RdrName -> RnM ([LHsDecl RdrName], FreeVars)
rnTopSpliceDecls e = failTH e "Template Haskell top splice"

rnSpliceType :: HsSplice RdrName -> PostTc Name Kind
             -> RnM (HsType Name, FreeVars)
rnSpliceType e _ = failTH e "Template Haskell type splice"

rnSpliceExpr :: HsSplice RdrName -> RnM (HsExpr Name, FreeVars)
rnSpliceExpr e = failTH e "Template Haskell splice"

rnSplicePat :: HsSplice RdrName -> RnM (Either (Pat RdrName) (Pat Name), FreeVars)
rnSplicePat e = failTH e "Template Haskell pattern splice"

rnSpliceDecl :: SpliceDecl RdrName -> RnM (SpliceDecl Name, FreeVars)
rnSpliceDecl e = failTH e "Template Haskell declaration splice"
#else

{-
*********************************************************
*                                                      *
                Splices
*                                                      *
*********************************************************

Note [Free variables of typed splices]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Consider renaming this:
        f = ...
        h = ...$(thing "f")...

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.

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.

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.
-}

rnSpliceGen :: (HsSplice Name -> RnM (a, FreeVars))     -- Outside brackets, run splice
            -> (HsSplice Name -> (PendingRnSplice, a))  -- Inside brackets, make it pending
            -> HsSplice RdrName
            -> RnM (a, FreeVars)
rnSpliceGen run_splice pend_splice splice
  = addErrCtxt (spliceCtxt splice) $ do
    { 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) }

        _ ->  do { (splice', fvs1) <- checkNoErrs $
                                      setStage (Splice splice_type) $
                                      rnSplice splice
                   -- checkNoErrs: don't attempt to run the splice if
                   -- renaming it failed; otherwise we get a cascade of
                   -- errors from e.g. unbound variables
                 ; (result, fvs2) <- run_splice splice'
                 ; return (result, fvs1 `plusFV` fvs2) } }
   where
     is_typed_splice = isTypedSplice splice
     splice_type = if is_typed_splice
                   then Typed
                   else Untyped

------------------
runRnSplice :: UntypedSpliceFlavour
            -> (LHsExpr Id -> TcRn res)
            -> (res -> SDoc)    -- How to pretty-print res
                                -- Usually just ppr, but not for [Decl]
            -> HsSplice Name    -- Always untyped
            -> TcRn res
runRnSplice flavour run_meta ppr_res splice
  = do { splice' <- getHooked runRnSpliceHook return >>= ($ splice)

       ; let the_expr = case splice' of
                  HsUntypedSplice _ e     ->  e
                  HsQuasiQuote _ q qs str -> mkQuasiQuoteExpr flavour q qs str
                  HsTypedSplice {}        -> pprPanic "runRnSplice" (ppr splice)

             -- Typecheck the expression
       ; meta_exp_ty   <- tcMetaTy meta_ty_name
       ; zonked_q_expr <- tcTopSpliceExpr Untyped $
                          tcPolyExpr the_expr meta_exp_ty

             -- Run the expression
       ; result <- run_meta zonked_q_expr
       ; traceSplice (SpliceInfo { spliceDescription = what
                                 , spliceIsDecl      = is_decl
                                 , spliceSource      = Just the_expr
                                 , spliceGenerated   = ppr_res result })

       ; return result }

  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
            -> HsSplice Name
            -> PendingRnSplice
makePending flavour (HsUntypedSplice n e)
  = PendingRnSplice flavour n e
makePending flavour (HsQuasiQuote n quoter q_span quote)
  = PendingRnSplice flavour n (mkQuasiQuoteExpr flavour quoter q_span quote)
makePending _ splice@(HsTypedSplice {})
  = pprPanic "makePending" (ppr splice)

------------------
mkQuasiQuoteExpr :: UntypedSpliceFlavour -> Name -> SrcSpan -> FastString -> LHsExpr Name
-- Return the expression (quoter "...quote...")
-- which is what we must run in a quasi-quote
mkQuasiQuoteExpr flavour quoter q_span quote
  = L q_span $ HsApp (L q_span $
                      HsApp (L q_span (HsVar (L q_span quote_selector)))
                            quoterExpr)
                     quoteExpr
  where
    quoterExpr = L q_span $! HsVar $! (L q_span quoter)
    quoteExpr  = L q_span $! HsLit $! HsString "" quote
    quote_selector = case flavour of
                       UntypedExpSplice  -> quoteExpName
                       UntypedPatSplice  -> quotePatName
                       UntypedTypeSplice -> quoteTypeName
                       UntypedDeclSplice -> quoteDecName

---------------------
rnSplice :: HsSplice RdrName -> RnM (HsSplice Name, FreeVars)
-- Not exported...used for all
rnSplice (HsTypedSplice splice_name expr)
  = do  { checkTH expr "Template Haskell typed splice"
        ; loc  <- getSrcSpanM
        ; n' <- newLocalBndrRn (L loc splice_name)
        ; (expr', fvs) <- rnLExpr expr
        ; return (HsTypedSplice n' expr', fvs) }

rnSplice (HsUntypedSplice splice_name expr)
  = do  { checkTH expr "Template Haskell untyped splice"
        ; loc  <- getSrcSpanM
        ; n' <- newLocalBndrRn (L loc splice_name)
        ; (expr', fvs) <- rnLExpr expr
        ; return (HsUntypedSplice n' expr', fvs) }

rnSplice (HsQuasiQuote splice_name quoter q_loc quote)
  = do  { checkTH quoter "Template Haskell quasi-quote"
        ; loc  <- getSrcSpanM
        ; splice_name' <- newLocalBndrRn (L loc splice_name)

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

        ; return (HsQuasiQuote splice_name' quoter' q_loc quote, unitFV quoter') }

---------------------
rnSpliceExpr :: HsSplice RdrName -> RnM (HsExpr Name, FreeVars)
rnSpliceExpr splice
  = rnSpliceGen run_expr_splice pend_expr_splice splice
  where
    pend_expr_splice :: HsSplice Name -> (PendingRnSplice, HsExpr Name)
    pend_expr_splice rn_splice
        = (makePending UntypedExpSplice rn_splice, HsSpliceE rn_splice)

    run_expr_splice :: HsSplice Name -> RnM (HsExpr Name, FreeVars)
    run_expr_splice rn_splice
      | isTypedSplice rn_splice   -- Run it later, in the type checker
      = do {  -- Ugh!  See Note [Splices] above
             traceRn (text "rnSpliceExpr: typed expression splice")
           ; lcl_rdr <- getLocalRdrEnv
           ; gbl_rdr <- getGlobalRdrEnv
           ; let gbl_names = mkNameSet [gre_name gre | gre <- globalRdrEnvElts gbl_rdr
                                                     , isLocalGRE gre]
                 lcl_names = mkNameSet (localRdrEnvElts lcl_rdr)

           ; return (HsSpliceE rn_splice, lcl_names `plusFV` gbl_names) }

      | otherwise  -- Run it here
      = do { traceRn (text "rnSpliceExpr: untyped expression splice")
           ; rn_expr <- runRnSplice UntypedExpSplice runMetaE ppr rn_splice
           ; (lexpr3, fvs) <- checkNoErrs (rnLExpr rn_expr)
           ; return (HsPar lexpr3, fvs)  }

----------------------
rnSpliceType :: HsSplice RdrName -> PostTc Name Kind
             -> RnM (HsType Name, FreeVars)
rnSpliceType splice k
  = rnSpliceGen run_type_splice pend_type_splice splice
  where
    pend_type_splice rn_splice
       = (makePending UntypedTypeSplice rn_splice, HsSpliceTy rn_splice k)

    run_type_splice rn_splice
      = do { traceRn (text "rnSpliceType: untyped type splice")
           ; hs_ty2 <- runRnSplice UntypedTypeSplice runMetaT ppr rn_splice
           ; (hs_ty3, fvs) <- do { let doc = SpliceTypeCtx hs_ty2
                                 ; checkNoErrs $ rnLHsType doc hs_ty2 }
                                    -- checkNoErrs: see Note [Renamer errors]
           ; return (HsParTy hs_ty3, fvs) }<commit_msg>Add Note [Running splices in the Renamer]<commit_after>{-# LANGUAGE CPP #-}

module RnSplice (
        rnTopSpliceDecls,
        rnSpliceType, rnSpliceExpr, rnSplicePat, rnSpliceDecl,
        rnBracket,
        checkThLocalName
#ifdef GHCI
        , traceSplice, SpliceInfo(..)
#endif
  ) where

#include "HsVersions.h"

import Name
import NameSet
import HsSyn
import RdrName
import TcRnMonad
import Kind

import RnEnv
import RnSource         ( rnSrcDecls, findSplice )
import RnPat            ( rnPat )
import BasicTypes       ( TopLevelFlag, isTopLevel )
import Outputable
import Module
import SrcLoc
import RnTypes          ( rnLHsType )

import Control.Monad    ( unless, when )

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

import TcEnv            ( checkWellStaged )
import THNames          ( liftName )

#ifdef GHCI
import DynFlags
import FastString
import ErrUtils         ( dumpIfSet_dyn_printer )
import TcEnv            ( tcMetaTy )
import Hooks
import Var              ( Id )
import THNames          ( quoteExpName, quotePatName, quoteDecName, quoteTypeName
                        , decsQTyConName, expQTyConName, patQTyConName, typeQTyConName, )

import {-# SOURCE #-} TcExpr   ( tcPolyExpr )
import {-# SOURCE #-} TcSplice ( runMetaD, runMetaE, runMetaP, runMetaT, tcTopSpliceExpr )
#endif

import qualified GHC.LanguageExtensions as LangExt

{-
************************************************************************
*                                                                      *
        Template Haskell brackets
*                                                                      *
************************************************************************
-}

rnBracket :: HsExpr RdrName -> HsBracket RdrName -> RnM (HsExpr Name, FreeVars)
rnBracket e br_body
  = addErrCtxt (quotationCtxtDoc br_body) $
    do { -- Check that -XTemplateHaskellQuotes is enabled and available
         thQuotesEnabled <- xoptM LangExt.TemplateHaskellQuotes
       ; unless thQuotesEnabled $
           failWith ( vcat
                      [ text "Syntax error on" <+> ppr e
                      , text ("Perhaps you intended to use TemplateHaskell"
                              ++ " or TemplateHaskellQuotes") ] )

         -- Check for nested brackets
       ; cur_stage <- getStage
       ; case cur_stage of
           { Splice Typed   -> checkTc (isTypedBracket br_body)
                                       illegalUntypedBracket
           ; Splice Untyped -> checkTc (not (isTypedBracket br_body))
                                       illegalTypedBracket
           ; Comp           -> return ()
           ; Brack {}       -> failWithTc illegalBracket
           }

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

       ; case isTypedBracket br_body of
            True  -> do { traceRn (text "Renaming typed TH bracket")
                        ; (body', fvs_e) <-
                          setStage (Brack cur_stage RnPendingTyped) $
                                   rn_bracket cur_stage br_body
                        ; return (HsBracket body', fvs_e) }

            False -> do { traceRn (text "Renaming untyped TH bracket")
                        ; ps_var <- newMutVar []
                        ; (body', fvs_e) <-
                          setStage (Brack cur_stage (RnPendingUntyped ps_var)) $
                                   rn_bracket cur_stage br_body
                        ; pendings <- readMutVar ps_var
                        ; return (HsRnBracketOut body' pendings, fvs_e) }
       }

rn_bracket :: ThStage -> HsBracket RdrName -> RnM (HsBracket Name, FreeVars)
rn_bracket outer_stage br@(VarBr flg rdr_name)
  = do { name <- lookupOccRn rdr_name
       ; this_mod <- getModule

       ; when (flg && nameIsLocalOrFrom this_mod name) $
             -- Type variables can be quoted in TH. See #5721.
                 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
                             -> do { traceRn (text "rn_bracket VarBr" <+> ppr name <+> ppr bind_lvl <+> ppr outer_stage)
                                   ; checkTc (thLevel outer_stage + 1 == bind_lvl)
                                             (quotedNameStageErr br) }
                        }
                    }
       ; return (VarBr flg name, unitFV name) }

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

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

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

rn_bracket _ (DecBrL decls)
  = 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 $
                              rnSrcDecls group

              -- Discard the tcg_env; it contains only extra info about fixity
        ; traceRn (text "rn_bracket dec" <+> (ppr (tcg_dus tcg_env) $$
                   ppr (duUses (tcg_dus tcg_env))))
        ; return (DecBrG group', duUses (tcg_dus tcg_env)) }
  where
    groupDecls :: [LHsDecl RdrName] -> RnM (HsGroup RdrName)
    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' }
                  }
           }}

rn_bracket _ (DecBrG _) = panic "rn_bracket: unexpected DecBrG"

rn_bracket _ (TExpBr e) = do { (e', fvs) <- rnLExpr e
                             ; return (TExpBr e', fvs) }

quotationCtxtDoc :: HsBracket RdrName -> SDoc
quotationCtxtDoc br_body
  = hang (text "In the Template Haskell quotation")
         2 (ppr br_body)

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

illegalTypedBracket :: SDoc
illegalTypedBracket =
    text "Typed brackets may only appear in typed splices."

illegalUntypedBracket :: SDoc
illegalUntypedBracket =
    text "Untyped brackets may only appear in untyped splices."

quotedNameStageErr :: HsBracket RdrName -> SDoc
quotedNameStageErr br
  = sep [ text "Stage error: the non-top-level quoted name" <+> ppr br
        , text "must be used at the same stage at which is is bound" ]

#ifndef GHCI
rnTopSpliceDecls :: HsSplice RdrName -> RnM ([LHsDecl RdrName], FreeVars)
rnTopSpliceDecls e = failTH e "Template Haskell top splice"

rnSpliceType :: HsSplice RdrName -> PostTc Name Kind
             -> RnM (HsType Name, FreeVars)
rnSpliceType e _ = failTH e "Template Haskell type splice"

rnSpliceExpr :: HsSplice RdrName -> RnM (HsExpr Name, FreeVars)
rnSpliceExpr e = failTH e "Template Haskell splice"

rnSplicePat :: HsSplice RdrName -> RnM (Either (Pat RdrName) (Pat Name), FreeVars)
rnSplicePat e = failTH e "Template Haskell pattern splice"

rnSpliceDecl :: SpliceDecl RdrName -> RnM (SpliceDecl Name, FreeVars)
rnSpliceDecl e = failTH e "Template Haskell declaration splice"
#else

{-
*********************************************************
*                                                      *
                Splices
*                                                      *
*********************************************************

Note [Free variables of typed splices]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Consider renaming this:
        f = ...
        h = ...$(thing "f")...

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.

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.

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.
-}

rnSpliceGen :: (HsSplice Name -> RnM (a, FreeVars))     -- Outside brackets, run splice
            -> (HsSplice Name -> (PendingRnSplice, a))  -- Inside brackets, make it pending
            -> HsSplice RdrName
            -> RnM (a, FreeVars)
rnSpliceGen run_splice pend_splice splice
  = addErrCtxt (spliceCtxt splice) $ do
    { 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) }

        _ ->  do { (splice', fvs1) <- checkNoErrs $
                                      setStage (Splice splice_type) $
                                      rnSplice splice
                   -- checkNoErrs: don't attempt to run the splice if
                   -- renaming it failed; otherwise we get a cascade of
                   -- errors from e.g. unbound variables
                 ; (result, fvs2) <- run_splice splice'
                 ; return (result, fvs1 `plusFV` fvs2) } }
   where
     is_typed_splice = isTypedSplice splice
     splice_type = if is_typed_splice
                   then Typed
                   else Untyped

------------------
runRnSplice :: UntypedSpliceFlavour
            -> (LHsExpr Id -> TcRn res)
            -> (res -> SDoc)    -- How to pretty-print res
                                -- Usually just ppr, but not for [Decl]
            -> HsSplice Name    -- Always untyped
            -> TcRn res
runRnSplice flavour run_meta ppr_res splice
  = do { splice' <- getHooked runRnSpliceHook return >>= ($ splice)

       ; let the_expr = case splice' of
                  HsUntypedSplice _ e     ->  e
                  HsQuasiQuote _ q qs str -> mkQuasiQuoteExpr flavour q qs str
                  HsTypedSplice {}        -> pprPanic "runRnSplice" (ppr splice)

             -- Typecheck the expression
       ; meta_exp_ty   <- tcMetaTy meta_ty_name
       ; zonked_q_expr <- tcTopSpliceExpr Untyped $
                          tcPolyExpr the_expr meta_exp_ty

             -- Run the expression
       ; result <- run_meta zonked_q_expr
       ; traceSplice (SpliceInfo { spliceDescription = what
                                 , spliceIsDecl      = is_decl
                                 , spliceSource      = Just the_expr
                                 , spliceGenerated   = ppr_res result })

       ; return result }

  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
            -> HsSplice Name
            -> PendingRnSplice
makePending flavour (HsUntypedSplice n e)
  = PendingRnSplice flavour n e
makePending flavour (HsQuasiQuote n quoter q_span quote)
  = PendingRnSplice flavour n (mkQuasiQuoteExpr flavour quoter q_span quote)
makePending _ splice@(HsTypedSplice {})
  = pprPanic "makePending" (ppr splice)

------------------
mkQuasiQuoteExpr :: UntypedSpliceFlavour -> Name -> SrcSpan -> FastString -> LHsExpr Name
-- Return the expression (quoter "...quote...")
-- which is what we must run in a quasi-quote
mkQuasiQuoteExpr flavour quoter q_span quote
  = L q_span $ HsApp (L q_span $
                      HsApp (L q_span (HsVar (L q_span quote_selector)))
                            quoterExpr)
                     quoteExpr
  where
    quoterExpr = L q_span $! HsVar $! (L q_span quoter)
    quoteExpr  = L q_span $! HsLit $! HsString "" quote
    quote_selector = case flavour of
                       UntypedExpSplice  -> quoteExpName
                       UntypedPatSplice  -> quotePatName
                       UntypedTypeSplice -> quoteTypeName
                       UntypedDeclSplice -> quoteDecName

---------------------
rnSplice :: HsSplice RdrName -> RnM (HsSplice Name, FreeVars)
-- Not exported...used for all
rnSplice (HsTypedSplice splice_name expr)
  = do  { checkTH expr "Template Haskell typed splice"
        ; loc  <- getSrcSpanM
        ; n' <- newLocalBndrRn (L loc splice_name)
        ; (expr', fvs) <- rnLExpr expr
        ; return (HsTypedSplice n' expr', fvs) }

rnSplice (HsUntypedSplice splice_name expr)
  = do  { checkTH expr "Template Haskell untyped splice"
        ; loc  <- getSrcSpanM
        ; n' <- newLocalBndrRn (L loc splice_name)
        ; (expr', fvs) <- rnLExpr expr
        ; return (HsUntypedSplice n' expr', fvs) }

rnSplice (HsQuasiQuote splice_name quoter q_loc quote)
  = do  { checkTH quoter "Template Haskell quasi-quote"
        ; loc  <- getSrcSpanM
        ; splice_name' <- newLocalBndrRn (L loc splice_name)

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

        ; return (HsQuasiQuote splice_name' quoter' q_loc quote, unitFV quoter') }

---------------------
rnSpliceExpr :: HsSplice RdrName -> RnM (HsExpr Name, FreeVars)
rnSpliceExpr splice
  = rnSpliceGen run_expr_splice pend_expr_splice splice
  where
    pend_expr_splice :: HsSplice Name -> (PendingRnSplice, HsExpr Name)
    pend_expr_splice rn_splice
        = (makePending UntypedExpSplice rn_splice, HsSpliceE rn_splice)

    run_expr_splice :: HsSplice Name -> RnM (HsExpr Name, FreeVars)
    run_expr_splice rn_splice
      | isTypedSplice rn_splice   -- Run it later, in the type checker
      = do {  -- Ugh!  See Note [Splices] above
             traceRn (text "rnSpliceExpr: typed expression splice")
           ; lcl_rdr <- getLocalRdrEnv
           ; gbl_rdr <- getGlobalRdrEnv
           ; let gbl_names = mkNameSet [gre_name gre | gre <- globalRdrEnvElts gbl_rdr
                                                     , isLocalGRE gre]
                 lcl_names = mkNameSet (localRdrEnvElts lcl_rdr)

           ; return (HsSpliceE rn_splice, lcl_names `plusFV` gbl_names) }

      | otherwise  -- Run it here, see Note [Running splices in the Renamer]
      = do { traceRn (text "rnSpliceExpr: untyped expression splice")
           ; rn_expr <- runRnSplice UntypedExpSplice runMetaE ppr rn_splice
           ; (lexpr3, fvs) <- checkNoErrs (rnLExpr rn_expr)
           ; return (HsPar lexpr3, fvs)  }

{- Note [Running splices in the Renamer]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

Splices used to be run in the typechecker, which led to (Trac #4364). Since the
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
the problem of cyclic type declarations seen in (Trac #4364). Instead, by
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.

However, see (Trac #9813), for an example where we would like to run splices
*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!

Indeed, the conclusion of (Trac #9813) was that it is not worth the complexity
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.

-}

----------------------
rnSpliceType :: HsSplice RdrName -> PostTc Name Kind
             -> RnM (HsType Name, FreeVars)
rnSpliceType splice k
  = rnSpliceGen run_type_splice pend_type_splice splice
  where
    pend_type_splice rn_splice
       = (makePending UntypedTypeSplice rn_splice, HsSpliceTy rn_splice k)

    run_type_splice rn_splice
      = do { traceRn (text "rnSpliceType: untyped type splice")
           ; hs_ty2 <- runRnSplice UntypedTypeSplice runMetaT ppr rn_splice
           ; (hs_ty3, fvs) <- do { let doc = SpliceTypeCtx hs_ty2
                                 ; checkNoErrs $ rnLHsType doc hs_ty2 }
                                    -- checkNoErrs: see Note [Renamer errors]
           ; return (HsParTy hs_ty3, fvs) }
{'fraction_non_alphanumeric': 0.0952729044834308, 'fraction_numerical': 0.0013807667316439245, 'mean_word_length': 1.9166929879974732, 'pattern_counts': {'":': 0, '<': 105, '<?xml version=': 0, '>': 161, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 64, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '2731597', 'n_tokens_mistral': 11681, 'n_tokens_neox': 10670, 'n_words': 3351}