<commit_before>%
% (c) The University of Glasgow 2006
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%

TcSplice: Template Haskell splices


\begin{code}
{-# OPTIONS -fno-warn-unused-imports -fno-warn-unused-binds #-}
-- The above warning supression flag is a temporary kludge.
-- While working on this module you are encouraged to remove it and fix
-- any warnings in the module. See
--     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
-- for details

module TcSplice( kcSpliceType, tcSpliceExpr, tcSpliceDecls, tcBracket,
                 lookupThName_maybe,
todoSession, todoTcM,
                 runQuasiQuoteExpr, runQuasiQuotePat, runAnnotation ) where

#include "HsVersions.h"

import HscMain
import TcRnDriver
	-- These imports are the reason that TcSplice 
	-- is very high up the module hierarchy

import HsSyn
import Convert
import RnExpr
import RnEnv
import RdrName
import RnTypes
import TcExpr
import TcHsSyn
import TcSimplify
import TcUnify
import TcType
import TcEnv
import TcMType
import TcHsType
import TcIface
import TypeRep
import Name
import NameEnv
import PrelNames
import HscTypes
import OccName
import Var
import Module
import Annotations
import TcRnMonad
import Class
import Inst
import TyCon
import DataCon
import Id
import IdInfo
import TysWiredIn
import DsMeta
import DsExpr
import DsMonad hiding (Splice)
import Serialized
import ErrUtils
import SrcLoc
import Outputable
import Unique
import Data.Maybe
import BasicTypes
import Panic
import FastString
import Exception

import qualified Language.Haskell.TH as TH
-- THSyntax gives access to internal functions and data types
import qualified Language.Haskell.TH.Syntax as TH

#ifdef GHCI
-- Because GHC.Desugar might not be in the base library of the bootstrapping compiler
import GHC.Desugar      ( AnnotationWrapper(..) )
#endif

import GHC.Exts		( unsafeCoerce#, Int#, Int(..) )
import System.IO.Error


--here for every bad reason :-)
import InstEnv
import FamInstEnv
--Session
todoSession :: HscEnv -> Name -> IO (Messages, Maybe (LHsDecl RdrName))
todoSession hsc_env name
  = initTcPrintErrors hsc_env iNTERACTIVE $ 
    setInteractiveContext hsc_env (hsc_IC hsc_env) $
    todoTcM name


todoTcM :: Name -> TcM (LHsDecl RdrName)
todoTcM name = do
  tcTyThing <- TcEnv.tcLookup name
  thInfo <- TcSplice.reifyThing tcTyThing
  let Just thDec = thGetDecFromInfo thInfo --BUG!
  let Right [hsdecl] = Convert.convertToHsDecls
        (error "srcspan of different package?")
        [thDec]
  return hsdecl

thGetDecFromInfo :: TH.Info -> Maybe TH.Dec
thGetDecFromInfo (TH.ClassI dec) = Just dec
thGetDecFromInfo (TH.ClassOpI {}) = error "classop"
thGetDecFromInfo (TH.TyConI dec) = Just dec
thGetDecFromInfo (TH.PrimTyConI {}) = Nothing --error "sometimes we can invent a signature? or it's better not to?"
thGetDecFromInfo (TH.DataConI {}) = error "datacon"
thGetDecFromInfo (TH.VarI _name _type (Just dec) _fixity) = Just dec
thGetDecFromInfo (TH.VarI _name _type Nothing _fixity) = error "vari"
thGetDecFromInfo (TH.TyVarI {}) = Nothing --tyvars don't have decls? they kinda have a type though...

setInteractiveContext :: HscEnv -> InteractiveContext -> TcRn a -> TcRn a
setInteractiveContext hsc_env icxt thing_inside 
  = let -- Initialise the tcg_inst_env with instances from all home modules.  
        -- This mimics the more selective call to hptInstances in tcRnModule.
	(home_insts, home_fam_insts) = hptInstances hsc_env (\_mod -> True)
    in
    updGblEnv (\env -> env { 
	tcg_rdr_env      = ic_rn_gbl_env icxt,
	tcg_inst_env     = extendInstEnvList    (tcg_inst_env env) home_insts,
	tcg_fam_inst_env = extendFamInstEnvList (tcg_fam_inst_env env) 
                                                home_fam_insts 
      }) $

    tcExtendGhciEnv (ic_tmp_ids icxt) $
        -- tcExtendGhciEnv does lots: 
        --   - it extends the local type env (tcl_env) with the given Ids,
        --   - it extends the local rdr env (tcl_rdr) with the Names from 
        --     the given Ids
        --   - it adds the free tyvars of the Ids to the tcl_tyvars
        --     set.
        --
        -- later ids in ic_tmp_ids must shadow earlier ones with the same
        -- OccName, and tcExtendIdEnv implements this behaviour.

    do	{ traceTc (text "setIC" <+> ppr (ic_tmp_ids icxt))
 	; thing_inside }
\end{code}

Note [How top-level splices are handled]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Top-level splices (those not inside a [| .. |] quotation bracket) are handled
very straightforwardly:

  1. tcTopSpliceExpr: typecheck the body e of the splice $(e)

  2. runMetaT: desugar, compile, run it, and convert result back to
     HsSyn RdrName (of the appropriate flavour, eg HsType RdrName,
     HsExpr RdrName etc)

  3. treat the result as if that's what you saw in the first place
     e.g for HsType, rename and kind-check<commit_msg>remove debugging/testing code that got here by mistake<commit_after>%
% (c) The University of Glasgow 2006
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%

TcSplice: Template Haskell splices


\begin{code}
{-# OPTIONS -fno-warn-unused-imports -fno-warn-unused-binds #-}
-- The above warning supression flag is a temporary kludge.
-- While working on this module you are encouraged to remove it and fix
-- any warnings in the module. See
--     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
-- for details

module TcSplice( kcSpliceType, tcSpliceExpr, tcSpliceDecls, tcBracket,
                 lookupThName_maybe,
                 runQuasiQuoteExpr, runQuasiQuotePat, runAnnotation ) where

#include "HsVersions.h"

import HscMain
import TcRnDriver
	-- These imports are the reason that TcSplice 
	-- is very high up the module hierarchy

import HsSyn
import Convert
import RnExpr
import RnEnv
import RdrName
import RnTypes
import TcExpr
import TcHsSyn
import TcSimplify
import TcUnify
import TcType
import TcEnv
import TcMType
import TcHsType
import TcIface
import TypeRep
import Name
import NameEnv
import PrelNames
import HscTypes
import OccName
import Var
import Module
import Annotations
import TcRnMonad
import Class
import Inst
import TyCon
import DataCon
import Id
import IdInfo
import TysWiredIn
import DsMeta
import DsExpr
import DsMonad hiding (Splice)
import Serialized
import ErrUtils
import SrcLoc
import Outputable
import Unique
import Data.Maybe
import BasicTypes
import Panic
import FastString
import Exception

import qualified Language.Haskell.TH as TH
-- THSyntax gives access to internal functions and data types
import qualified Language.Haskell.TH.Syntax as TH

#ifdef GHCI
-- Because GHC.Desugar might not be in the base library of the bootstrapping compiler
import GHC.Desugar      ( AnnotationWrapper(..) )
#endif

import GHC.Exts		( unsafeCoerce#, Int#, Int(..) )
import System.IO.Error
\end{code}

Note [How top-level splices are handled]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Top-level splices (those not inside a [| .. |] quotation bracket) are handled
very straightforwardly:

  1. tcTopSpliceExpr: typecheck the body e of the splice $(e)

  2. runMetaT: desugar, compile, run it, and convert result back to
     HsSyn RdrName (of the appropriate flavour, eg HsType RdrName,
     HsExpr RdrName etc)

  3. treat the result as if that's what you saw in the first place
     e.g for HsType, rename and kind-check
{'fraction_non_alphanumeric': 0.0779467680608365, 'fraction_numerical': 0.004073872895165671, 'mean_word_length': 3.7241821680564464, 'pattern_counts': {'":': 0, '<': 6, '<?xml version=': 0, '>': 13, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 2, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '3689565', 'n_tokens_mistral': 2461, 'n_tokens_neox': 2333, 'n_words': 845}