From 71a19227a9a29dfd974a7c5da61f3194668809af Mon Sep 17 00:00:00 2001 From: Geoffrey Mainland Date: Wed, 24 Apr 2013 13:57:35 +0100 Subject: [PATCH] Add syntactic support for typed expression brackets and splices. Right now the syntax for typed expression brackets and splices maps to conventional brackets and splices, i.e., they are not typed. --- compiler/parser/Lexer.x | 47 +++++++++++++++++++++++-------------- compiler/parser/Parser.y.pp | 10 ++++++++ 2 files changed, 40 insertions(+), 17 deletions(-) diff --git a/compiler/parser/Lexer.x b/compiler/parser/Lexer.x index 805a8f62a1e8..4a877db27101 100644 --- a/compiler/parser/Lexer.x +++ b/compiler/parser/Lexer.x @@ -306,14 +306,18 @@ $tab+ { warn Opt_WarnTabs (text "Tab character") } } <0> { - "[|" / { ifExtension thEnabled } { token ITopenExpQuote } - "[e|" / { ifExtension thEnabled } { token ITopenExpQuote } - "[p|" / { ifExtension thEnabled } { token ITopenPatQuote } - "[d|" / { ifExtension thEnabled } { layout_token ITopenDecQuote } - "[t|" / { ifExtension thEnabled } { token ITopenTypQuote } - "|]" / { ifExtension thEnabled } { token ITcloseQuote } - \$ @varid / { ifExtension thEnabled } { skip_one_varid ITidEscape } - "$(" / { ifExtension thEnabled } { token ITparenEscape } + "[|" / { ifExtension thEnabled } { token ITopenExpQuote } + "[||" / { ifExtension thEnabled } { token ITopenTExpQuote } + "[e|" / { ifExtension thEnabled } { token ITopenExpQuote } + "[p|" / { ifExtension thEnabled } { token ITopenPatQuote } + "[d|" / { ifExtension thEnabled } { layout_token ITopenDecQuote } + "[t|" / { ifExtension thEnabled } { token ITopenTypQuote } + "|]" / { ifExtension thEnabled } { token ITcloseQuote } + "||]" / { ifExtension thEnabled } { token ITcloseTExpQuote } + \$ @varid / { ifExtension thEnabled } { skip_one_varid ITidEscape } + "$$" @varid / { ifExtension thEnabled } { skip_two_varid ITidTyEscape } + "$(" / { ifExtension thEnabled } { token ITparenEscape } + "$$(" / { ifExtension thEnabled } { token ITparenTyEscape } -- For backward compatibility, accept the old dollar syntax "[$" @varid "|" / { ifExtension qqEnabled } @@ -564,8 +568,12 @@ data Token | ITopenDecQuote -- [d| | ITopenTypQuote -- [t| | ITcloseQuote -- |] + | ITopenTExpQuote -- [|| + | ITcloseTExpQuote -- ||] | ITidEscape FastString -- $x | ITparenEscape -- $( + | ITidTyEscape FastString -- $$x + | ITparenTyEscape -- $$( | ITtyQuote -- '' | ITquasiQuote (FastString,FastString,RealSrcSpan) -- ITquasiQuote(quoter, quote, loc) @@ -731,6 +739,10 @@ skip_one_varid :: (FastString -> Token) -> Action skip_one_varid f span buf len = return (L span $! f (lexemeToFastString (stepOn buf) (len-1))) +skip_two_varid :: (FastString -> Token) -> Action +skip_two_varid f span buf len + = return (L span $! f (lexemeToFastString (stepOn (stepOn buf)) (len-2))) + strtoken :: (String -> Token) -> Action strtoken f span buf len = return (L span $! (f $! lexemeToString buf len)) @@ -2249,16 +2261,17 @@ transitionalAlternativeLayoutWarning msg $$ text msg isALRopen :: Token -> Bool -isALRopen ITcase = True -isALRopen ITif = True -isALRopen ITthen = True -isALRopen IToparen = True -isALRopen ITobrack = True -isALRopen ITocurly = True +isALRopen ITcase = True +isALRopen ITif = True +isALRopen ITthen = True +isALRopen IToparen = True +isALRopen ITobrack = True +isALRopen ITocurly = True -- GHC Extensions: -isALRopen IToubxparen = True -isALRopen ITparenEscape = True -isALRopen _ = False +isALRopen IToubxparen = True +isALRopen ITparenEscape = True +isALRopen ITparenTyEscape = True +isALRopen _ = False isALRclose :: Token -> Bool isALRclose ITof = True diff --git a/compiler/parser/Parser.y.pp b/compiler/parser/Parser.y.pp index a4c08c196eae..11cf9efa987b 100644 --- a/compiler/parser/Parser.y.pp +++ b/compiler/parser/Parser.y.pp @@ -347,8 +347,12 @@ '[t|' { L _ ITopenTypQuote } '[d|' { L _ ITopenDecQuote } '|]' { L _ ITcloseQuote } +'[||' { L _ ITopenTExpQuote } +'||]' { L _ ITcloseTExpQuote } TH_ID_SPLICE { L _ (ITidEscape _) } -- $x '$(' { L _ ITparenEscape } -- $( exp ) +TH_ID_TY_SPLICE { L _ (ITidTyEscape _) } -- $$x +'$$(' { L _ ITparenTyEscape } -- $$( exp ) TH_TY_QUOTE { L _ ITtyQuote } -- ''T TH_QUASIQUOTE { L _ (ITquasiQuote _) } TH_QQUASIQUOTE { L _ (ITqQuasiQuote _) } @@ -1484,6 +1488,10 @@ (L1 $ HsVar (mkUnqual varName (getTH_ID_SPLICE $1)))) } | '$(' exp ')' { LL $ HsSpliceE (mkHsSplice $2) } + | TH_ID_TY_SPLICE { L1 $ HsSpliceE (mkHsSplice + (L1 $ HsVar (mkUnqual varName + (getTH_ID_TY_SPLICE $1)))) } + | '$$(' exp ')' { LL $ HsSpliceE (mkHsSplice $2) } | SIMPLEQUOTE qvar { LL $ HsBracket (VarBr True (unLoc $2)) } @@ -1491,6 +1499,7 @@ | TH_TY_QUOTE tyvar { LL $ HsBracket (VarBr False (unLoc $2)) } | TH_TY_QUOTE gtycon { LL $ HsBracket (VarBr False (unLoc $2)) } | '[|' exp '|]' { LL $ HsBracket (ExpBr $2) } + | '[||' exp '||]' { LL $ HsBracket (ExpBr $2) } | '[t|' ctype '|]' { LL $ HsBracket (TypBr $2) } | '[p|' infixexp '|]' {% checkPattern $2 >>= \p -> return (LL $ HsBracket (PatBr p)) } @@ -2104,6 +2113,7 @@ getPRIMFLOAT (L _ (ITprimfloat x)) = x getPRIMDOUBLE (L _ (ITprimdouble x)) = x getTH_ID_SPLICE (L _ (ITidEscape x)) = x +getTH_ID_TY_SPLICE (L _ (ITidTyEscape x)) = x getINLINE (L _ (ITinline_prag inl conl)) = (inl,conl) getSPEC_INLINE (L _ (ITspec_inline_prag True)) = (Inline, FunLike) getSPEC_INLINE (L _ (ITspec_inline_prag False)) = (NoInline,FunLike)