Commit f46360ed authored by Simon Peyton Jones's avatar Simon Peyton Jones

Refactor the handling of quasi-quotes

As Trac #10047 points out, a quasi-quotation [n|...blah...|] is supposed
to behave exactly like $(n "...blah...").  But it doesn't!  This was outright
wrong: quasiquotes were being run even inside brackets.

Now that TH supports both typed and untyped splices, a quasi-quote is properly
regarded as a particular syntax for an untyped splice. But apart from that
they should be treated the same.  So this patch refactors the handling of
quasiquotes to do just that.

The changes touch quite a lot of files, but mostly in a routine way.
The biggest changes by far are in RnSplice, and more minor changes in
TcSplice.  These are the places where there was real work to be done.
Everything else is routine knock-on changes.

* No more QuasiQuote forms in declarations, expressions, types, etc.
  So we get rid of these data constructors
    * HsBinds.QuasiQuoteD
    * HsExpr.HsSpliceE
    * HsPat.QuasiQuotePat
    * HsType.HsQuasiQuoteTy

* We get rid of the HsQuasiQuote type altogether

* Instead, we augment the HsExpr.HsSplice type to have three
  consructors, for the three types of splice:
    * HsTypedSplice
    * HsUntypedSplice
    * HsQuasiQuote
  There are some related changes in the data types in HsExpr near HsSplice.
  Specifically: PendingRnSplice, PendingTcSplice, UntypedSpliceFlavour.

* In Hooks, we combine rnQuasiQuoteHook and rnRnSpliceHook into one.
  A smaller, clearer interface.

