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) ...@@ -153,7 +153,6 @@ untidy b (L loc p) = L loc (untidy' b p)
untidy' _ (ConPatOut {}) = panic "Check.untidy: ConPatOut" untidy' _ (ConPatOut {}) = panic "Check.untidy: ConPatOut"
untidy' _ (ViewPat {}) = panic "Check.untidy: ViewPat" untidy' _ (ViewPat {}) = panic "Check.untidy: ViewPat"
untidy' _ (SplicePat {}) = panic "Check.untidy: SplicePat" untidy' _ (SplicePat {}) = panic "Check.untidy: SplicePat"
untidy' _ (QuasiQuotePat {}) = panic "Check.untidy: QuasiQuotePat"
untidy' _ (NPat {}) = panic "Check.untidy: NPat" untidy' _ (NPat {}) = panic "Check.untidy: NPat"
untidy' _ (NPlusKPat {}) = panic "Check.untidy: NPlusKPat" untidy' _ (NPlusKPat {}) = panic "Check.untidy: NPlusKPat"
untidy' _ (SigPatOut {}) = panic "Check.untidy: SigPatOut" untidy' _ (SigPatOut {}) = panic "Check.untidy: SigPatOut"
...@@ -732,7 +731,6 @@ tidy_pat (LitPat lit) = tidy_lit_pat lit ...@@ -732,7 +731,6 @@ tidy_pat (LitPat lit) = tidy_lit_pat lit
tidy_pat (ConPatIn {}) = panic "Check.tidy_pat: ConPatIn" tidy_pat (ConPatIn {}) = panic "Check.tidy_pat: ConPatIn"
tidy_pat (SplicePat {}) = panic "Check.tidy_pat: SplicePat" 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_pat (SigPatIn {}) = panic "Check.tidy_pat: SigPatIn"
tidy_lit_pat :: HsLit -> Pat Id tidy_lit_pat :: HsLit -> Pat Id
......
...@@ -1150,7 +1150,6 @@ collectl (L _ pat) bndrs ...@@ -1150,7 +1150,6 @@ collectl (L _ pat) bndrs
go (CoPat _ pat _) = collectl (noLoc pat) bndrs go (CoPat _ pat _) = collectl (noLoc pat) bndrs
go (ViewPat _ pat _) = collectl pat bndrs go (ViewPat _ pat _) = collectl pat bndrs
go p@(SplicePat {}) = pprPanic "collectl/go" (ppr p) go p@(SplicePat {}) = pprPanic "collectl/go" (ppr p)
go p@(QuasiQuotePat {}) = pprPanic "collectl/go" (ppr p)
collectEvBinders :: TcEvBinds -> [Id] collectEvBinders :: TcEvBinds -> [Id]
collectEvBinders (EvBinds bs) = foldrBag add_ev_bndr [] bs collectEvBinders (EvBinds bs) = foldrBag add_ev_bndr [] bs
......
...@@ -650,7 +650,7 @@ dsExpr (HsTcBracketOut x ps) = dsBracket x ps ...@@ -650,7 +650,7 @@ dsExpr (HsTcBracketOut x ps) = dsBracket x ps
#else #else
dsExpr (HsTcBracketOut _ _) = panic "dsExpr HsBracketOut" dsExpr (HsTcBracketOut _ _) = panic "dsExpr HsBracketOut"
#endif #endif
dsExpr (HsSpliceE _ s) = pprPanic "dsExpr:splice" (ppr s) dsExpr (HsSpliceE s) = pprPanic "dsExpr:splice" (ppr s)
-- Arrow notation extension -- Arrow notation extension
dsExpr (HsProc pat cmd) = dsProcExpr pat cmd dsExpr (HsProc pat cmd) = dsProcExpr pat cmd
...@@ -683,7 +683,6 @@ dsExpr (HsTickPragma _ _ expr) = do ...@@ -683,7 +683,6 @@ dsExpr (HsTickPragma _ _ expr) = do
-- HsSyn constructs that just shouldn't be here: -- HsSyn constructs that just shouldn't be here:
dsExpr (ExprWithTySig {}) = panic "dsExpr:ExprWithTySig" dsExpr (ExprWithTySig {}) = panic "dsExpr:ExprWithTySig"
dsExpr (HsBracket {}) = panic "dsExpr:HsBracket" dsExpr (HsBracket {}) = panic "dsExpr:HsBracket"
dsExpr (HsQuasiQuoteE {}) = panic "dsExpr:HsQuasiQuoteE"
dsExpr (HsArrApp {}) = panic "dsExpr:HsArrApp" dsExpr (HsArrApp {}) = panic "dsExpr:HsArrApp"
dsExpr (HsArrForm {}) = panic "dsExpr:HsArrForm" dsExpr (HsArrForm {}) = panic "dsExpr:HsArrForm"
dsExpr (EWildPat {}) = panic "dsExpr:EWildPat" dsExpr (EWildPat {}) = panic "dsExpr:EWildPat"
......
...@@ -78,7 +78,7 @@ dsBracket :: HsBracket Name -> [PendingTcSplice] -> DsM CoreExpr ...@@ -78,7 +78,7 @@ dsBracket :: HsBracket Name -> [PendingTcSplice] -> DsM CoreExpr
dsBracket brack splices dsBracket brack splices
= dsExtendMetaEnv new_bit (do_brack brack) = dsExtendMetaEnv new_bit (do_brack brack)
where 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 (VarBr _ n) = do { MkC e1 <- lookupOcc n ; return e1 }
do_brack (ExpBr e) = do { MkC e1 <- repLE e ; return e1 } do_brack (ExpBr e) = do { MkC e1 <- repLE e ; return e1 }
...@@ -970,12 +970,17 @@ repRole (L _ Nothing) = rep2 inferRName [] ...@@ -970,12 +970,17 @@ repRole (L _ Nothing) = rep2 inferRName []
repSplice :: HsSplice Name -> DsM (Core a) repSplice :: HsSplice Name -> DsM (Core a)
-- See Note [How brackets and nested splices are handled] in TcSplice -- See Note [How brackets and nested splices are handled] in TcSplice
-- We return a CoreExpr of any old type; the context should know -- We return a CoreExpr of any old type; the context should know
repSplice (HsSplice n _) repSplice (HsTypedSplice n _) = rep_splice n
= do { mb_val <- dsLookupMetaEnv 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 ; case mb_val of
Just (DsSplice e) -> do { e' <- dsExpr e Just (DsSplice e) -> do { e' <- dsExpr e
; return (MkC e') } ; return (MkC e') }
_ -> pprPanic "HsSplice" (ppr n) } _ -> pprPanic "HsSplice" (ppr splice_name) }
-- Should not happen; statically checked -- Should not happen; statically checked
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
...@@ -1094,7 +1099,7 @@ repE (ArithSeq _ _ aseq) = ...@@ -1094,7 +1099,7 @@ repE (ArithSeq _ _ aseq) =
ds3 <- repLE e3 ds3 <- repLE e3
repFromThenTo ds1 ds2 ds3 repFromThenTo ds1 ds2 ds3
repE (HsSpliceE _ splice) = repSplice splice repE (HsSpliceE splice) = repSplice splice
repE (HsStatic e) = repLE e >>= rep2 staticEName . (:[]) . unC repE (HsStatic e) = repLE e >>= rep2 staticEName . (:[]) . unC
repE e@(PArrSeq {}) = notHandled "Parallel arrays" (ppr e) repE e@(PArrSeq {}) = notHandled "Parallel arrays" (ppr e)
repE e@(HsCoreAnn {}) = notHandled "Core annotations" (ppr e) repE e@(HsCoreAnn {}) = notHandled "Core annotations" (ppr e)
......
...@@ -79,7 +79,7 @@ module HsDecls ( ...@@ -79,7 +79,7 @@ module HsDecls (
) where ) where
-- friends: -- friends:
import {-# SOURCE #-} HsExpr( LHsExpr, HsExpr, HsSplice, pprExpr, pprUntypedSplice ) import {-# SOURCE #-} HsExpr( LHsExpr, HsExpr, HsSplice, pprExpr, pprSplice )
-- Because Expr imports Decls via HsBracket -- Because Expr imports Decls via HsBracket
import HsBinds import HsBinds
...@@ -139,9 +139,8 @@ data HsDecl id ...@@ -139,9 +139,8 @@ data HsDecl id
| AnnD (AnnDecl id) | AnnD (AnnDecl id)
| RuleD (RuleDecls id) | RuleD (RuleDecls id)
| VectD (VectDecl id) | VectD (VectDecl id)
| SpliceD (SpliceDecl id) | SpliceD (SpliceDecl id) -- Includes quasi-quotes
| DocD (DocDecl) | DocD (DocDecl)
| QuasiQuoteD (HsQuasiQuote id)
| RoleAnnotD (RoleAnnotDecl id) | RoleAnnotD (RoleAnnotDecl id)
deriving (Typeable) deriving (Typeable)
deriving instance (DataId id) => Data (HsDecl id) deriving instance (DataId id) => Data (HsDecl id)
...@@ -265,7 +264,6 @@ instance OutputableBndr name => Outputable (HsDecl name) where ...@@ -265,7 +264,6 @@ instance OutputableBndr name => Outputable (HsDecl name) where
ppr (AnnD ad) = ppr ad ppr (AnnD ad) = ppr ad
ppr (SpliceD dd) = ppr dd ppr (SpliceD dd) = ppr dd
ppr (DocD doc) = ppr doc ppr (DocD doc) = ppr doc
ppr (QuasiQuoteD qq) = ppr qq
ppr (RoleAnnotD ra) = ppr ra ppr (RoleAnnotD ra) = ppr ra
instance OutputableBndr name => Outputable (HsGroup name) where instance OutputableBndr name => Outputable (HsGroup name) where
...@@ -316,7 +314,7 @@ data SpliceDecl id ...@@ -316,7 +314,7 @@ data SpliceDecl id
deriving instance (DataId id) => Data (SpliceDecl id) deriving instance (DataId id) => Data (SpliceDecl id)
instance OutputableBndr name => Outputable (SpliceDecl name) where 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 ...@@ -381,11 +381,7 @@ data HsExpr id
-- 'ApiAnnotation.AnnClose' -- 'ApiAnnotation.AnnClose'
-- For details on above see note [Api annotations] in ApiAnnotation -- For details on above see note [Api annotations] in ApiAnnotation
| HsSpliceE Bool -- True <=> typed splice | HsSpliceE (HsSplice id)
(HsSplice id) -- False <=> untyped
| HsQuasiQuoteE (HsQuasiQuote id)
-- See Note [Quasi-quote overview] in TcSplice
----------------------------------------------------------- -----------------------------------------------------------
-- Arrow notation extension -- Arrow notation extension
...@@ -720,13 +716,12 @@ ppr_expr (HsSCC _ lbl expr) ...@@ -720,13 +716,12 @@ ppr_expr (HsSCC _ lbl expr)
ppr_expr (HsWrap co_fn e) = pprHsWrapper (pprExpr e) co_fn ppr_expr (HsWrap co_fn e) = pprHsWrapper (pprExpr e) co_fn
ppr_expr (HsType id) = ppr id 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 (HsBracket b) = pprHsBracket b
ppr_expr (HsRnBracketOut e []) = ppr e ppr_expr (HsRnBracketOut e []) = ppr e
ppr_expr (HsRnBracketOut e ps) = ppr e $$ ptext (sLit "pending(rn)") <+> ppr ps ppr_expr (HsRnBracketOut e ps) = ppr e $$ ptext (sLit "pending(rn)") <+> ppr ps
ppr_expr (HsTcBracketOut e []) = ppr e ppr_expr (HsTcBracketOut e []) = ppr e
ppr_expr (HsTcBracketOut e ps) = ppr e $$ ptext (sLit "pending(tc)") <+> ppr ps 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 _ _ _))) ppr_expr (HsProc pat (L _ (HsCmdTop cmd _ _ _)))
= hsep [ptext (sLit "proc"), ppr pat, ptext (sLit "->"), ppr cmd] = hsep [ptext (sLit "proc"), ppr pat, ptext (sLit "->"), ppr cmd]
...@@ -1592,31 +1587,45 @@ pprQuals quals = interpp'SP quals ...@@ -1592,31 +1587,45 @@ pprQuals quals = interpp'SP quals
-} -}
data HsSplice id 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 id -- A unique name to identify this splice point
(LHsExpr id) -- See Note [Pending Splices] (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 (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] -- See Note [Pending Splices]
data PendingSplice id type SplicePointName = Name
= 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.
data PendingRnSplice data PendingRnSplice
= PendingRnExpSplice (PendingSplice Name) = PendingRnSplice UntypedSpliceFlavour SplicePointName (LHsExpr Name)
| PendingRnPatSplice (PendingSplice Name)
| PendingRnTypeSplice (PendingSplice Name)
| PendingRnDeclSplice (PendingSplice Name)
| PendingRnCrossStageSplice Name
deriving (Data, Typeable) 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] Note [Pending Splices]
...@@ -1633,9 +1642,9 @@ looks like ...@@ -1633,9 +1642,9 @@ looks like
which the renamer rewrites to which the renamer rewrites to
HsRnBracketOut (HsApp (HsVar f) (HsSpliceE sn (g x))) 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; * The PendingRnExpSplice gives the splice that splice-point name maps to;
and the typechecker can now conveniently find these sub-expressions and the typechecker can now conveniently find these sub-expressions
...@@ -1644,30 +1653,35 @@ which the renamer rewrites to ...@@ -1644,30 +1653,35 @@ which the renamer rewrites to
in the renamed first arg of HsRnBracketOut in the renamed first arg of HsRnBracketOut
is used only for pretty printing is used only for pretty printing
There are four varieties of pending splices generated by the renamer: There are four varieties of pending splices generated by the renamer,
distinguished by their UntypedSpliceFlavour
* Pending expression splices (PendingRnExpSplice), e.g.,
[|$(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., * Pending declaration (UntypedDeclSplice), e.g.,
[| let $(f x) in ... |]
\x -> [| x |]
There is a fifth variety of pending splice, which is generated by the type There is a fifth variety of pending splice, which is generated by the type
checker: checker:
* Pending *typed* expression splices, (PendingTcSplice), e.g., * 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 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, 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. ...@@ -1678,21 +1692,24 @@ sense, although I hate to add another constructor to HsExpr.
-} -}
instance OutputableBndr id => Outputable (HsSplice id) where 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 pprPendingSplice :: OutputableBndr id => SplicePointName -> LHsExpr id -> SDoc
ppr (PendSplice n e) = angleBrackets (ppr n <> comma <+> ppr e) pprPendingSplice n e = angleBrackets (ppr n <> comma <+> ppr e)
pprUntypedSplice :: OutputableBndr id => HsSplice id -> SDoc pprSplice :: OutputableBndr id => HsSplice id -> SDoc
pprUntypedSplice = pprSplice False 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 ppr_quasi :: OutputableBndr id => id -> id -> FastString -> SDoc
pprTypedSplice = pprSplice True 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 ppr_splice :: OutputableBndr id => SDoc -> id -> LHsExpr id -> SDoc
pprSplice is_typed (HsSplice n e) ppr_splice herald n e
= (if is_typed then ptext (sLit "$$") else char '$') = herald <> ifPprDebug (brackets (ppr n)) <> eDoc
<> ifPprDebug (brackets (ppr n)) <> eDoc
where where
-- We use pprLExpr to match pprParendExpr: -- We use pprLExpr to match pprParendExpr:
-- Using pprLExpr makes sure that we go 'deeper' -- Using pprLExpr makes sure that we go 'deeper'
...@@ -1740,11 +1757,10 @@ thTyBrackets :: SDoc -> SDoc ...@@ -1740,11 +1757,10 @@ thTyBrackets :: SDoc -> SDoc
thTyBrackets pp_body = ptext (sLit "[||") <+> pp_body <+> ptext (sLit "||]") thTyBrackets pp_body = ptext (sLit "[||") <+> pp_body <+> ptext (sLit "||]")
instance Outputable PendingRnSplice where instance Outputable PendingRnSplice where
ppr (PendingRnExpSplice s) = ppr s ppr (PendingRnSplice _ n e) = pprPendingSplice n e
ppr (PendingRnPatSplice s) = ppr s
ppr (PendingRnTypeSplice s) = ppr s instance Outputable PendingTcSplice where
ppr (PendingRnDeclSplice s) = ppr s ppr (PendingTcSplice n e) = pprPendingSplice n e
ppr (PendingRnCrossStageSplice name) = ppr name
{- {-
************************************************************************ ************************************************************************
......
...@@ -59,8 +59,7 @@ pprLExpr :: (OutputableBndr i) => ...@@ -59,8 +59,7 @@ pprLExpr :: (OutputableBndr i) =>
pprExpr :: (OutputableBndr i) => pprExpr :: (OutputableBndr i) =>
HsExpr i -> SDoc HsExpr i -> SDoc
pprUntypedSplice :: (OutputableBndr i) => pprSplice :: (OutputableBndr i) => HsSplice i -> SDoc
HsSplice i -> SDoc
pprPatBind :: (OutputableBndr bndr, OutputableBndr id, Outputable body) pprPatBind :: (OutputableBndr bndr, OutputableBndr id, Outputable body)
=> LPat bndr -> GRHSs id body -> SDoc => LPat bndr -> GRHSs id body -> SDoc
......
...@@ -29,7 +29,7 @@ module HsPat ( ...@@ -29,7 +29,7 @@ module HsPat (
pprParendLPat, pprConArgs pprParendLPat, pprConArgs
) where ) where
import {-# SOURCE #-} HsExpr (SyntaxExpr, LHsExpr, HsSplice, pprLExpr, pprUntypedSplice) import {-# SOURCE #-} HsExpr (SyntaxExpr, LHsExpr, HsSplice, pprLExpr, pprSplice)
-- friends: -- friends:
import HsBinds import HsBinds
...@@ -166,11 +166,7 @@ data Pat id ...@@ -166,11 +166,7 @@ data Pat id
-- 'ApiAnnotation.AnnClose' @')'@ -- 'ApiAnnotation.AnnClose' @')'@
-- For details on above see note [Api annotations] in ApiAnnotation -- For details on above see note [Api annotations] in ApiAnnotation
| SplicePat (HsSplice id) | SplicePat (HsSplice id) -- Includes quasi-quotes
------------ Quasiquoted patterns ---------------
-- See Note [Quasi-quote overview] in TcSplice
| QuasiQuotePat (HsQuasiQuote id)
------------ Literal and n+k patterns --------------- ------------ Literal and n+k patterns ---------------
| LitPat HsLit -- Used for *non-overloaded* literal patterns: | LitPat HsLit -- Used for *non-overloaded* literal patterns:
...@@ -333,8 +329,7 @@ pprPat (LitPat s) = ppr s ...@@ -333,8 +329,7 @@ pprPat (LitPat s) = ppr s
pprPat (NPat l Nothing _) = ppr l pprPat (NPat l Nothing _) = ppr l
pprPat (NPat l (Just _) _) = char '-' <> ppr l pprPat (NPat l (Just _) _) = char '-' <> ppr l
pprPat (NPlusKPat n k _ _) = hcat [ppr n, char '+', ppr k] pprPat (NPlusKPat n k _ _) = hcat [ppr n, char '+', ppr k]
pprPat (SplicePat splice) = pprUntypedSplice splice pprPat (SplicePat splice) = pprSplice splice
pprPat (QuasiQuotePat qq) = ppr qq
pprPat (CoPat co pat _) = pprHsWrapper (ppr pat) co pprPat (CoPat co pat _) = pprHsWrapper (ppr pat) co
pprPat (SigPatIn pat ty) = ppr pat <+> dcolon <+> ppr ty pprPat (SigPatIn pat ty) = ppr pat <+> dcolon <+> ppr ty
pprPat (SigPatOut pat ty) = ppr pat <+> dcolon <+> ppr ty pprPat (SigPatOut pat ty) = ppr pat <+> dcolon <+> ppr ty
...@@ -490,14 +485,12 @@ isIrrefutableHsPat pat ...@@ -490,14 +485,12 @@ isIrrefutableHsPat pat
-- Both should be gotten rid of by renamer before -- Both should be gotten rid of by renamer before
-- isIrrefutablePat is called -- isIrrefutablePat is called
go1 (SplicePat {}) = urk pat go1 (SplicePat {}) = urk pat
go1 (QuasiQuotePat {}) = urk pat
urk pat = pprPanic "isIrrefutableHsPat:" (ppr pat) urk pat = pprPanic "isIrrefutableHsPat:" (ppr pat)
hsPatNeedsParens :: Pat a -> Bool hsPatNeedsParens :: Pat a -> Bool
hsPatNeedsParens (NPlusKPat {}) = True hsPatNeedsParens (NPlusKPat {}) = True
hsPatNeedsParens (SplicePat {}) = False hsPatNeedsParens (SplicePat {}) = False
hsPatNeedsParens (QuasiQuotePat {}) = True
hsPatNeedsParens (ConPatIn _ ds) = conPatNeedsParens ds hsPatNeedsParens (ConPatIn _ ds) = conPatNeedsParens ds
hsPatNeedsParens p@(ConPatOut {}) = conPatNeedsParens (pat_args p) hsPatNeedsParens p@(ConPatOut {}) = conPatNeedsParens (pat_args p)
hsPatNeedsParens (SigPatIn {}) = True hsPatNeedsParens (SigPatIn {}) = True
......
...@@ -23,7 +23,6 @@ module HsTypes ( ...@@ -23,7 +23,6 @@ module HsTypes (
HsWithBndrs(..), HsWithBndrs(..),
HsTupleSort(..), HsExplicitFlag(..), HsTupleSort(..), HsExplicitFlag(..),
HsContext, LHsContext, HsContext, LHsContext,
HsQuasiQuote(..),
HsTyWrapper(..), HsTyWrapper(..),
HsTyLit(..), HsTyLit(..),
HsIPName(..), hsIPNameFS, HsIPName(..), hsIPNameFS,
...@@ -49,7 +48,7 @@ module HsTypes ( ...@@ -49,7 +48,7 @@ module HsTypes (
pprHsContext, pprHsContextNoArrow, pprHsContextMaybe pprHsContext, pprHsContextNoArrow, pprHsContextMaybe
) where ) where
import {-# SOURCE #-} HsExpr ( HsSplice, pprUntypedSplice ) import {-# SOURCE #-} HsExpr ( HsSplice, pprSplice )
import PlaceHolder ( PostTc,PostRn,DataId,PlaceHolder(..) ) import PlaceHolder ( PostTc,PostRn,DataId,PlaceHolder(..) )
...@@ -69,28 +68,6 @@ import Maybes( isJust ) ...@@ -69,28 +68,6 @@ import Maybes( isJust )
import Data.Data hiding ( Fixity ) import Data.Data hiding ( Fixity )
import Data.Maybe ( fromMaybe ) 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 ...@@ -336,12 +313,7 @@ data HsType name
-- For details on above see note [Api annotations] in ApiAnnotation -- For details on above see note [Api annotations] in ApiAnnotation
| HsQuasiQuoteTy (HsQuasiQuote name) | HsSpliceTy (HsSplice name) -- Includes quasi-quotes
-- ^ - 'ApiAnnotation.AnnKeywordId' : None
-- For details on above see note [Api annotations] in ApiAnnotation
| HsSpliceTy (HsSplice name)
(PostTc name Kind) (PostTc name Kind)
-- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'$('@, -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'$('@,
-- 'ApiAnnotation.AnnClose' @')'@ -- 'ApiAnnotation.AnnClose' @')'@
...@@ -840,7 +812,6 @@ ppr_mono_ty ctxt_prec (HsForAllTy exp extra tvs ctxt ty) ...@@ -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] 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 _ (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 _ (HsRecTy flds) = pprConDeclFields flds
ppr_mono_ty _ (HsTyVar name) = pprPrefixOcc name ppr_mono_ty _ (HsTyVar name) = pprPrefixOcc name
ppr_mono_ty prec (HsFunTy ty1 ty2) = ppr_fun_ty prec ty1 ty2 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 ...@@ -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 _ (HsListTy ty) = brackets (ppr_mono_lty TopPrec ty)
ppr_mono_ty _ (HsPArrTy ty) = paBrackets (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 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 _ (HsCoreTy ty) = ppr ty
ppr_mono_ty _ (HsExplicitListTy _ tys) = quote $ brackets (interpp'SP tys) ppr_mono_ty _ (HsExplicitListTy _ tys) = quote $ brackets (interpp'SP tys)
ppr_mono_ty _ (HsExplicitTupleTy _ tys) = quote $ parens (interpp'SP tys) ppr_mono_ty _ (HsExplicitTupleTy _ tys) = quote $ parens (interpp'SP tys)
......
...@@ -53,7 +53,7 @@ module HsUtils( ...@@ -53,7 +53,7 @@ module HsUtils(
emptyRecStmt, emptyRecStmtName, emptyRecStmtId, mkRecStmt, emptyRecStmt, emptyRecStmtName, emptyRecStmtId, mkRecStmt,
-- Template Haskell -- Template Haskell
mkHsSpliceTy, mkHsSpliceE, mkHsSpliceTE, mkHsSplice, mkHsSpliceTy, mkHsSpliceE, mkHsSpliceTE, mkUntypedSplice,
mkHsQuasiQuote, unqualQuasiQuote, mkHsQuasiQuote, unqualQuasiQuote,
-- Flags -- Flags
...@@ -281,23 +281,23 @@ mkRecStmt stmts = emptyRecStmt { recS_stmts = stmts } ...@@ -281,23 +281,23 @@ mkRecStmt stmts = emptyRecStmt { recS_stmts = stmts }
mkHsOpApp :: LHsExpr id -> id -> LHsExpr id -> HsExpr id mkHsOpApp :: LHsExpr id -> id -> LHsExpr id -> HsExpr id
mkHsOpApp e1 op e2 = OpApp e1 (noLoc (HsVar op)) (error "mkOpApp:fixity") e2 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 :: RdrName
unqualSplice = mkRdrUnqual (mkVarOccFS (fsLit "splice")) unqualSplice = mkRdrUnqual (mkVarOccFS (fsLit "splice"))
mkUntypedSplice :: LHsExpr RdrName -> HsSplice RdrName
mkUntypedSplice e = HsUntypedSplice unqualSplice e
mkHsSpliceE :: LHsExpr RdrName -> HsExpr RdrName mkHsSpliceE :: LHsExpr RdrName -> HsExpr RdrName
mkHsSpliceE e = HsSpliceE False (mkHsSplice e) mkHsSpliceE e = HsSpliceE (mkUntypedSplice e)
mkHsSpliceTE :: LHsExpr RdrName -> HsExpr RdrName mkHsSpliceTE :: LHsExpr RdrName -> HsExpr RdrName
mkHsSpliceTE e = HsSpliceE True (mkHsSplice e) mkHsSpliceTE e = HsSpliceE (HsTypedSplice unqualSplice e)
mkHsSpliceTy :: LHsExpr RdrName -> HsType RdrName 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 :: RdrName -> SrcSpan -> FastString -> HsSplice RdrName
mkHsQuasiQuote quoter span quote = HsQuasiQuote quoter span quote mkHsQuasiQuote quoter span quote = HsQuasiQuote unqualSplice quoter span quote
unqualQuasiQuote :: RdrName unqualQuasiQuote :: RdrName
unqualQuasiQuote = mkRdrUnqual (mkVarOccFS (fsLit "quasiquote")) unqualQuasiQuote = mkRdrUnqual (mkVarOccFS (fsLit "quasiquote"))
...@@ -705,7 +705,6 @@ collect_lpat (L _ pat) bndrs ...@@ -705,7 +705,6 @@ collect_lpat (L _ pat) bndrs
go (SigPatIn pat _) = collect_lpat pat bndrs go (SigPatIn pat _) = collect_lpat pat bndrs
go (SigPatOut pat _) = collect_lpat pat bndrs go (SigPatOut pat _) = collect_lpat pat bndrs
go (SplicePat _) = bndrs go (SplicePat _) = bndrs