%
+% (c) The University of Glasgow 2006
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
-\section[TcSplice]{Template Haskell splices}
+
+TcSplice: Template Haskell splices
\begin{code}
module TcSplice( tcSpliceExpr, tcSpliceDecls, tcBracket ) where
#include "HsVersions.h"
-import HscMain ( compileExpr )
-import TcRnDriver ( tcTopSrcDecls )
+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 HscTypes
+import OccName
+import Var
+import Module
+import TcRnMonad
+import IfaceEnv
+import Class
+import TyCon
+import DataCon
+import Id
+import IdInfo
+import TysWiredIn
+import DsMeta
+import DsExpr
+import DsMonad hiding (Splice)
+import ErrUtils
+import SrcLoc
+import Outputable
+import Unique
+import DynFlags
+import PackageConfig
+import BasicTypes
+import Panic
+import FastString
+
import qualified Language.Haskell.TH as TH
-- THSyntax gives access to internal functions and data types
import qualified Language.Haskell.TH.Syntax as TH
-import HsSyn ( HsBracket(..), HsExpr(..), HsSplice(..), LHsExpr, LHsDecl,
- HsType, LHsType )
-import Convert ( convertToHsExpr, convertToHsDecls, convertToHsType, thRdrName )
-import RnExpr ( rnLExpr )
-import RnEnv ( lookupFixityRn, lookupSrcOcc_maybe, lookupImportedName )
-import RdrName ( RdrName, lookupLocalRdrEnv, isSrcRdrName )
-import RnTypes ( rnLHsType )
-import TcExpr ( tcMonoExpr )
-import TcHsSyn ( mkHsDictLet, zonkTopLExpr )
-import TcSimplify ( tcSimplifyTop, tcSimplifyBracket )
-import TcUnify ( boxyUnify, unBox )
-import TcType ( TcType, TcKind, BoxyRhoType, liftedTypeKind, mkAppTy, tcSplitSigmaTy )
-import TcEnv ( spliceOK, tcMetaTy, bracketOK )
-import TcMType ( newFlexiTyVarTy, newKindVar, UserTypeCtxt(ExprSigCtxt), zonkTcType )
-import TcHsType ( tcHsSigType, kcHsType )
-import TcIface ( tcImportDecl )
-import TypeRep ( Type(..), PredType(..), TyThing(..) ) -- For reification
-import PrelNames ( thFAKE )
-import Name ( Name, NamedThing(..), nameOccName, nameModule, isExternalName,
- nameIsLocalOrFrom )
-import NameEnv ( lookupNameEnv )
-import HscTypes ( lookupType, ExternalPackageState(..), emptyModDetails )
-import OccName
-import Var ( Id, TyVar, idType )
-import Module ( moduleName, moduleNameString, modulePackageId )
-import TcRnMonad
-import IfaceEnv ( lookupOrig )
-import Class ( Class, classExtraBigSig )
-import TyCon ( TyCon, tyConTyVars, synTyConDefn,
- isSynTyCon, isNewTyCon, tyConDataCons, isPrimTyCon, isFunTyCon,
- tyConArity, tyConStupidTheta, isUnLiftedTyCon )
-import DataCon ( DataCon, dataConTyCon, dataConOrigArgTys, dataConStrictMarks,
- dataConName, dataConFieldLabels, dataConWrapId, dataConIsInfix,
- isVanillaDataCon )
-import Id ( idName, globalIdDetails )
-import IdInfo ( GlobalIdDetails(..) )
-import TysWiredIn ( mkListTy )
-import DsMeta ( expQTyConName, typeQTyConName, decTyConName, qTyConName, nameTyConName )
-import DsExpr ( dsLExpr )
-import DsMonad ( initDsTc )
-import ErrUtils ( Message )
-import SrcLoc ( SrcSpan, noLoc, unLoc, getLoc )
-import Outputable
-import Unique ( Unique, Uniquable(..), getKey, mkUniqueGrimily )
-import PackageConfig ( packageIdString )
-import BasicTypes ( StrictnessMark(..), Fixity(..), FixityDirection(..) )
-import Panic ( showException )
-import FastString ( LitString )
-
-import GHC.Base ( unsafeCoerce#, Int#, Int(..) ) -- Should have a better home in the module hierarchy
-import Monad ( liftM )
-
-#ifdef GHCI
-import FastString ( mkFastString )
-#endif
+import GHC.Exts ( unsafeCoerce#, Int#, Int(..) )
+import Control.Monad ( liftM )
\end{code}
tcSpliceDecls :: LHsExpr Name -> TcM [LHsDecl RdrName]
tcSpliceExpr :: HsSplice Name -> BoxyRhoType -> TcM (HsExpr TcId)
kcSpliceType :: HsSplice Name -> TcM (HsType Name, TcKind)
+ -- None of these functions add constraints to the LIE
#ifndef GHCI
tcSpliceExpr n e ty = pprPanic "Cant do tcSpliceExpr without GHCi" (ppr e)
%* *
%************************************************************************
+Note [Handling brackets]
+~~~~~~~~~~~~~~~~~~~~~~~~
+Source: f = [| Just $(g 3) |]
+ The [| |] part is a HsBracket
+
+Typechecked: f = [| Just ${s7}(g 3) |]{s7 = g Int 3}
+ The [| |] part is a HsBracketOut, containing *renamed* (not typechecked) expression
+ The "s7" is the "splice point"; the (g Int 3) part is a typechecked expression
+
+Desugared: f = do { s7 <- g Int 3
+ ; return (ConE "Data.Maybe.Just" s7) }
+
\begin{code}
tcBracket :: HsBracket Name -> BoxyRhoType -> TcM (LHsExpr TcId)
tcBracket brack res_ty
runMeta convert expr
= do { -- Desugar
ds_expr <- initDsTc (dsLExpr expr)
-
-- Compile and link it; might fail if linking fails
; hsc_env <- getTopEnv
; src_span <- getSrcSpanM
reifyTyCon tc
= do { cxt <- reifyCxt (tyConStupidTheta tc)
- ; cons <- mapM reifyDataCon (tyConDataCons tc)
+ ; let tvs = tyConTyVars tc
+ ; cons <- mapM (reifyDataCon (mkTyVarTys tvs)) (tyConDataCons tc)
; let name = reifyName tc
- tvs = reifyTyVars (tyConTyVars tc)
+ r_tvs = reifyTyVars tvs
deriv = [] -- Don't know about deriving
- decl | isNewTyCon tc = TH.NewtypeD cxt name tvs (head cons) deriv
- | otherwise = TH.DataD cxt name tvs cons deriv
+ decl | isNewTyCon tc = TH.NewtypeD cxt name r_tvs (head cons) deriv
+ | otherwise = TH.DataD cxt name r_tvs cons deriv
; return (TH.TyConI decl) }
-reifyDataCon :: DataCon -> TcM TH.Con
-reifyDataCon dc
+reifyDataCon :: [Type] -> DataCon -> TcM TH.Con
+reifyDataCon tys dc
| isVanillaDataCon dc
- = do { arg_tys <- reifyTypes (dataConOrigArgTys dc)
+ = do { arg_tys <- reifyTypes (dataConInstOrigArgTys dc tys)
; let stricts = map reifyStrict (dataConStrictMarks dc)
fields = dataConFieldLabels dc
name = reifyName dc
projects / ghc-hetmet.git / blobdiff