[commit: ghc] master: Explicitly capture whether a splice has a dollar prefix (c0af206)
git at git.haskell.org
git at git.haskell.org
Mon Feb 27 09:47:18 UTC 2017
Repository : ssh://git@git.haskell.org/ghc
On branch : master
Link : http://ghc.haskell.org/trac/ghc/changeset/c0af206f26b97d8d4f1c5722825577b27087c0a9/ghc
>---------------------------------------------------------------
commit c0af206f26b97d8d4f1c5722825577b27087c0a9
Author: Alan Zimmerman <alan.zimm at gmail.com>
Date: Mon Feb 27 11:43:01 2017 +0200
Explicitly capture whether a splice has a dollar prefix
A top-level splice can be written
$splice
or
splice
For accurate pretty-printing, and for ghc-exactprint, capture in the hsSyn AST
which variant was parsed.
>---------------------------------------------------------------
c0af206f26b97d8d4f1c5722825577b27087c0a9
compiler/hsSyn/HsExpr.hs | 28 ++++++++++++++++++----------
compiler/hsSyn/HsUtils.hs | 8 ++++----
compiler/parser/Parser.y | 6 +++---
testsuite/tests/printer/Ppr037.hs | 2 ++
4 files changed, 27 insertions(+), 17 deletions(-)
diff --git a/compiler/hsSyn/HsExpr.hs b/compiler/hsSyn/HsExpr.hs
index de793bd..f627056 100644
--- a/compiler/hsSyn/HsExpr.hs
+++ b/compiler/hsSyn/HsExpr.hs
@@ -2045,12 +2045,12 @@ pprQuals quals = interpp'SP quals
-- | Haskell Splice
data HsSplice id
= HsTypedSplice -- $$z or $$(f 4)
- HasParens -- Whether $$( ) variant found, for pretty printing
+ SpliceDecoration -- Whether $$( ) variant found, for pretty printing
id -- A unique name to identify this splice point
(LHsExpr id) -- See Note [Pending Splices]
| HsUntypedSplice -- $z or $(f 4)
- HasParens -- Whether $( ) variant found, for pretty printing
+ SpliceDecoration -- Whether $( ) variant found, for pretty printing
id -- A unique name to identify this splice point
(LHsExpr id) -- See Note [Pending Splices]
@@ -2070,13 +2070,17 @@ data HsSplice id
deriving Typeable
deriving instance (DataId id) => Data (HsSplice id)
-data HasParens = HasParens
- | NoParens
- deriving (Data, Eq, Show)
+-- | A splice can appear with various decorations wrapped around it. This data
+-- type captures explicitly how it was originally written, for use in the pretty
+-- printer.
+data SpliceDecoration
+ = HasParens -- ^ $( splice ) or $$( splice )
+ | HasDollar -- ^ $splice or $$splice
+ | NoParens -- ^ bare splice
+ deriving (Data, Eq, Show)
-instance Outputable HasParens where
- ppr HasParens = text "HasParens"
- ppr NoParens = text "NoParens"
+instance Outputable SpliceDecoration where
+ ppr x = text $ show x
isTypedSplice :: HsSplice id -> Bool
@@ -2218,12 +2222,16 @@ ppr_splice_decl e = pprSplice e
pprSplice :: (OutputableBndrId id) => HsSplice id -> SDoc
pprSplice (HsTypedSplice HasParens n e)
= ppr_splice (text "$$(") n e (text ")")
-pprSplice (HsTypedSplice NoParens n e)
+pprSplice (HsTypedSplice HasDollar n e)
= ppr_splice (text "$$") n e empty
+pprSplice (HsTypedSplice NoParens n e)
+ = ppr_splice empty n e empty
pprSplice (HsUntypedSplice HasParens n e)
= ppr_splice (text "$(") n e (text ")")
-pprSplice (HsUntypedSplice NoParens n e)
+pprSplice (HsUntypedSplice HasDollar n e)
= ppr_splice (text "$") n e empty
+pprSplice (HsUntypedSplice NoParens n e)
+ = ppr_splice empty n e empty
pprSplice (HsQuasiQuote n q _ s) = ppr_quasi n q s
pprSplice (HsSpliced _ thing) = ppr thing
diff --git a/compiler/hsSyn/HsUtils.hs b/compiler/hsSyn/HsUtils.hs
index 8001a15..c7d43b0 100644
--- a/compiler/hsSyn/HsUtils.hs
+++ b/compiler/hsSyn/HsUtils.hs
@@ -321,16 +321,16 @@ mkHsOpApp e1 op e2 = OpApp e1 (noLoc (HsVar (noLoc op)))
unqualSplice :: RdrName
unqualSplice = mkRdrUnqual (mkVarOccFS (fsLit "splice"))
-mkUntypedSplice :: HasParens -> LHsExpr RdrName -> HsSplice RdrName
+mkUntypedSplice :: SpliceDecoration -> LHsExpr RdrName -> HsSplice RdrName
mkUntypedSplice hasParen e = HsUntypedSplice hasParen unqualSplice e
-mkHsSpliceE :: HasParens -> LHsExpr RdrName -> HsExpr RdrName
+mkHsSpliceE :: SpliceDecoration -> LHsExpr RdrName -> HsExpr RdrName
mkHsSpliceE hasParen e = HsSpliceE (mkUntypedSplice hasParen e)
-mkHsSpliceTE :: HasParens -> LHsExpr RdrName -> HsExpr RdrName
+mkHsSpliceTE :: SpliceDecoration -> LHsExpr RdrName -> HsExpr RdrName
mkHsSpliceTE hasParen e = HsSpliceE (HsTypedSplice hasParen unqualSplice e)
-mkHsSpliceTy :: HasParens -> LHsExpr RdrName -> HsType RdrName
+mkHsSpliceTy :: SpliceDecoration -> LHsExpr RdrName -> HsType RdrName
mkHsSpliceTy hasParen e
= HsSpliceTy (HsUntypedSplice hasParen unqualSplice e) placeHolderKind
diff --git a/compiler/parser/Parser.y b/compiler/parser/Parser.y
index 721559f..b590333 100644
--- a/compiler/parser/Parser.y
+++ b/compiler/parser/Parser.y
@@ -1876,7 +1876,7 @@ atype :: { LHsType RdrName }
| quasiquote { sL1 $1 (HsSpliceTy (unLoc $1) placeHolderKind) }
| '$(' exp ')' {% ams (sLL $1 $> $ mkHsSpliceTy HasParens $2)
[mj AnnOpenPE $1,mj AnnCloseP $3] }
- | TH_ID_SPLICE {%ams (sLL $1 $> $ mkHsSpliceTy NoParens $ sL1 $1 $ HsVar $
+ | TH_ID_SPLICE {%ams (sLL $1 $> $ mkHsSpliceTy HasDollar $ sL1 $1 $ HsVar $
(sL1 $1 (mkUnqual varName (getTH_ID_SPLICE $1))))
[mj AnnThIdSplice $1] }
-- see Note [Promotion] for the followings
@@ -2540,13 +2540,13 @@ aexp2 :: { LHsExpr RdrName }
[mu AnnOpenB $1,mu AnnCloseB $4] }
splice_exp :: { LHsExpr RdrName }
- : TH_ID_SPLICE {% ams (sL1 $1 $ mkHsSpliceE NoParens
+ : TH_ID_SPLICE {% ams (sL1 $1 $ mkHsSpliceE HasDollar
(sL1 $1 $ HsVar (sL1 $1 (mkUnqual varName
(getTH_ID_SPLICE $1)))))
[mj AnnThIdSplice $1] }
| '$(' exp ')' {% ams (sLL $1 $> $ mkHsSpliceE HasParens $2)
[mj AnnOpenPE $1,mj AnnCloseP $3] }
- | TH_ID_TY_SPLICE {% ams (sL1 $1 $ mkHsSpliceTE NoParens
+ | TH_ID_TY_SPLICE {% ams (sL1 $1 $ mkHsSpliceTE HasDollar
(sL1 $1 $ HsVar (sL1 $1 (mkUnqual varName
(getTH_ID_TY_SPLICE $1)))))
[mj AnnThIdTySplice $1] }
diff --git a/testsuite/tests/printer/Ppr037.hs b/testsuite/tests/printer/Ppr037.hs
index a812643..1ece439 100644
--- a/testsuite/tests/printer/Ppr037.hs
+++ b/testsuite/tests/printer/Ppr037.hs
@@ -62,3 +62,5 @@ class (kparam ~ 'KProxy) => SEq (kparam :: KProxy k) where
infix 4 %:/=
$(singEqInstances basicTypes)
+$singEqInstances basicTypes
+singEqInstances basicTypes
More information about the ghc-commits
mailing list