Commit ee914828 authored by Alan Zimmerman's avatar Alan Zimmerman

ApiAnnotations : ITopenExpQuote needs SourceText

Summary:
In the lexer, ITopenExpQuote can be recognised for '[e|' or '[|'.

The token definition needs to capture the original SourceText, and pass
it through to ExpBr, which also needs a SrcText field.

It is easier to simply add a flag  to the token identifying the variant
and to generate a different AnnKeywordId based on this.

Test Plan: ./validate

Reviewers: mpickering, bgamari, austin

Reviewed By: bgamari

Subscribers: thomie

Differential Revision: https://phabricator.haskell.org/D1479

GHC Trac Issues: #10276
parent fe95463b
......@@ -9,6 +9,7 @@ module ApiAnnotation (
AnnotationComment(..),
IsUnicodeSyntax(..),
unicodeAnn,
HasE(..),
LRdrName -- Exists for haddocks only
) where
......@@ -238,6 +239,7 @@ data AnnKeywordId
| AnnOf
| AnnOpen -- ^ '(\#' or '{-\# LANGUAGE' etc
| AnnOpenC -- ^ '{'
| AnnOpenE -- ^ '[e|' or '[e||'
| AnnOpenP -- ^ '('
| AnnOpenPE -- ^ '$('
| AnnOpenPTE -- ^ '$$('
......@@ -331,3 +333,14 @@ unicodeAnn AnnRarrowtail = AnnRarrowtailU
unicodeAnn AnnStar = AnnStarU
unicodeAnn ann = ann
-- What about '*'?
-- | Some template haskell tokens have two variants, one with an `e` the other
-- not:
--
-- > [| or [e|
-- > [|| or [e||
--
-- This type indicates whether the 'e' is present or not.
data HasE = HasE | NoE
deriving (Eq, Ord, Data, Typeable, Show)
......@@ -365,10 +365,10 @@ $tab { warnTab }
}
<0> {
"[|" / { ifExtension thEnabled } { token ITopenExpQuote }
"[||" / { ifExtension thEnabled } { token ITopenTExpQuote }
"[e|" / { ifExtension thEnabled } { token ITopenExpQuote }
"[e||" / { ifExtension thEnabled } { token ITopenTExpQuote }
"[|" / { ifExtension thEnabled } { token (ITopenExpQuote NoE) }
"[||" / { ifExtension thEnabled } { token (ITopenTExpQuote NoE) }
"[e|" / { ifExtension thEnabled } { token (ITopenExpQuote HasE) }
"[e||" / { ifExtension thEnabled } { token (ITopenTExpQuote HasE) }
"[p|" / { ifExtension thEnabled } { token ITopenPatQuote }
"[d|" / { ifExtension thEnabled } { layout_token ITopenDecQuote }
"[t|" / { ifExtension thEnabled } { token ITopenTypQuote }
......@@ -647,12 +647,12 @@ data Token
| ITprimdouble FractionalLit
-- Template Haskell extension tokens
| ITopenExpQuote -- [| or [e|
| ITopenExpQuote HasE -- [| or [e|
| ITopenPatQuote -- [p|
| ITopenDecQuote -- [d|
| ITopenTypQuote -- [t|
| ITcloseQuote -- |]
| ITopenTExpQuote -- [||
| ITopenTExpQuote HasE -- [|| or [e||
| ITcloseTExpQuote -- ||]
| ITidEscape FastString -- $x
| ITparenEscape -- $(
......
......@@ -468,12 +468,12 @@ output it generates.
DOCSECTION { L _ (ITdocSection _ _) }
-- Template Haskell
'[|' { L _ ITopenExpQuote }
'[|' { L _ (ITopenExpQuote _) }
'[p|' { L _ ITopenPatQuote }
'[t|' { L _ ITopenTypQuote }
'[d|' { L _ ITopenDecQuote }
'|]' { L _ ITcloseQuote }
'[||' { L _ ITopenTExpQuote }
'[||' { L _ (ITopenTExpQuote _) }
'||]' { L _ ITcloseTExpQuote }
TH_ID_SPLICE { L _ (ITidEscape _) } -- $x
'$(' { L _ ITparenEscape } -- $( exp )
......@@ -2302,8 +2302,10 @@ aexp2 :: { LHsExpr RdrName }
| SIMPLEQUOTE qcon {% ams (sLL $1 $> $ HsBracket (VarBr True (unLoc $2))) [mj AnnSimpleQuote $1,mj AnnName $2] }
| TH_TY_QUOTE tyvar {% ams (sLL $1 $> $ HsBracket (VarBr False (unLoc $2))) [mj AnnThTyQuote $1,mj AnnName $2] }
| TH_TY_QUOTE gtycon {% ams (sLL $1 $> $ HsBracket (VarBr False (unLoc $2))) [mj AnnThTyQuote $1,mj AnnName $2] }
| '[|' exp '|]' {% ams (sLL $1 $> $ HsBracket (ExpBr $2)) [mo $1,mc $3] }
| '[||' exp '||]' {% ams (sLL $1 $> $ HsBracket (TExpBr $2)) [mo $1,mc $3]}
| '[|' exp '|]' {% ams (sLL $1 $> $ HsBracket (ExpBr $2))
(if (hasE $1) then [mj AnnOpenE $1,mc $3] else [mo $1,mc $3]) }
| '[||' exp '||]' {% ams (sLL $1 $> $ HsBracket (TExpBr $2))
(if (hasE $1) then [mj AnnOpenE $1,mc $3] else [mo $1,mc $3]) }
| '[t|' ctype '|]' {% ams (sLL $1 $> $ HsBracket (TypBr $2)) [mo $1,mc $3] }
| '[p|' infixexp '|]' {% checkPattern empty $2 >>= \p ->
ams (sLL $1 $> $ HsBracket (PatBr p))
......@@ -3208,6 +3210,11 @@ isUnicode (L _ (ITLarrowtail iu)) = iu == UnicodeSyntax
isUnicode (L _ (ITRarrowtail iu)) = iu == UnicodeSyntax
isUnicode _ = False
hasE :: Located Token -> Bool
hasE (L _ (ITopenExpQuote HasE)) = True
hasE (L _ (ITopenTExpQuote HasE)) = True
hasE _ = False
getSCC :: Located Token -> P FastString
getSCC lt = do let s = getSTRING lt
err = "Spaces are not allowed in SCCs"
......
......@@ -106,3 +106,7 @@ T10313:
.PHONY: T11018
T11018:
$(CHECK_API_ANNOTATIONS) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Test11018
.PHONY: T10276
T10276:
$(CHECK_API_ANNOTATIONS) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Test10276
Test10276.hs:10:3: error:
‘qqExp’ is not a (visible) method of class ‘QQExp’
Test10276.hs:11:29: error:
Not in scope: ‘M.empty’
No module named ‘M’ is imported.
In the Template Haskell quotation
[|| fst
$ runState
($$(qqExpM x))
((0, M.empty) :: (Int, M.Map L.Name [L.Operand])) ||]
Test10276.hs:11:46: error:
Not in scope: type constructor or class ‘M.Map’
No module named ‘M’ is imported.
In the Template Haskell quotation
[|| fst
$ runState
($$(qqExpM x))
((0, M.empty) :: (Int, M.Map L.Name [L.Operand])) ||]
Test10276.hs:11:52: error:
Not in scope: type constructor or class ‘L.Name’
No module named ‘L’ is imported.
In the Template Haskell quotation
[|| fst
$ runState
($$(qqExpM x))
((0, M.empty) :: (Int, M.Map L.Name [L.Operand])) ||]
Test10276.hs:11:60: error:
Not in scope: type constructor or class ‘L.Operand’
No module named ‘L’ is imported.
In the Template Haskell quotation
[|| fst
$ runState
($$(qqExpM x))
((0, M.empty) :: (Int, M.Map L.Name [L.Operand])) ||]
Test10276.hs:14:3: error:
‘qqExp’ is not a (visible) method of class ‘QQExp2’
Test10276.hs:15:29: error:
Not in scope: ‘M.empty’
No module named ‘M’ is imported.
In the Template Haskell quotation
[|| fst
$ runState
($$(qqExpM x))
((0, M.empty) :: (Int, M.Map L.Name [L.Operand])) ||]
Test10276.hs:15:46: error:
Not in scope: type constructor or class ‘M.Map’
No module named ‘M’ is imported.
In the Template Haskell quotation
[|| fst
$ runState
($$(qqExpM x))
((0, M.empty) :: (Int, M.Map L.Name [L.Operand])) ||]
Test10276.hs:15:52: error:
Not in scope: type constructor or class ‘L.Name’
No module named ‘L’ is imported.
In the Template Haskell quotation
[|| fst
$ runState
($$(qqExpM x))
((0, M.empty) :: (Int, M.Map L.Name [L.Operand])) ||]
Test10276.hs:15:60: error:
Not in scope: type constructor or class ‘L.Operand’
No module named ‘L’ is imported.
In the Template Haskell quotation
[|| fst
$ runState
($$(qqExpM x))
((0, M.empty) :: (Int, M.Map L.Name [L.Operand])) ||]
---Problems (should be empty list)---
[]
---Annotations-----------------------
-- SrcSpan the annotation is attached to, AnnKeywordId,
-- list of locations the keyword item appears in
[
((Test10276.hs:1:1,AnnModule), [Test10276.hs:4:1-6]),
((Test10276.hs:1:1,AnnWhere), [Test10276.hs:4:18-22]),
((Test10276.hs:6:1-14,AnnEqual), [Test10276.hs:6:4]),
((Test10276.hs:6:1-14,AnnFunId), [Test10276.hs:6:1-2]),
((Test10276.hs:6:1-14,AnnSemi), [Test10276.hs:7:1]),
((Test10276.hs:6:6-14,AnnClose), [Test10276.hs:6:13-14]),
((Test10276.hs:6:6-14,AnnOpen), [Test10276.hs:6:6-7]),
((Test10276.hs:7:1-15,AnnEqual), [Test10276.hs:7:4]),
((Test10276.hs:7:1-15,AnnFunId), [Test10276.hs:7:1-2]),
((Test10276.hs:7:1-15,AnnSemi), [Test10276.hs:9:1]),
((Test10276.hs:7:6-15,AnnClose), [Test10276.hs:7:14-15]),
((Test10276.hs:7:6-15,AnnOpenE), [Test10276.hs:7:6-8]),
((Test10276.hs:(9,1)-(11,74),AnnClass), [Test10276.hs:9:1-5]),
((Test10276.hs:(9,1)-(11,74),AnnSemi), [Test10276.hs:13:1]),
((Test10276.hs:(9,1)-(11,74),AnnWhere), [Test10276.hs:9:17-21]),
((Test10276.hs:(10,3)-(11,74),AnnEqual), [Test10276.hs:10:11]),
((Test10276.hs:(10,3)-(11,74),AnnFunId), [Test10276.hs:10:3-7]),
((Test10276.hs:(10,13)-(11,74),AnnClose), [Test10276.hs:11:72-74]),
((Test10276.hs:(10,13)-(11,74),AnnOpen), [Test10276.hs:10:13-15]),
((Test10276.hs:(10,16)-(11,71),AnnVal), [Test10276.hs:10:20]),
((Test10276.hs:10:31-42,AnnCloseP), [Test10276.hs:10:42]),
((Test10276.hs:10:31-42,AnnOpenPTE), [Test10276.hs:10:31-33]),
((Test10276.hs:11:25-71,AnnCloseP), [Test10276.hs:11:71]),
((Test10276.hs:11:25-71,AnnOpenP), [Test10276.hs:11:25]),
((Test10276.hs:11:26-36,AnnCloseP), [Test10276.hs:11:36]),
((Test10276.hs:11:26-36,AnnOpenP), [Test10276.hs:11:26]),
((Test10276.hs:11:26-70,AnnDcolon), [Test10276.hs:11:38-39]),
((Test10276.hs:11:27,AnnComma), [Test10276.hs:11:28]),
((Test10276.hs:11:41-70,AnnCloseP), [Test10276.hs:11:70]),
((Test10276.hs:11:41-70,AnnOpenP), [Test10276.hs:11:41]),
((Test10276.hs:11:42-44,AnnComma), [Test10276.hs:11:45]),
((Test10276.hs:11:59-69,AnnCloseS), [Test10276.hs:11:69]),
((Test10276.hs:11:59-69,AnnOpenS), [Test10276.hs:11:59]),
((Test10276.hs:(13,1)-(15,74),AnnClass), [Test10276.hs:13:1-5]),
((Test10276.hs:(13,1)-(15,74),AnnSemi), [Test10276.hs:16:1]),
((Test10276.hs:(13,1)-(15,74),AnnWhere), [Test10276.hs:13:18-22]),
((Test10276.hs:(14,3)-(15,74),AnnEqual), [Test10276.hs:14:11]),
((Test10276.hs:(14,3)-(15,74),AnnFunId), [Test10276.hs:14:3-7]),
((Test10276.hs:(14,13)-(15,74),AnnClose), [Test10276.hs:15:72-74]),
((Test10276.hs:(14,13)-(15,74),AnnOpenE), [Test10276.hs:14:13-16]),
((Test10276.hs:(14,17)-(15,71),AnnVal), [Test10276.hs:14:21]),
((Test10276.hs:14:32-43,AnnCloseP), [Test10276.hs:14:43]),
((Test10276.hs:14:32-43,AnnOpenPTE), [Test10276.hs:14:32-34]),
((Test10276.hs:15:25-71,AnnCloseP), [Test10276.hs:15:71]),
((Test10276.hs:15:25-71,AnnOpenP), [Test10276.hs:15:25]),
((Test10276.hs:15:26-36,AnnCloseP), [Test10276.hs:15:36]),
((Test10276.hs:15:26-36,AnnOpenP), [Test10276.hs:15:26]),
((Test10276.hs:15:26-70,AnnDcolon), [Test10276.hs:15:38-39]),
((Test10276.hs:15:27,AnnComma), [Test10276.hs:15:28]),
((Test10276.hs:15:41-70,AnnCloseP), [Test10276.hs:15:70]),
((Test10276.hs:15:41-70,AnnOpenP), [Test10276.hs:15:41]),
((Test10276.hs:15:42-44,AnnComma), [Test10276.hs:15:45]),
((Test10276.hs:15:59-69,AnnCloseS), [Test10276.hs:15:69]),
((Test10276.hs:15:59-69,AnnOpenS), [Test10276.hs:15:59]),
((<no location info>,AnnEofPos), [Test10276.hs:16:1])
]
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE QuasiQuotes #-}
module Test10276 where
f1 = [| bar |]
f2 = [e| bar |]
class QQExp a b where
qqExp x = [||fst $ runState $$(qqExpM x)
((0,M.empty) :: (Int,M.Map L.Name [L.Operand]))||]
class QQExp2 a b where
qqExp x = [e||fst $ runState $$(qqExpM x)
((0,M.empty) :: (Int,M.Map L.Name [L.Operand]))||]
......@@ -19,4 +19,5 @@ test('T10396', normal, run_command, ['$MAKE -s --no-print-directory T10396'
test('T10399', normal, run_command, ['$MAKE -s --no-print-directory T10399'])
test('T10313', normal, run_command, ['$MAKE -s --no-print-directory T10313'])
test('T11018', normal, run_command, ['$MAKE -s --no-print-directory T11018'])
test('bundle-export', normal, run_command, ['$MAKE -s --no-print-directory bundle-export'])
test('bundle-export', normal, run_command, ['$MAKE -s --no-print-directory bundle-export'])
test('T10276', normal, run_command, ['$MAKE -s --no-print-directory T10276'])
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment