[commit: ghc] wip/fix-i386-warning, wip/optsemi-unsafe-coerce: Refactor splice_exp in Parser.y (ab49342)
git at git.haskell.org
git at git.haskell.org
Wed Feb 6 14:09:17 UTC 2019
Repository : ssh://git@git.haskell.org/ghc
On branches: wip/fix-i386-warning,wip/optsemi-unsafe-coerce
Link : http://ghc.haskell.org/trac/ghc/changeset/ab4934230bb12451f8990d063906f24ab072addc/ghc
>---------------------------------------------------------------
commit ab4934230bb12451f8990d063906f24ab072addc
Author: Vladislav Zavialov <vlad.z.4096 at gmail.com>
Date: Fri Feb 1 09:25:45 2019 +0300
Refactor splice_exp in Parser.y
>---------------------------------------------------------------
ab4934230bb12451f8990d063906f24ab072addc
compiler/basicTypes/SrcLoc.hs | 6 ++++++
compiler/hsSyn/HsUtils.hs | 14 +++-----------
compiler/parser/Parser.y | 24 +++++++++++++-----------
3 files changed, 22 insertions(+), 22 deletions(-)
diff --git a/compiler/basicTypes/SrcLoc.hs b/compiler/basicTypes/SrcLoc.hs
index 696395f..bcf2fcb 100644
--- a/compiler/basicTypes/SrcLoc.hs
+++ b/compiler/basicTypes/SrcLoc.hs
@@ -77,6 +77,9 @@ module SrcLoc (
getLoc, unLoc,
unRealSrcSpan, getRealSrcSpan,
+ -- ** Modifying Located
+ mapLoc,
+
-- ** Combining and comparing Located values
eqLocated, cmpLocated, combineLocs, addCLoc,
leftmost_smallest, leftmost_largest, rightmost,
@@ -527,6 +530,9 @@ data GenLocated l e = L l e
type Located = GenLocated SrcSpan
type RealLocated = GenLocated RealSrcSpan
+mapLoc :: (a -> b) -> GenLocated l a -> GenLocated l b
+mapLoc = fmap
+
unLoc :: HasSrcSpan a => a -> SrcSpanLess a
unLoc (dL->L _ e) = e
diff --git a/compiler/hsSyn/HsUtils.hs b/compiler/hsSyn/HsUtils.hs
index 2219ca6..febd5ac 100644
--- a/compiler/hsSyn/HsUtils.hs
+++ b/compiler/hsSyn/HsUtils.hs
@@ -67,7 +67,7 @@ module HsUtils(
unitRecStmtTc,
-- Template Haskell
- mkHsSpliceTy, mkHsSpliceE, mkHsSpliceTE, mkUntypedSplice,
+ mkUntypedSplice, mkTypedSplice,
mkHsQuasiQuote, unqualQuasiQuote,
-- Collecting binders
@@ -346,16 +346,8 @@ unqualSplice = mkRdrUnqual (mkVarOccFS (fsLit "splice"))
mkUntypedSplice :: SpliceDecoration -> LHsExpr GhcPs -> HsSplice GhcPs
mkUntypedSplice hasParen e = HsUntypedSplice noExt hasParen unqualSplice e
-mkHsSpliceE :: SpliceDecoration -> LHsExpr GhcPs -> HsExpr GhcPs
-mkHsSpliceE hasParen e = HsSpliceE noExt (mkUntypedSplice hasParen e)
-
-mkHsSpliceTE :: SpliceDecoration -> LHsExpr GhcPs -> HsExpr GhcPs
-mkHsSpliceTE hasParen e
- = HsSpliceE noExt (HsTypedSplice noExt hasParen unqualSplice e)
-
-mkHsSpliceTy :: SpliceDecoration -> LHsExpr GhcPs -> HsType GhcPs
-mkHsSpliceTy hasParen e = HsSpliceTy noExt
- (HsUntypedSplice noExt hasParen unqualSplice e)
+mkTypedSplice :: SpliceDecoration -> LHsExpr GhcPs -> HsSplice GhcPs
+mkTypedSplice hasParen e = HsTypedSplice noExt hasParen unqualSplice e
mkHsQuasiQuote :: RdrName -> SrcSpan -> FastString -> HsSplice GhcPs
mkHsQuasiQuote quoter span quote
diff --git a/compiler/parser/Parser.y b/compiler/parser/Parser.y
index 0751567..ce5c523 100644
--- a/compiler/parser/Parser.y
+++ b/compiler/parser/Parser.y
@@ -2025,12 +2025,8 @@ atype :: { LHsType GhcPs }
[mo $1,mc $3] }
| '[' ktype ']' {% ams (sLL $1 $> $ HsListTy noExt $2) [mos $1,mcs $3] }
| '(' ktype ')' {% ams (sLL $1 $> $ HsParTy noExt $2) [mop $1,mcp $3] }
- | quasiquote { sL1 $1 (HsSpliceTy noExt (unLoc $1) ) }
- | '$(' exp ')' {% ams (sLL $1 $> $ mkHsSpliceTy HasParens $2)
- [mj AnnOpenPE $1,mj AnnCloseP $3] }
- | TH_ID_SPLICE {%ams (sLL $1 $> $ mkHsSpliceTy HasDollar $ sL1 $1 $ HsVar noExt $
- (sL1 $1 (mkUnqual varName (getTH_ID_SPLICE $1))))
- [mj AnnThIdSplice $1] }
+ | quasiquote { mapLoc (HsSpliceTy noExt) $1 }
+ | splice_untyped { mapLoc (HsSpliceTy noExt) $1 }
-- see Note [Promotion] for the followings
| SIMPLEQUOTE qcon_nowiredlist {% ams (sLL $1 $> $ HsTyVar noExt IsPromoted $2) [mj AnnSimpleQuote $1,mj AnnName $2] }
| SIMPLEQUOTE '(' ktype ',' comma_types1 ')'
@@ -2749,17 +2745,23 @@ aexp2 :: { LHsExpr GhcPs }
[mu AnnOpenB $1,mu AnnCloseB $4] }
splice_exp :: { LHsExpr GhcPs }
- : TH_ID_SPLICE {% ams (sL1 $1 $ mkHsSpliceE HasDollar
+ : splice_untyped { mapLoc (HsSpliceE noExt) $1 }
+ | splice_typed { mapLoc (HsSpliceE noExt) $1 }
+
+splice_untyped :: { Located (HsSplice GhcPs) }
+ : TH_ID_SPLICE {% ams (sL1 $1 $ mkUntypedSplice HasDollar
(sL1 $1 $ HsVar noExt (sL1 $1 (mkUnqual varName
(getTH_ID_SPLICE $1)))))
[mj AnnThIdSplice $1] }
- | '$(' exp ')' {% ams (sLL $1 $> $ mkHsSpliceE HasParens $2)
+ | '$(' exp ')' {% ams (sLL $1 $> $ mkUntypedSplice HasParens $2)
[mj AnnOpenPE $1,mj AnnCloseP $3] }
- | TH_ID_TY_SPLICE {% ams (sL1 $1 $ mkHsSpliceTE HasDollar
+
+splice_typed :: { Located (HsSplice GhcPs) }
+ : TH_ID_TY_SPLICE {% ams (sL1 $1 $ mkTypedSplice HasDollar
(sL1 $1 $ HsVar noExt (sL1 $1 (mkUnqual varName
(getTH_ID_TY_SPLICE $1)))))
[mj AnnThIdTySplice $1] }
- | '$$(' exp ')' {% ams (sLL $1 $> $ mkHsSpliceTE HasParens $2)
+ | '$$(' exp ')' {% ams (sLL $1 $> $ mkTypedSplice HasParens $2)
[mj AnnOpenPTE $1,mj AnnCloseP $3] }
cmdargs :: { [LHsCmdTop GhcPs] }
@@ -3810,7 +3812,7 @@ warnSpaceAfterBang span = do
-- When two single quotes don't followed by tyvar or gtycon, we report the
-- error as empty character literal, or TH quote that missing proper type
-- variable or constructor. See Trac #13450.
-reportEmptyDoubleQuotes :: SrcSpan -> P (Located (HsExpr GhcPs))
+reportEmptyDoubleQuotes :: SrcSpan -> P a
reportEmptyDoubleQuotes span = do
thQuotes <- getBit ThQuotesBit
if thQuotes
More information about the ghc-commits
mailing list