* We have to update the Haddock submodule, to accommodate the hsSyn changes
parent 78833ca6
......@@ -153,7 +153,6 @@ untidy b (L loc p) = L loc (untidy' b p)
untidy' _ (ConPatOut {}) = panic "Check.untidy: ConPatOut"
untidy' _ (ViewPat {}) = panic "Check.untidy: ViewPat"
untidy' _ (SplicePat {}) = panic "Check.untidy: SplicePat"
untidy' _ (QuasiQuotePat {}) = panic "Check.untidy: QuasiQuotePat"
untidy' _ (NPat {}) = panic "Check.untidy: NPat"
untidy' _ (NPlusKPat {}) = panic "Check.untidy: NPlusKPat"
untidy' _ (SigPatOut {}) = panic "Check.untidy: SigPatOut"
......@@ -732,7 +731,6 @@ tidy_pat (LitPat lit) = tidy_lit_pat lit
tidy_pat (ConPatIn {}) = panic "Check.tidy_pat: ConPatIn"
tidy_pat (SplicePat {}) = panic "Check.tidy_pat: SplicePat"
tidy_pat (QuasiQuotePat {}) = panic "Check.tidy_pat: QuasiQuotePat"
tidy_pat (SigPatIn {}) = panic "Check.tidy_pat: SigPatIn"
tidy_lit_pat :: HsLit -> Pat Id
......
......@@ -1150,7 +1150,6 @@ collectl (L _ pat) bndrs
go (CoPat _ pat _) = collectl (noLoc pat) bndrs
go (ViewPat _ pat _) = collectl pat bndrs
go p@(SplicePat {}) = pprPanic "collectl/go" (ppr p)
go p@(QuasiQuotePat {}) = pprPanic "collectl/go" (ppr p)
collectEvBinders :: TcEvBinds -> [Id]
collectEvBinders (EvBinds bs) = foldrBag add_ev_bndr [] bs
......
......@@ -650,7 +650,7 @@ dsExpr (HsTcBracketOut x ps) = dsBracket x ps
#else
dsExpr (HsTcBracketOut _ _) = panic "dsExpr HsBracketOut"
#endif
dsExpr (HsSpliceE _ s) = pprPanic "dsExpr:splice" (ppr s)
dsExpr (HsSpliceE s) = pprPanic "dsExpr:splice" (ppr s)
-- Arrow notation extension
dsExpr (HsProc pat cmd) = dsProcExpr pat cmd
......@@ -683,7 +683,6 @@ dsExpr (HsTickPragma _ _ expr) = do
-- HsSyn constructs that just shouldn't be here:
dsExpr (ExprWithTySig {}) = panic "dsExpr:ExprWithTySig"
dsExpr (HsBracket {}) = panic "dsExpr:HsBracket"
dsExpr (HsQuasiQuoteE {}) = panic "dsExpr:HsQuasiQuoteE"
dsExpr (HsArrApp {}) = panic "dsExpr:HsArrApp"
dsExpr (HsArrForm {}) = panic "dsExpr:HsArrForm"
dsExpr (EWildPat {}) = panic "dsExpr:EWildPat"
......
......@@ -78,7 +78,7 @@ dsBracket :: HsBracket Name -> [PendingTcSplice] -> DsM CoreExpr
dsBracket brack splices
= dsExtendMetaEnv new_bit (do_brack brack)
where
new_bit = mkNameEnv [(n, DsSplice (unLoc e)) | PendSplice n e <- splices]
new_bit = mkNameEnv [(n, DsSplice (unLoc e)) | PendingTcSplice n e <- splices]
do_brack (VarBr _ n) = do { MkC e1 <- lookupOcc n ; return e1 }
do_brack (ExpBr e) = do { MkC e1 <- repLE e ; return e1 }
......@@ -970,12 +970,17 @@ repRole (L _ Nothing) = rep2 inferRName []
repSplice :: HsSplice Name -> DsM (Core a)
-- See Note [How brackets and nested splices are handled] in TcSplice
-- We return a CoreExpr of any old type; the context should know
repSplice (HsSplice n _)
= do { mb_val <- dsLookupMetaEnv n
repSplice (HsTypedSplice n _) = rep_splice n
repSplice (HsUntypedSplice n _) = rep_splice n
repSplice (HsQuasiQuote n _ _ _) = rep_splice n
rep_splice :: Name -> DsM (Core a)
rep_splice splice_name
= do { mb_val <- dsLookupMetaEnv splice_name
; case mb_val of
Just (DsSplice e) -> do { e' <- dsExpr e
; return (MkC e') }
_ -> pprPanic "HsSplice" (ppr n) }
_ -> pprPanic "HsSplice" (ppr splice_name) }
-- Should not happen; statically checked
-----------------------------------------------------------------------------
......@@ -1094,7 +1099,7 @@ repE (ArithSeq _ _ aseq) =
ds3 <- repLE e3
repFromThenTo ds1 ds2 ds3
repE (HsSpliceE _ splice) = repSplice splice
repE (HsSpliceE splice) = repSplice splice
repE (HsStatic e) = repLE e >>= rep2 staticEName . (:[]) . unC
repE e@(PArrSeq {}) = notHandled "Parallel arrays" (ppr e)
repE e@(HsCoreAnn {}) = notHandled "Core annotations" (ppr e)
......
......@@ -79,7 +79,7 @@ module HsDecls (
) where
-- friends:
import {-# SOURCE #-} HsExpr( LHsExpr, HsExpr, HsSplice, pprExpr, pprUntypedSplice )
import {-# SOURCE #-} HsExpr( LHsExpr, HsExpr, HsSplice, pprExpr, pprSplice )
-- Because Expr imports Decls via HsBracket
import HsBinds
......@@ -139,9 +139,8 @@ data HsDecl id
| AnnD (AnnDecl id)
| RuleD (RuleDecls id)
| VectD (VectDecl id)
| SpliceD (SpliceDecl id)
| SpliceD (SpliceDecl id) -- Includes quasi-quotes
| DocD (DocDecl)
| QuasiQuoteD (HsQuasiQuote id)
| RoleAnnotD (RoleAnnotDecl id)
deriving (Typeable)
deriving instance (DataId id) => Data (HsDecl id)
......@@ -265,7 +264,6 @@ instance OutputableBndr name => Outputable (HsDecl name) where
ppr (AnnD ad) = ppr ad
ppr (SpliceD dd) = ppr dd
ppr (DocD doc) = ppr doc
ppr (QuasiQuoteD qq) = ppr qq
ppr (RoleAnnotD ra) = ppr ra
instance OutputableBndr name => Outputable (HsGroup name) where
......@@ -316,7 +314,7 @@ data SpliceDecl id
deriving instance (DataId id) => Data (SpliceDecl id)
instance OutputableBndr name => Outputable (SpliceDecl name) where
ppr (SpliceDecl (L _ e) _) = pprUntypedSplice e
ppr (SpliceDecl (L _ e) _) = pprSplice e
{-
************************************************************************
......
......@@ -381,11 +381,7 @@ data HsExpr id
-- 'ApiAnnotation.AnnClose'
-- For details on above see note [Api annotations] in ApiAnnotation
| HsSpliceE Bool -- True <=> typed splice
(HsSplice id) -- False <=> untyped
| HsQuasiQuoteE (HsQuasiQuote id)
-- See Note [Quasi-quote overview] in TcSplice
| HsSpliceE (HsSplice id)
-----------------------------------------------------------
-- Arrow notation extension
......@@ -720,13 +716,12 @@ ppr_expr (HsSCC _ lbl expr)
ppr_expr (HsWrap co_fn e) = pprHsWrapper (pprExpr e) co_fn
ppr_expr (HsType id) = ppr id
ppr_expr (HsSpliceE t s) = pprSplice t s
ppr_expr (HsSpliceE s) = pprSplice s
ppr_expr (HsBracket b) = pprHsBracket b
ppr_expr (HsRnBracketOut e []) = ppr e
ppr_expr (HsRnBracketOut e ps) = ppr e $$ ptext (sLit "pending(rn)") <+> ppr ps
ppr_expr (HsTcBracketOut e []) = ppr e
ppr_expr (HsTcBracketOut e ps) = ppr e $$ ptext (sLit "pending(tc)") <+> ppr ps
ppr_expr (HsQuasiQuoteE qq) = ppr qq
ppr_expr (HsProc pat (L _ (HsCmdTop cmd _ _ _)))
= hsep [ptext (sLit "proc"), ppr pat, ptext (sLit "->"), ppr cmd]
......@@ -1592,31 +1587,45 @@ pprQuals quals = interpp'SP quals
-}
data HsSplice id
= HsSplice -- $z or $(f 4)
= HsTypedSplice -- $z or $(f 4)
id -- A unique name to identify this splice point
(LHsExpr id) -- See Note [Pending Splices]
| HsUntypedSplice -- $z or $(f 4)
id -- A unique name to identify this splice point
(LHsExpr id) -- See Note [Pending Splices]
| HsQuasiQuote -- See Note [Quasi-quote overview] in TcSplice
id -- Splice point
id -- Quoter
SrcSpan -- The span of the enclosed string
FastString -- The enclosed string
deriving (Typeable )
deriving instance (DataId id) => Data (HsSplice id)
isTypedSplice :: HsSplice id -> Bool
isTypedSplice (HsTypedSplice {}) = True
isTypedSplice _ = False -- Quasi-quotes are untyped splices
-- See Note [Pending Splices]
data PendingSplice id
= PendSplice Name (LHsExpr id)
deriving( Typeable )
-- It'd be convenient to re-use HsSplice, but the splice-name
-- really is a Name, never an Id. Using (PostRn id Name) is
-- nearly OK, but annoyingly we can't pretty-print it.
type SplicePointName = Name
data PendingRnSplice
= PendingRnExpSplice (PendingSplice Name)
| PendingRnPatSplice (PendingSplice Name)
| PendingRnTypeSplice (PendingSplice Name)
| PendingRnDeclSplice (PendingSplice Name)
| PendingRnCrossStageSplice Name
= PendingRnSplice UntypedSpliceFlavour SplicePointName (LHsExpr Name)
deriving (Data, Typeable)
type PendingTcSplice = PendingSplice Id
data UntypedSpliceFlavour
= UntypedExpSplice
| UntypedPatSplice
| UntypedTypeSplice
| UntypedDeclSplice
deriving( Data, Typeable )
data PendingTcSplice
= PendingTcSplice SplicePointName (LHsExpr Id)
deriving( Data, Typeable )
deriving instance (DataId id) => Data (HsSplice id)
deriving instance (DataId id) => Data (PendingSplice id)
{-
Note [Pending Splices]
......@@ -1633,9 +1642,9 @@ looks like
which the renamer rewrites to
HsRnBracketOut (HsApp (HsVar f) (HsSpliceE sn (g x)))
[PendingRnExpSplice (HsSplice sn (g x))]
[PendingRnSplice UntypedExpSplice sn (g x)]
* The 'sn' is the Name of the splice point.
* The 'sn' is the Name of the splice point, the SplicePointName
* The PendingRnExpSplice gives the splice that splice-point name maps to;
and the typechecker can now conveniently find these sub-expressions
......@@ -1644,30 +1653,35 @@ which the renamer rewrites to
in the renamed first arg of HsRnBracketOut
is used only for pretty printing
There are four varieties of pending splices generated by the renamer:
* Pending expression splices (PendingRnExpSplice), e.g.,
There are four varieties of pending splices generated by the renamer,
distinguished by their UntypedSpliceFlavour
[|$(f x) + 2|]
* Pending expression splices (UntypedExpSplice), e.g.,
[|$(f x) + 2|]
* Pending pattern splices (PendingRnPatSplice), e.g.,
UntypedExpSplice is also used for
* quasi-quotes, where the pending expression expands to
$(quoter "...blah...")
(see RnSplice.makePending, HsQuasiQuote case)
[|\ $(f x) -> x|]
* cross-stage lifting, where the pending expression expands to
$(lift x)
(see RnSplice.checkCrossStageLifting)
* Pending type splices (PendingRnTypeSplice), e.g.,
* Pending pattern splices (UntypedPatSplice), e.g.,
[| \$(f x) -> x |]
[|f :: $(g x)|]
* Pending type splices (UntypedTypeSplice), e.g.,
[| f :: $(g x) |]
* Pending cross-stage splices (PendingRnCrossStageSplice), e.g.,
\x -> [| x |]
* Pending declaration (UntypedDeclSplice), e.g.,
[| let $(f x) in ... |]
There is a fifth variety of pending splice, which is generated by the type
checker:
* Pending *typed* expression splices, (PendingTcSplice), e.g.,
[||1 + $$(f 2)||]
[||1 + $$(f 2)||]
It would be possible to eliminate HsRnBracketOut and use HsBracketOut for the
output of the renamer. However, when pretty printing the output of the renamer,
......@@ -1678,21 +1692,24 @@ sense, although I hate to add another constructor to HsExpr.
-}
instance OutputableBndr id => Outputable (HsSplice id) where
ppr (HsSplice n e) = angleBrackets (ppr n <> comma <+> ppr e)
ppr s = pprSplice s
instance OutputableBndr id => Outputable (PendingSplice id) where
ppr (PendSplice n e) = angleBrackets (ppr n <> comma <+> ppr e)
pprPendingSplice :: OutputableBndr id => SplicePointName -> LHsExpr id -> SDoc
pprPendingSplice n e = angleBrackets (ppr n <> comma <+> ppr e)
pprUntypedSplice :: OutputableBndr id => HsSplice id -> SDoc
pprUntypedSplice = pprSplice False
pprSplice :: OutputableBndr id => HsSplice id -> SDoc
pprSplice (HsTypedSplice n e) = ppr_splice (ptext (sLit "$$")) n e
pprSplice (HsUntypedSplice n e) = ppr_splice (ptext (sLit "$")) n e
pprSplice (HsQuasiQuote n q _ s) = ppr_quasi n q s
pprTypedSplice :: OutputableBndr id => HsSplice id -> SDoc
pprTypedSplice = pprSplice True
ppr_quasi :: OutputableBndr id => id -> id -> FastString -> SDoc
ppr_quasi n quoter quote = ifPprDebug (brackets (ppr n)) <>
char '[' <> ppr quoter <> ptext (sLit "|") <>
ppr quote <> ptext (sLit "|]")
pprSplice :: OutputableBndr id => Bool -> HsSplice id -> SDoc
pprSplice is_typed (HsSplice n e)
= (if is_typed then ptext (sLit "$$") else char '$')
<> ifPprDebug (brackets (ppr n)) <> eDoc
ppr_splice :: OutputableBndr id => SDoc -> id -> LHsExpr id -> SDoc
ppr_splice herald n e
= herald <> ifPprDebug (brackets (ppr n)) <> eDoc
where
-- We use pprLExpr to match pprParendExpr:
-- Using pprLExpr makes sure that we go 'deeper'
......@@ -1740,11 +1757,10 @@ thTyBrackets :: SDoc -> SDoc
thTyBrackets pp_body = ptext (sLit "[||") <+> pp_body <+> ptext (sLit "||]")
instance Outputable PendingRnSplice where
ppr (PendingRnExpSplice s) = ppr s
ppr (PendingRnPatSplice s) = ppr s
ppr (PendingRnTypeSplice s) = ppr s
ppr (PendingRnDeclSplice s) = ppr s
ppr (PendingRnCrossStageSplice name) = ppr name
ppr (PendingRnSplice _ n e) = pprPendingSplice n e
instance Outputable PendingTcSplice where
ppr (PendingTcSplice n e) = pprPendingSplice n e
{-
************************************************************************
......
......@@ -59,8 +59,7 @@ pprLExpr :: (OutputableBndr i) =>
pprExpr :: (OutputableBndr i) =>
HsExpr i -> SDoc
pprUntypedSplice :: (OutputableBndr i) =>
HsSplice i -> SDoc
pprSplice :: (OutputableBndr i) => HsSplice i -> SDoc
pprPatBind :: (OutputableBndr bndr, OutputableBndr id, Outputable body)
=> LPat bndr -> GRHSs id body -> SDoc
......
......@@ -29,7 +29,7 @@ module HsPat (
pprParendLPat, pprConArgs
) where
import {-# SOURCE #-} HsExpr (SyntaxExpr, LHsExpr, HsSplice, pprLExpr, pprUntypedSplice)
import {-# SOURCE #-} HsExpr (SyntaxExpr, LHsExpr, HsSplice, pprLExpr, pprSplice)
-- friends:
import HsBinds
......@@ -166,11 +166,7 @@ data Pat id
-- 'ApiAnnotation.AnnClose' @')'@
-- For details on above see note [Api annotations] in ApiAnnotation
| SplicePat (HsSplice id)
------------ Quasiquoted patterns ---------------
-- See Note [Quasi-quote overview] in TcSplice
| QuasiQuotePat (HsQuasiQuote id)
| SplicePat (HsSplice id) -- Includes quasi-quotes
------------ Literal and n+k patterns ---------------
| LitPat HsLit -- Used for *non-overloaded* literal patterns:
......@@ -333,8 +329,7 @@ pprPat (LitPat s) = ppr s
pprPat (NPat l Nothing _) = ppr l
pprPat (NPat l (Just _) _) = char '-' <> ppr l
pprPat (NPlusKPat n k _ _) = hcat [ppr n, char '+', ppr k]
pprPat (SplicePat splice) = pprUntypedSplice splice
pprPat (QuasiQuotePat qq) = ppr qq
pprPat (SplicePat splice) = pprSplice splice
pprPat (CoPat co pat _) = pprHsWrapper (ppr pat) co
pprPat (SigPatIn pat ty) = ppr pat <+> dcolon <+> ppr ty
pprPat (SigPatOut pat ty) = ppr pat <+> dcolon <+> ppr ty
......@@ -490,14 +485,12 @@ isIrrefutableHsPat pat
-- Both should be gotten rid of by renamer before
-- isIrrefutablePat is called
go1 (SplicePat {}) = urk pat
go1 (QuasiQuotePat {}) = urk pat
urk pat = pprPanic "isIrrefutableHsPat:" (ppr pat)
hsPatNeedsParens :: Pat a -> Bool
hsPatNeedsParens (NPlusKPat {}) = True
hsPatNeedsParens (SplicePat {}) = False
hsPatNeedsParens (QuasiQuotePat {}) = True
hsPatNeedsParens (ConPatIn _ ds) = conPatNeedsParens ds
hsPatNeedsParens p@(ConPatOut {}) = conPatNeedsParens (pat_args p)
hsPatNeedsParens (SigPatIn {}) = True
......
......@@ -23,7 +23,6 @@ module HsTypes (
HsWithBndrs(..),
HsTupleSort(..), HsExplicitFlag(..),
HsContext, LHsContext,
HsQuasiQuote(..),
HsTyWrapper(..),
HsTyLit(..),
HsIPName(..), hsIPNameFS,
......@@ -49,7 +48,7 @@ module HsTypes (
pprHsContext, pprHsContextNoArrow, pprHsContextMaybe
) where
import {-# SOURCE #-} HsExpr ( HsSplice, pprUntypedSplice )
import {-# SOURCE #-} HsExpr ( HsSplice, pprSplice )
import PlaceHolder ( PostTc,PostRn,DataId,PlaceHolder(..) )
......@@ -69,28 +68,6 @@ import Maybes( isJust )
import Data.Data hiding ( Fixity )
import Data.Maybe ( fromMaybe )
{-
************************************************************************
* *
Quasi quotes; used in types and elsewhere
* *
************************************************************************
-}
data HsQuasiQuote id = HsQuasiQuote
id -- The quasi-quoter
SrcSpan -- The span of the enclosed string
FastString -- The enclosed string
deriving (Data, Typeable)
instance OutputableBndr id => Outputable (HsQuasiQuote id) where
ppr = ppr_qq
ppr_qq :: OutputableBndr id => HsQuasiQuote id -> SDoc
ppr_qq (HsQuasiQuote quoter _ quote) =
char '[' <> ppr quoter <> ptext (sLit "|") <>
ppr quote <> ptext (sLit "|]")
{-
************************************************************************
* *
......@@ -336,12 +313,7 @@ data HsType name
-- For details on above see note [Api annotations] in ApiAnnotation
| HsQuasiQuoteTy (HsQuasiQuote name)
-- ^ - 'ApiAnnotation.AnnKeywordId' : None
-- For details on above see note [Api annotations] in ApiAnnotation
| HsSpliceTy (HsSplice name)
| HsSpliceTy (HsSplice name) -- Includes quasi-quotes
(PostTc name Kind)
-- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'$('@,
-- 'ApiAnnotation.AnnClose' @')'@
......@@ -840,7 +812,6 @@ ppr_mono_ty ctxt_prec (HsForAllTy exp extra tvs ctxt ty)
sep [pprHsForAllExtra exp extra tvs ctxt, ppr_mono_lty TopPrec ty]
ppr_mono_ty _ (HsBangTy b ty) = ppr b <> ppr_mono_lty TyConPrec ty
ppr_mono_ty _ (HsQuasiQuoteTy qq) = ppr qq
ppr_mono_ty _ (HsRecTy flds) = pprConDeclFields flds
ppr_mono_ty _ (HsTyVar name) = pprPrefixOcc name
ppr_mono_ty prec (HsFunTy ty1 ty2) = ppr_fun_ty prec ty1 ty2
......@@ -852,7 +823,7 @@ ppr_mono_ty _ (HsKindSig ty kind) = parens (ppr_mono_lty TopPrec ty <+> dcolo
ppr_mono_ty _ (HsListTy ty) = brackets (ppr_mono_lty TopPrec ty)
ppr_mono_ty _ (HsPArrTy ty) = paBrackets (ppr_mono_lty TopPrec ty)
ppr_mono_ty prec (HsIParamTy n ty) = maybeParen prec FunPrec (ppr n <+> dcolon <+> ppr_mono_lty TopPrec ty)
ppr_mono_ty _ (HsSpliceTy s _) = pprUntypedSplice s
ppr_mono_ty _ (HsSpliceTy s _) = pprSplice s
ppr_mono_ty _ (HsCoreTy ty) = ppr ty
ppr_mono_ty _ (HsExplicitListTy _ tys) = quote $ brackets (interpp'SP tys)
ppr_mono_ty _ (HsExplicitTupleTy _ tys) = quote $ parens (interpp'SP tys)
......
......@@ -53,7 +53,7 @@ module HsUtils(
emptyRecStmt, emptyRecStmtName, emptyRecStmtId, mkRecStmt,
-- Template Haskell
mkHsSpliceTy, mkHsSpliceE, mkHsSpliceTE, mkHsSplice,
mkHsSpliceTy, mkHsSpliceE, mkHsSpliceTE, mkUntypedSplice,
mkHsQuasiQuote, unqualQuasiQuote,
-- Flags
......@@ -281,23 +281,23 @@ mkRecStmt stmts = emptyRecStmt { recS_stmts = stmts }
mkHsOpApp :: LHsExpr id -> id -> LHsExpr id -> HsExpr id
mkHsOpApp e1 op e2 = OpApp e1 (noLoc (HsVar op)) (error "mkOpApp:fixity") e2
mkHsSplice :: LHsExpr RdrName -> HsSplice RdrName
mkHsSplice e = HsSplice unqualSplice e
unqualSplice :: RdrName
unqualSplice = mkRdrUnqual (mkVarOccFS (fsLit "splice"))
mkUntypedSplice :: LHsExpr RdrName -> HsSplice RdrName
mkUntypedSplice e = HsUntypedSplice unqualSplice e
mkHsSpliceE :: LHsExpr RdrName -> HsExpr RdrName
mkHsSpliceE e = HsSpliceE False (mkHsSplice e)
mkHsSpliceE e = HsSpliceE (mkUntypedSplice e)
mkHsSpliceTE :: LHsExpr RdrName -> HsExpr RdrName
mkHsSpliceTE e = HsSpliceE True (mkHsSplice e)
mkHsSpliceTE e = HsSpliceE (HsTypedSplice unqualSplice e)
mkHsSpliceTy :: LHsExpr RdrName -> HsType RdrName
mkHsSpliceTy e = HsSpliceTy (mkHsSplice e) placeHolderKind
mkHsSpliceTy e = HsSpliceTy (HsUntypedSplice unqualSplice e) placeHolderKind
mkHsQuasiQuote :: RdrName -> SrcSpan -> FastString -> HsQuasiQuote RdrName
mkHsQuasiQuote quoter span quote = HsQuasiQuote quoter span quote
mkHsQuasiQuote :: RdrName -> SrcSpan -> FastString -> HsSplice RdrName
mkHsQuasiQuote quoter span quote = HsQuasiQuote unqualSplice quoter span quote
unqualQuasiQuote :: RdrName
unqualQuasiQuote = mkRdrUnqual (mkVarOccFS (fsLit "quasiquote"))
......@@ -705,7 +705,6 @@ collect_lpat (L _ pat) bndrs
go (SigPatIn pat _) = collect_lpat pat bndrs
go (SigPatOut pat _) = collect_lpat pat bndrs
go (SplicePat _) = bndrs
go (QuasiQuotePat _) = bndrs
go (CoPat _ pat _) = go pat
{-
......
......@@ -20,13 +20,11 @@ module Hooks ( Hooks
, runPhaseHook
, runMetaHook
, linkHook
, runQuasiQuoteHook
, runRnSpliceHook
, getValueSafelyHook
) where
import DynFlags
import HsTypes
import Name
import PipelineMonad
import HscTypes
......@@ -58,7 +56,7 @@ import Data.Maybe
-- uses the default built-in behaviour
emptyHooks :: Hooks
emptyHooks = Hooks Nothing Nothing Nothing Nothing Nothing Nothing
emptyHooks = Hooks Nothing Nothing Nothing Nothing Nothing
Nothing Nothing Nothing Nothing Nothing Nothing
Nothing
......@@ -73,8 +71,7 @@ data Hooks = Hooks
, runPhaseHook :: Maybe (PhasePlus -> FilePath -> DynFlags -> CompPipeline (PhasePlus, FilePath))
, runMetaHook :: Maybe (MetaHook TcM)
, linkHook :: Maybe (GhcLink -> DynFlags -> Bool -> HomePackageTable -> IO SuccessFlag)
, runQuasiQuoteHook :: Maybe (HsQuasiQuote Name -> RnM (HsQuasiQuote Name))
, runRnSpliceHook :: Maybe (LHsExpr Name -> RnM (LHsExpr Name))
, runRnSpliceHook :: Maybe (HsSplice Name -> RnM (HsSplice Name))
, getValueSafelyHook :: Maybe (HscEnv -> Name -> Type -> IO (Maybe HValue))
}
......
......@@ -1543,7 +1543,7 @@ atype :: { LHsType RdrName }
| '(' ctype ')' {% ams (sLL $1 $> $ HsParTy $2) [mop $1,mcp $3] }
| '(' ctype '::' kind ')' {% ams (sLL $1 $> $ HsKindSig $2 $4)
[mop $1,mj AnnDcolon $3,mcp $5] }
| quasiquote { sL1 $1 (HsQuasiQuoteTy (unLoc $1)) }
| quasiquote { sL1 $1 (HsSpliceTy (unLoc $1) placeHolderKind) }
| '$(' exp ')' {% ams (sLL $1 $> $ mkHsSpliceTy $2)
[mo $1,mc $3] }
| TH_ID_SPLICE { sLL $1 $> $ mkHsSpliceTy $ sL1 $1 $ HsVar $
......@@ -1958,7 +1958,7 @@ explicit_activation :: { ([AddAnn],Activation) } -- In brackets
-----------------------------------------------------------------------------
-- Expressions
quasiquote :: { Located (HsQuasiQuote RdrName) }
quasiquote :: { Located (HsSplice RdrName) }
: TH_QUASIQUOTE { let { loc = getLoc $1
; ITquasiQuote (quoter, quote, quoteSpan) = unLoc $1
; quoterId = mkUnqual varName quoter }
......@@ -2180,7 +2180,7 @@ aexp2 :: { LHsExpr RdrName }
[mo $1,mc $3] }
| '[d|' cvtopbody '|]' {% ams (sLL $1 $> $ HsBracket (DecBrL (snd $2)))
(mo $1:mc $3:fst $2) }
| quasiquote { sL1 $1 (HsQuasiQuoteE (unLoc $1)) }
| quasiquote { sL1 $1 (HsSpliceE (unLoc $1)) }
-- arrow notation extension
| '(|' aexp2 cmdargs '|)' {% ams (sLL $1 $> $ HsArrForm $2
......
......@@ -376,12 +376,10 @@ mkSpliceDecl :: LHsExpr RdrName -> HsDecl RdrName
-- f x then behave as if she'd written $(f x)
-- ie a SpliceD
mkSpliceDecl lexpr@(L loc expr)
| HsQuasiQuoteE qq <- expr = QuasiQuoteD qq
| HsSpliceE is_typed splice <- expr = ASSERT( not is_typed )
SpliceD (SpliceDecl (L loc splice) ExplicitSplice)
| otherwise = SpliceD (SpliceDecl (L loc splice) ImplicitSplice)
| HsSpliceE splice <- expr = SpliceD (SpliceDecl (L loc splice) ExplicitSplice)
| otherwise = SpliceD (SpliceDecl (L loc splice) ImplicitSplice)
where
splice = mkHsSplice lexpr
splice = mkUntypedSplice lexpr
mkRoleAnnotDecl :: SrcSpan
-> Located RdrName -- type being annotated
......@@ -877,10 +875,9 @@ checkAPat msg loc e0 = do
RecordCon c _ (HsRecFields fs dd)
-> do fs <- mapM (checkPatField msg) fs
return (ConPatIn c (RecCon (HsRecFields fs dd)))
HsSpliceE is_typed s | not is_typed
-> return (SplicePat s)
HsQuasiQuoteE q -> return (QuasiQuotePat q)
_ -> patFail msg loc e0
HsSpliceE s | not (isTypedSplice s)
-> return (SplicePat s)
_ -> patFail msg loc e0
placeHolderPunRhs :: LHsExpr RdrName
-- The RHS of a punned record field will be filled in by the renamer
......
......@@ -18,8 +18,6 @@ module RnExpr (
#include "HsVersions.h"
import {-# SOURCE #-} TcSplice( runQuasiQuoteExpr )
import RnBinds ( rnLocalBindsAndThen, rnLocalValBindsLHS, rnLocalValBindsRHS,
rnMatchGroup, rnGRHS, makeMiniFixityEnv)
import HsSyn
......@@ -153,14 +151,7 @@ rnExpr (NegApp e _)
-- (not with an rnExpr crash) in a stage-1 compiler.
rnExpr e@(HsBracket br_body) = rnBracket e br_body
rnExpr (HsSpliceE is_typed splice) = rnSpliceExpr is_typed splice
rnExpr (HsQuasiQuoteE qq)
= do { lexpr' <- runQuasiQuoteExpr qq
-- Wrap the result of the quasi-quoter in parens so that we don't
-- lose the outermost location set by runQuasiQuote (#7918)
; rnExpr (HsPar lexpr') }
rnExpr (HsSpliceE splice) = rnSpliceExpr splice
---------------------------------------------
-- Sections
......
......@@ -36,7 +36,6 @@ module RnPat (-- main entry points
import {-# SOURCE #-} RnExpr ( rnLExpr )
import {-# SOURCE #-} RnSplice ( rnSplicePat )
import {-# SOURCE #-} TcSplice ( runQuasiQuotePat )
#include "HsVersions.h"
......@@ -453,15 +452,9 @@ rnPatAndThen mk (TuplePat pats boxed _)
rnPatAndThen mk (SplicePat splice)
= do { eith <- liftCpsFV $ rnSplicePat splice
; case eith of -- See Note [rnSplicePat] in RnSplice
Left not_yet_renamed -> rnPatAndThen mk not_yet_renamed
Left not_yet_renamed -> rnPatAndThen mk not_yet_renamed
Right already_renamed -> return already_renamed }
rnPatAndThen mk (QuasiQuotePat qq)
= do { pat <- liftCps $ runQuasiQuotePat qq
-- Wrap the result of the quasi-quoter in parens so that we don't
-- lose the outermost location set by runQuasiQuote (#7918)
; rnPatAndThen mk (ParPat pat) }
rnPatAndThen _ pat = pprPanic "rnLPatAndThen" (ppr pat)
......
......@@ -14,7 +14,6 @@ module RnSource (
import {-# SOURCE #-} RnExpr( rnLExpr )
import {-# SOURCE #-} RnSplice ( rnSpliceDecl )
import {-# SOURCE #-} TcSplice ( runQuasiQuoteDecl )
import HsSyn
import RdrName
......@@ -1514,10 +1513,6 @@ add gp loc (SpliceD splice@(SpliceDecl _ flag)) ds
badImplicitSplice = ptext (sLit "Parse error: naked expression at top level")
$$ ptext (sLit "Perhaps you intended to use TemplateHaskell")
add gp _ (QuasiQuoteD qq) ds -- Expand quasiquotes
= do { ds' <- runQuasiQuoteDecl qq
; addl gp (ds' ++ ds) }
-- Class declarations: pull out the fixity signatures to the top
add gp@(HsGroup {hs_tyclds = ts, hs_fixds = fs}) l (TyClD d) ds
| isClassDecl d
......
......@@ -5,8 +5,12 @@ module RnSplice (
rnSpliceType, rnSpliceExpr, rnSplicePat, rnSpliceDecl,
rnBracket,
checkThLocalName
#ifdef GHCI
, traceSplice, SpliceInfo(..)
#endif
) where
#include "HsVersions.h"
import Name
import NameSet
......@@ -19,19 +23,23 @@ import Kind
import ErrUtils ( dumpIfSet_dyn_printer )
import Control.Monad ( unless, when )
import DynFlags
import DsMeta ( decsQTyConName, expQTyConName, patQTyConName, typeQTyConName )
import DsMeta ( decsQTyConName, expQTyConName, patQTyConName, typeQTyConName, liftName )
import LoadIface ( loadInterfaceForName )
import Module
import RnEnv
import RnPat ( rnPat )
import RnSource ( rnSrcDecls, findSplice )
import RnTypes ( rnLHsType )
import PrelNames ( isUnboundName )