Commit 75492e74 authored by Jan Stolarek's avatar Jan Stolarek

Add typed holes support in Template Haskell.

Fixes #10267. Typed holes in typed Template Haskell currently don't work.
See #10945 and #10946.
parent b1884b0e
......@@ -140,7 +140,9 @@ okTcOcc _ = False
-- with an acceptable letter?
okVarIdOcc :: String -> Bool
okVarIdOcc str = okIdOcc str &&
not (str `Set.member` reservedIds)
-- admit "_" as a valid identifier. Required to support typed
-- holes in Template Haskell. See #10267
(str == "_" || not (str `Set.member` reservedIds))
-- | Is this an acceptable symbolic variable name, assuming it starts
-- with an acceptable character?
......@@ -224,6 +226,7 @@ okSymChar c
OtherSymbol -> True
_ -> False
-- | All reserved identifiers. Taken from section 2.4 of the 2010 Report.
reservedIds :: Set.Set String
reservedIds = Set.fromList [ "case", "class", "data", "default", "deriving"
......
......@@ -1167,6 +1167,11 @@ repE (ArithSeq _ _ aseq) =
repE (HsSpliceE splice) = repSplice splice
repE (HsStatic e) = repLE e >>= rep2 staticEName . (:[]) . unC
repE (HsUnboundVar name) = do
occ <- occNameLit name
sname <- repNameS occ
repUnboundVar sname
repE e@(PArrSeq {}) = notHandled "Parallel arrays" (ppr e)
repE e@(HsCoreAnn {}) = notHandled "Core annotations" (ppr e)
repE e@(HsSCC {}) = notHandled "Cost centres" (ppr e)
......@@ -1572,10 +1577,10 @@ globalVar name
| isExternalName name
= do { MkC mod <- coreStringLit name_mod
; MkC pkg <- coreStringLit name_pkg
; MkC occ <- occNameLit name
; MkC occ <- nameLit name
; rep2 mk_varg [pkg,mod,occ] }
| otherwise
= do { MkC occ <- occNameLit name
= do { MkC occ <- nameLit name
; MkC uni <- coreIntLit (getKey (getUnique name))
; rep2 mkNameLName [occ,uni] }
where
......@@ -1612,13 +1617,16 @@ wrapGenSyms binds body@(MkC b)
go _ [] = return body
go var_ty ((name,id) : binds)
= do { MkC body' <- go var_ty binds
; lit_str <- occNameLit name
; lit_str <- nameLit name
; gensym_app <- repGensym lit_str
; repBindQ var_ty elt_ty
gensym_app (MkC (Lam id body')) }
occNameLit :: Name -> DsM (Core String)
occNameLit n = coreStringLit (occNameString (nameOccName n))
nameLit :: Name -> DsM (Core String)
nameLit n = coreStringLit (occNameString (nameOccName n))
occNameLit :: OccName -> DsM (Core String)
occNameLit name = coreStringLit (occNameString name)
-- %*********************************************************************
......@@ -2136,6 +2144,9 @@ mk_lit (HsIntegral _ i) = mk_integer i
mk_lit (HsFractional f) = mk_rational f
mk_lit (HsIsString _ s) = mk_string s
repNameS :: Core String -> DsM (Core TH.Name)
repNameS (MkC name) = rep2 mkNameSName [name]
--------------- Miscellaneous -------------------
repGensym :: Core String -> DsM (Core (TH.Q TH.Name))
......@@ -2150,6 +2161,9 @@ repSequenceQ :: Type -> Core [TH.Q a] -> DsM (Core (TH.Q [a]))
repSequenceQ ty_a (MkC list)
= rep2 sequenceQName [Type ty_a, list]
repUnboundVar :: Core TH.Name -> DsM (Core TH.ExpQ)
repUnboundVar (MkC name) = rep2 unboundVarEName [name]
------------ Lists -------------------
-- turn a list of patterns into a single pattern matching a list
......
......@@ -715,6 +715,7 @@ cvtl e = wrapL (cvt e)
; return $ RecordUpd e' flds'
PlaceHolder PlaceHolder PlaceHolder }
cvt (StaticE e) = fmap HsStatic $ cvtl e
cvt (UnboundVarE s) = do { s' <- vName s; return $ HsVar s' }
{- Note [Dropping constructors]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
......
......@@ -1673,7 +1673,7 @@ pprQuals quals = interpp'SP quals
-}
data HsSplice id
= HsTypedSplice -- $z or $(f 4)
= HsTypedSplice -- $$z or $$(f 4)
id -- A unique name to identify this splice point
(LHsExpr id) -- See Note [Pending Splices]
......
......@@ -27,6 +27,7 @@ templateHaskellNames :: [Name]
templateHaskellNames = [
returnQName, bindQName, sequenceQName, newNameName, liftName,
mkNameName, mkNameG_vName, mkNameG_dName, mkNameG_tcName, mkNameLName,
mkNameSName,
liftStringName,
unTypeName,
unTypeQName,
......@@ -52,7 +53,7 @@ templateHaskellNames = [
tupEName, unboxedTupEName,
condEName, multiIfEName, letEName, caseEName, doEName, compEName,
fromEName, fromThenEName, fromToEName, fromThenToEName,
listEName, sigEName, recConEName, recUpdEName, staticEName,
listEName, sigEName, recConEName, recUpdEName, staticEName, unboundVarEName,
-- FieldExp
fieldExpName,
-- Body
......@@ -184,7 +185,7 @@ kindTyConName = thTc (fsLit "Kind") kindTyConKey
returnQName, bindQName, sequenceQName, newNameName, liftName,
mkNameName, mkNameG_vName, mkNameG_dName, mkNameG_tcName,
mkNameLName, liftStringName, unTypeName, unTypeQName,
mkNameLName, mkNameSName, liftStringName, unTypeName, unTypeQName,
unsafeTExpCoerceName :: Name
returnQName = thFun (fsLit "returnQ") returnQIdKey
bindQName = thFun (fsLit "bindQ") bindQIdKey
......@@ -197,6 +198,7 @@ mkNameG_vName = thFun (fsLit "mkNameG_v") mkNameG_vIdKey
mkNameG_dName = thFun (fsLit "mkNameG_d") mkNameG_dIdKey
mkNameG_tcName = thFun (fsLit "mkNameG_tc") mkNameG_tcIdKey
mkNameLName = thFun (fsLit "mkNameL") mkNameLIdKey
mkNameSName = thFun (fsLit "mkNameS") mkNameSIdKey
unTypeName = thFun (fsLit "unType") unTypeIdKey
unTypeQName = thFun (fsLit "unTypeQ") unTypeQIdKey
unsafeTExpCoerceName = thFun (fsLit "unsafeTExpCoerce") unsafeTExpCoerceIdKey
......@@ -252,7 +254,7 @@ clauseName = libFun (fsLit "clause") clauseIdKey
varEName, conEName, litEName, appEName, infixEName, infixAppName,
sectionLName, sectionRName, lamEName, lamCaseEName, tupEName,
unboxedTupEName, condEName, multiIfEName, letEName, caseEName,
doEName, compEName, staticEName :: Name
doEName, compEName, staticEName, unboundVarEName :: Name
varEName = libFun (fsLit "varE") varEIdKey
conEName = libFun (fsLit "conE") conEIdKey
litEName = libFun (fsLit "litE") litEIdKey
......@@ -284,6 +286,7 @@ sigEName = libFun (fsLit "sigE") sigEIdKey
recConEName = libFun (fsLit "recConE") recConEIdKey
recUpdEName = libFun (fsLit "recUpdE") recUpdEIdKey
staticEName = libFun (fsLit "staticE") staticEIdKey
unboundVarEName = libFun (fsLit "unboundVarE") unboundVarEIdKey
-- type FieldExp = ...
fieldExpName :: Name
......@@ -576,7 +579,8 @@ kindTyConKey = mkPreludeTyConUnique 232
returnQIdKey, bindQIdKey, sequenceQIdKey, liftIdKey, newNameIdKey,
mkNameIdKey, mkNameG_vIdKey, mkNameG_dIdKey, mkNameG_tcIdKey,
mkNameLIdKey, unTypeIdKey, unTypeQIdKey, unsafeTExpCoerceIdKey :: Unique
mkNameLIdKey, mkNameSIdKey, unTypeIdKey, unTypeQIdKey,
unsafeTExpCoerceIdKey :: Unique
returnQIdKey = mkPreludeMiscIdUnique 200
bindQIdKey = mkPreludeMiscIdUnique 201
sequenceQIdKey = mkPreludeMiscIdUnique 202
......@@ -587,9 +591,10 @@ mkNameG_vIdKey = mkPreludeMiscIdUnique 206
mkNameG_dIdKey = mkPreludeMiscIdUnique 207
mkNameG_tcIdKey = mkPreludeMiscIdUnique 208
mkNameLIdKey = mkPreludeMiscIdUnique 209
unTypeIdKey = mkPreludeMiscIdUnique 210
unTypeQIdKey = mkPreludeMiscIdUnique 211
unsafeTExpCoerceIdKey = mkPreludeMiscIdUnique 212
mkNameSIdKey = mkPreludeMiscIdUnique 210
unTypeIdKey = mkPreludeMiscIdUnique 211
unTypeQIdKey = mkPreludeMiscIdUnique 212
unsafeTExpCoerceIdKey = mkPreludeMiscIdUnique 213
-- data Lit = ...
......@@ -647,7 +652,8 @@ varEIdKey, conEIdKey, litEIdKey, appEIdKey, infixEIdKey, infixAppIdKey,
unboxedTupEIdKey, condEIdKey, multiIfEIdKey,
letEIdKey, caseEIdKey, doEIdKey, compEIdKey,
fromEIdKey, fromThenEIdKey, fromToEIdKey, fromThenToEIdKey,
listEIdKey, sigEIdKey, recConEIdKey, recUpdEIdKey, staticEIdKey :: Unique
listEIdKey, sigEIdKey, recConEIdKey, recUpdEIdKey, staticEIdKey,
unboundVarEIdKey :: Unique
varEIdKey = mkPreludeMiscIdUnique 270
conEIdKey = mkPreludeMiscIdUnique 271
litEIdKey = mkPreludeMiscIdUnique 272
......@@ -675,6 +681,7 @@ sigEIdKey = mkPreludeMiscIdUnique 293
recConEIdKey = mkPreludeMiscIdUnique 294
recUpdEIdKey = mkPreludeMiscIdUnique 295
staticEIdKey = mkPreludeMiscIdUnique 296
unboundVarEIdKey = mkPreludeMiscIdUnique 297
-- type FieldExp = ...
fieldExpIdKey :: Unique
......
......@@ -83,19 +83,15 @@ finishHsVar name
rnUnboundVar :: RdrName -> RnM (HsExpr Name, FreeVars)
rnUnboundVar v
= do { stage <- getStage
; if isUnqual v && not (in_untyped_bracket stage)
= do { if isUnqual v
then -- Treat this as a "hole"
-- Do not fail right now; instead, return HsUnboundVar
-- and let the type checker report the error
return (HsUnboundVar (rdrNameOcc v), emptyFVs)
else -- Fail immediately (qualified name, or in untyped bracket)
else -- Fail immediately (qualified name)
do { n <- reportUnboundName v
; return (HsVar n, emptyFVs) } }
where
in_untyped_bracket (Brack _ (RnPendingUntyped {})) = True
in_untyped_bracket _ = False
rnExpr (HsVar v)
= do { mb_name <- lookupOccRn_overloaded False v
......
......@@ -177,7 +177,7 @@ rnSrcDecls group@(HsGroup { hs_valds = val_decls,
-- Haddock docs; no free vars
rn_docs <- mapM (wrapLocM rnDocDecl) docs ;
last_tcg_env <- getGblEnv ;
last_tcg_env <- getGblEnv ;
-- (I) Compute the results and return
let {rn_group = HsGroup { hs_valds = rn_val_decls,
hs_splcds = rn_splice_decls,
......@@ -351,7 +351,7 @@ rnAnnDecl :: AnnDecl RdrName -> RnM (AnnDecl Name, FreeVars)
rnAnnDecl ann@(HsAnnotation s provenance expr)
= addErrCtxt (annCtxt ann) $
do { (provenance', provenance_fvs) <- rnAnnProvenance provenance
; (expr', expr_fvs) <- setStage (Splice False) $
; (expr', expr_fvs) <- setStage (Splice Untyped) $
rnLExpr expr
; return (HsAnnotation s provenance' expr',
provenance_fvs `plusFV` expr_fvs) }
......
......@@ -27,7 +27,6 @@ import Outputable
import Module
import SrcLoc
import DynFlags
import FastString
import RnTypes ( rnLHsType )
import Control.Monad ( unless, when )
......@@ -39,6 +38,7 @@ import TcEnv ( checkWellStaged )
import THNames ( liftName )
#ifdef GHCI
import FastString
import ErrUtils ( dumpIfSet_dyn_printer )
import TcEnv ( tcMetaTy )
import Hooks
......@@ -66,29 +66,36 @@ rnBracket e br_body
do { -- Check that Template Haskell is enabled and available
thEnabled <- xoptM Opt_TemplateHaskell
; unless thEnabled $
failWith ( vcat [ ptext (sLit "Syntax error on") <+> ppr e
, ptext (sLit "Perhaps you intended to use TemplateHaskell") ] )
failWith ( vcat
[ text "Syntax error on" <+> ppr e
, text "Perhaps you intended to use TemplateHaskell" ] )
-- Check for nested brackets
; cur_stage <- getStage
; case cur_stage of
{ Splice True -> checkTc (isTypedBracket br_body) illegalUntypedBracket
; Splice False -> checkTc (not (isTypedBracket br_body)) illegalTypedBracket
; Comp -> return ()
; Brack {} -> failWithTc illegalBracket
{ 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 { (body', fvs_e) <- setStage (Brack cur_stage RnPendingTyped) $
rn_bracket cur_stage br_body
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 { ps_var <- newMutVar []
; (body', fvs_e) <- setStage (Brack cur_stage (RnPendingUntyped ps_var)) $
rn_bracket cur_stage br_body
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) }
}
......@@ -157,22 +164,26 @@ rn_bracket _ (TExpBr e) = do { (e', fvs) <- rnLExpr e
quotationCtxtDoc :: HsBracket RdrName -> SDoc
quotationCtxtDoc br_body
= hang (ptext (sLit "In the Template Haskell quotation"))
= hang (text "In the Template Haskell quotation")
2 (ppr br_body)
illegalBracket :: SDoc
illegalBracket = ptext (sLit "Template Haskell brackets cannot be nested (without intervening splices)")
illegalBracket =
text "Template Haskell brackets cannot be nested" <+>
text "(without intervening splices)"
illegalTypedBracket :: SDoc
illegalTypedBracket = ptext (sLit "Typed brackets may only appear in typed slices.")
illegalTypedBracket =
text "Typed brackets may only appear in typed splices."
illegalUntypedBracket :: SDoc
illegalUntypedBracket = ptext (sLit "Untyped brackets may only appear in untyped slices.")
illegalUntypedBracket =
text "Untyped brackets may only appear in untyped splices."
quotedNameStageErr :: HsBracket RdrName -> SDoc
quotedNameStageErr br
= sep [ ptext (sLit "Stage error: the non-top-level quoted name") <+> ppr br
, ptext (sLit "must be used at the same stage at which is is bound")]
= 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)
......@@ -253,7 +264,7 @@ rnSpliceGen run_splice pend_splice splice
; return (result, fvs) }
_ -> do { (splice', fvs1) <- checkNoErrs $
setStage (Splice is_typed_splice) $
setStage (Splice splice_type) $
rnSplice splice
-- checkNoErrs: don't attempt to run the splice if
-- renaming it failed; otherwise we get a cascade of
......@@ -262,6 +273,9 @@ rnSpliceGen run_splice pend_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
......@@ -280,7 +294,7 @@ runRnSplice flavour run_meta ppr_res splice
-- Typecheck the expression
; meta_exp_ty <- tcMetaTy meta_ty_name
; zonked_q_expr <- tcTopSpliceExpr False $
; zonked_q_expr <- tcTopSpliceExpr Untyped $
tcMonoExpr the_expr meta_exp_ty
-- Run the expression
......@@ -396,7 +410,8 @@ rnSpliceExpr splice
run_expr_splice rn_splice
| isTypedSplice rn_splice -- Run it later, in the type checker
= do { -- Ugh! See Note [Splices] above
lcl_rdr <- getLocalRdrEnv
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]
......@@ -405,7 +420,8 @@ rnSpliceExpr splice
; return (HsSpliceE rn_splice, lcl_names `plusFV` gbl_names) }
| otherwise -- Run it here
= do { rn_expr <- runRnSplice UntypedExpSplice runMetaE ppr rn_splice
= 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) }
......@@ -419,7 +435,8 @@ rnSpliceType splice k
= (makePending UntypedTypeSplice rn_splice, HsSpliceTy rn_splice k)
run_type_splice rn_splice
= do { hs_ty2 <- runRnSplice UntypedTypeSplice runMetaT ppr 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
; checkValidPartialTypeSplice doc hs_ty2
-- See Note [Partial Type Splices]
......@@ -497,7 +514,8 @@ rnSplicePat splice
= (makePending UntypedPatSplice rn_splice, Right (SplicePat rn_splice))
run_pat_splice rn_splice
= do { pat <- runRnSplice UntypedPatSplice runMetaP ppr rn_splice
= do { traceRn (text "rnSplicePat: untyped pattern splice")
; pat <- runRnSplice UntypedPatSplice runMetaP ppr rn_splice
; return (Left (ParPat pat), emptyFVs) }
-- Wrap the result of the quasi-quoter in parens so that we don't
-- lose the outermost location set by runQuasiQuote (#7918)
......@@ -515,8 +533,9 @@ rnSpliceDecl (SpliceDecl (L loc splice) flg)
rnTopSpliceDecls :: HsSplice RdrName -> RnM ([LHsDecl RdrName], FreeVars)
-- Declaration splice at the very top level of the module
rnTopSpliceDecls splice
= do { (rn_splice, fvs) <- setStage (Splice False) $
= do { (rn_splice, fvs) <- setStage (Splice Untyped) $
rnSplice splice
; traceRn (text "rnTopSpliceDecls: untyped declaration splice")
; decls <- runRnSplice UntypedDeclSplice runMetaD ppr_decls rn_splice
; return (decls,fvs) }
where
......@@ -538,8 +557,10 @@ 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
are bound within the splice, so pattern splices within brackets aren't
all that useful.
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.
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
......
......@@ -868,7 +868,7 @@ mkOpAppRn e1 op fix e2 -- Default case, no rearrangment
----------------------------
get_op :: LHsExpr Name -> Name
-- An unbound name could be either HsVar or HsUnboundVra
-- An unbound name could be either HsVar or HsUnboundVar
-- See RnExpr.rnUnboundVar
get_op (L _ (HsVar n)) = n
get_op (L _ (HsUnboundVar occ)) = mkUnboundName (mkRdrUnqual occ)
......
......@@ -1089,9 +1089,9 @@ rnTopSrcDecls :: HsGroup RdrName -> TcM (TcGblEnv, HsGroup Name)
-- Fails if there are any errors
rnTopSrcDecls group
= do { -- Rename the source decls
traceTc "rn12" empty ;
traceRn (text "rn12") ;
(tcg_env, rn_decls) <- checkNoErrs $ rnSrcDecls group ;
traceTc "rn13" empty ;
traceRn (text "rn13") ;
-- save the renamed syntax, if we want it
let { tcg_env'
......
......@@ -47,7 +47,8 @@ module TcRnTypes(
DsMetaEnv, DsMetaVal(..),
-- Template Haskell
ThStage(..), PendingStuff(..), topStage, topAnnStage, topSpliceStage,
ThStage(..), SpliceType(..), PendingStuff(..),
topStage, topAnnStage, topSpliceStage,
ThLevel, impLevel, outerLevel, thLevel,
-- Arrows
......@@ -734,12 +735,13 @@ instance Outputable TcIdBinder where
-- Template Haskell stages and levels
---------------------------
data SpliceType = Typed | Untyped
data ThStage -- See Note [Template Haskell state diagram] in TcSplice
= Splice -- Inside a top-level splice splice
-- This code will be run *at compile time*;
-- the result replaces the splice
-- Binding level = 0
Bool -- True if in a typed splice, False otherwise
= Splice SpliceType -- Inside a top-level splice
-- This code will be run *at compile time*;
-- the result replaces the splice
-- Binding level = 0
| Comp -- Ordinary Haskell code
-- Binding level = 1
......@@ -760,8 +762,8 @@ data PendingStuff
topStage, topAnnStage, topSpliceStage :: ThStage
topStage = Comp
topAnnStage = Splice False
topSpliceStage = Splice False
topAnnStage = Splice Untyped
topSpliceStage = Splice Untyped
instance Outputable ThStage where
ppr (Splice _) = text "Splice"
......
......@@ -452,7 +452,7 @@ tcTopSplice expr res_ty
= do { -- Typecheck the expression,
-- making sure it has type Q (T res_ty)
meta_exp_ty <- tcTExpTy res_ty
; zonked_q_expr <- tcTopSpliceExpr True $
; zonked_q_expr <- tcTopSpliceExpr Typed $
tcMonoExpr expr meta_exp_ty
-- Run the expression
......@@ -490,7 +490,7 @@ spliceResultDoc expr
, ptext (sLit "To see what the splice expanded to, use -ddump-splices")]
-------------------
tcTopSpliceExpr :: Bool -> TcM (LHsExpr Id) -> TcM (LHsExpr Id)
tcTopSpliceExpr :: SpliceType -> TcM (LHsExpr Id) -> TcM (LHsExpr Id)
-- Note [How top-level splices are handled]
-- Type check an expression that is the body of a top-level splice
-- (the caller will compile and run it)
......@@ -536,7 +536,7 @@ runAnnotation target expr = do
-- Check the instances we require live in another module (we want to execute it..)
-- and check identifiers live in other modules using TH stage checks. tcSimplifyStagedExpr
-- also resolves the LIE constraints to detect e.g. instance ambiguity
zonked_wrapped_expr' <- tcTopSpliceExpr False $
zonked_wrapped_expr' <- tcTopSpliceExpr Untyped $
do { (expr', expr_ty) <- tcInferRhoNC expr
-- We manually wrap the typechecked expression in a call to toAnnotationWrapper
-- By instantiating the call >here< it gets registered in the
......
......@@ -11,6 +11,7 @@ import Annotations ( Annotation, CoreAnnTarget )
#ifdef GHCI
import HsSyn ( LHsType, LPat, LHsDecl )
import RdrName ( RdrName )
import TcRnTypes ( SpliceType )
import qualified Language.Haskell.TH as TH
#endif
......@@ -29,7 +30,7 @@ tcTypedBracket :: HsBracket Name
runAnnotation :: CoreAnnTarget -> LHsExpr Name -> TcM Annotation
#ifdef GHCI
tcTopSpliceExpr :: Bool -> TcM (LHsExpr TcId) -> TcM (LHsExpr TcId)
tcTopSpliceExpr :: SpliceType -> TcM (LHsExpr TcId) -> TcM (LHsExpr TcId)
runMetaE :: LHsExpr TcId -> TcM (LHsExpr RdrName)
runMetaP :: LHsExpr TcId -> TcM (LPat RdrName)
......
......@@ -128,6 +128,10 @@ Template Haskell
- Partial type signatures can now be used in splices, see
:ref:`pts-where`.
- ``Template Haskell`` now fully supports typed holes and quoting unbound
variables. This means it is now possible to use pattern splices nested
inside quotation brackets.
- ``Template Haskell`` now supports the use of ``UInfixT`` in types to
resolve infix operator fixities, in the same vein as ``UInfixP`` and
``UInfixE`` in patterns and expressions. ``ParensT`` and ``InfixT``
......
......@@ -9349,42 +9349,28 @@ on.
This abbreviation makes top-level declaration slices quieter and less
intimidating.
- Outermost pattern splices may bind variables. By "outermost" here, we
refer to a pattern splice that occurs outside of any quotation
brackets. For example,
- Pattern splices introduce variable binders but scoping of variables in
expressions inside the pattern's scope is only checked when a splice is
run. Note that pattern splices that occur outside of any quotation
brackets are run at compile time. Pattern splices occurring inside a
quotation bracket are *not* run at compile time; they are run when the
bracket is spliced in, sometime later. For example,
::
mkPat :: Bool -> Q Pat
mkPat True = [p| (x, y) |]
mkPat False = [p| (y, x) |]
mkPat :: Q Pat
mkPat = [p| (x, y) |]
-- in another module:
foo :: (Char, String) -> String
foo $(mkPat True) = x : y
foo $(mkPat) = x : z
bar :: (String, Char) -> String
bar $(mkPat False) = x : y
bar :: Q Exp
bar = [| \ $(mkPat) -> x : w |]
- Nested pattern splices do *not* bind variables. By "nested" here, we
refer to a pattern splice occurring within a quotation bracket.
Continuing the example from the last bullet:
::
baz :: Bool -> Q Exp
baz b = [| quux $(mkPat b) = x + y |]
would fail with ``x`` and ``y`` being out of scope.
The difference in treatment of outermost and nested pattern splices
is because outermost splices are run at compile time. GHC can then
use the result of running the splice when analysing the expressions
within the pattern's scope. Nested splices, on the other hand, are
*not* run at compile time; they are run when the bracket is spliced
in, sometime later. Since nested pattern splices may refer to local
variables, there is no way for GHC to know, at splice compile time,
what variables are bound, so it binds none.
will fail with ``z`` being out of scope in the definition of ``foo`` but it
will *not* fail with ``w`` being out of scope in the definition of ``bar``.
That will only happen when ``bar`` is spliced.
- A pattern quasiquoter *may* generate binders that scope over the
right-hand side of a definition because these binders are in scope
......
......@@ -300,6 +300,9 @@ fieldExp s e = do { e' <- e; return (s,e') }
staticE :: ExpQ -> ExpQ
staticE = fmap StaticE
unboundVarE :: Name -> ExpQ
unboundVarE s = return (UnboundVarE s)
-- ** 'arithSeqE' Shortcuts
fromE :: ExpQ -> ExpQ
fromE x = do { a <- x; return (ArithSeqE (FromR a)) }
......
......@@ -172,6 +172,7 @@ pprExp _ (RecConE nm fs) = ppr nm <> braces (pprFields fs)
pprExp _ (RecUpdE e fs) = pprExp appPrec e <> braces (pprFields fs)
pprExp i (StaticE e) = parensIf (i >= appPrec) $
text "static"<+> pprExp appPrec e
pprExp _ (UnboundVarE v) = pprName' Applied v
pprFields :: [(Name,Exp)] -> Doc
pprFields = sep . punctuate comma . map (\(s,e) -> ppr s <+> equals <+> ppr e)
......
......@@ -1032,6 +1032,9 @@ mkNameG :: NameSpace -> String -> String -> String -> Name
mkNameG ns pkg modu occ
= Name (mkOccName occ) (NameG ns (mkPkgName pkg) (mkModName modu))
mkNameS :: String -> Name
mkNameS n = Name (mkOccName n) NameS
mkNameG_v, mkNameG_tc, mkNameG_d :: String -> String -> String -> Name
mkNameG_v = mkNameG VarName
mkNameG_tc = mkNameG TcClsName
......@@ -1415,6 +1418,7 @@ data Exp
| RecConE Name [FieldExp] -- ^ @{ T { x = y, z = w } }@
| RecUpdE Exp [FieldExp] -- ^ @{ (f x) { z = w } }@
| StaticE Exp -- ^ @{ static e }@
| UnboundVarE Name -- ^ @{ _x }@ (hole)
deriving( Show, Eq, Ord, Data, Typeable, Generic )
type FieldExp = (Name,Exp)
......
{-# LANGUAGE TemplateHaskell #-}
module T10267 where
import Language.Haskell.TH
import T10267a
[d| i :: a -> a
i = _foo
j :: a -> a
j x = _ |]
$(return [
SigD (mkName "k")
(ForallT [PlainTV (mkName "a")]
[]
(AppT (AppT ArrowT (VarT (mkName "a"))) (VarT (mkName "a"))))
, FunD (mkName "k")
[Clause [] (NormalB (UnboundVarE (mkName "_foo"))) []]
])
$(return [
SigD (mkName "l")
(ForallT [PlainTV (mkName "a")]
[]
(AppT (AppT ArrowT (VarT (mkName "a"))) (VarT (mkName "a"))))
, FunD (mkName "l")
[Clause [VarP (mkName "x")] (NormalB (UnboundVarE (mkName "_"))) []]
])
foo :: a -> a
foo x = $varX
T10267.hs:8:1: error:
Found hole: _ :: a0
Where: ‘a0’ is a rigid type variable bound by
the type signature for:
j :: a0 -> a0
at T10267.hs:8:1
Relevant bindings include
x :: a0 (bound at T10267.hs:8:1)
j :: a0 -> a0 (bound at T10267.hs:8:1)
In the expression: _
In an equation for ‘j’: j x = _
T10267.hs:8:1: error:
Found hole: _foo :: a0 -> a0
Where: ‘a0’ is a rigid type variable bound by
the type signature for:
i :: a0 -> a0
at T10267.hs:8:1
Or perhaps ‘_foo’ is mis-spelled, or not in scope
Relevant bindings include i :: a0 -> a0 (bound at T10267.hs:8:1)
In the expression: _foo
In an equation for ‘i’: i = _foo
T10267.hs:14:3: error:
Found hole: _foo :: a -> a
Where: ‘a’ is a rigid type variable bound by
the type signature for:
k :: a -> a
at T10267.hs:14:3
Or perhaps ‘_foo’ is mis-spelled, or not in scope
Relevant bindings include k :: a -> a (bound at T10267.hs:14:3)
In the expression: _foo
In an equation for ‘k’: k = _foo
T10267.hs:23:3: error:
Found hole: _ :: a
Where: ‘a’ is a rigid type variable bound by
the type signature for:
l :: a -> a
at T10267.hs:23:3