diff options
| author | Vladislav Zavialov <vlad.z.4096@gmail.com> | 2019-02-01 09:25:45 +0300 |
|---|---|---|
| committer | Vladislav Zavialov <vlad.z.4096@gmail.com> | 2019-02-01 22:47:30 +0300 |
| commit | 846f2c918466f2b65af4aa56dd862dddb54b3613 (patch) | |
| tree | 8bbe0d1a3e58a8eb4488932d0f913b5aae4e0e05 /compiler/parser | |
| parent | ef6b28339b18597a2df1ce39116f1d4e4533804c (diff) | |
| download | haskell-wip/splice-parsing.tar.gz | |
Refactor splice_exp in Parser.ywip/splice-parsing
Diffstat (limited to 'compiler/parser')
| -rw-r--r-- | compiler/parser/Parser.y | 24 |
1 files changed, 13 insertions, 11 deletions
diff --git a/compiler/parser/Parser.y b/compiler/parser/Parser.y index 07515679b1..ce5c523e6f 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 |