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

5 files changed, 162 insertions, 1 deletions

diff --git a/testsuite/tests/ghc-api/annotations/Makefile b/testsuite/tests/ghc-api/annotations/Makefile
index 631e7e3c1e..d0b9c2f095 100644
--- a/testsuite/tests/ghc-api/annotations/Makefile
+++ b/testsuite/tests/ghc-api/annotations/Makefile
@@ -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
diff --git a/testsuite/tests/ghc-api/annotations/T10276.stderr b/testsuite/tests/ghc-api/annotations/T10276.stderr
new file mode 100644
index 0000000000..d79fc3a6e3
--- /dev/null
+++ b/testsuite/tests/ghc-api/annotations/T10276.stderr
@@ -0,0 +1,78 @@
+
+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])) ||]
diff --git a/testsuite/tests/ghc-api/annotations/T10276.stdout b/testsuite/tests/ghc-api/annotations/T10276.stdout
new file mode 100644
index 0000000000..14179a6836
--- /dev/null
+++ b/testsuite/tests/ghc-api/annotations/T10276.stdout
@@ -0,0 +1,63 @@
+---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])
+]
+
diff --git a/testsuite/tests/ghc-api/annotations/Test10276.hs b/testsuite/tests/ghc-api/annotations/Test10276.hs
new file mode 100644
index 0000000000..dcf2549979
--- /dev/null
+++ b/testsuite/tests/ghc-api/annotations/Test10276.hs
@@ -0,0 +1,15 @@
+{-# 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]))||]
diff --git a/testsuite/tests/ghc-api/annotations/all.T b/testsuite/tests/ghc-api/annotations/all.T
index 591f5bf2e7..c7c8542a11 100644
--- a/testsuite/tests/ghc-api/annotations/all.T
+++ b/testsuite/tests/ghc-api/annotations/all.T
@@ -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'])