Parse the (!) type operator and allow type operators in existential context

Summary:
Improve the way `(!)`, `(~)`, and other type operators are handled in the parser,
fixing two issues at once:

1. `(!)` can now be used as a type operator
   that respects fixity and precedence (#15457)
2. Existential context of a data constructor
   no longer needs parentheses (#15675)

In addition to that, with this patch it is now trivial to adjust precedence of
the `{-# UNPACK #-}` pragma, as suggested in
https://ghc.haskell.org/trac/ghc/ticket/14761#comment:7

There was a small change to API Annotations. Before this patch, `(~)` was a
strange special case that produced an annotation unlike any other type
operator. After this patch, when `(~)` or `(!)` are used to specify strictness they
produce AnnTilde and AnnBang annotations respectively, and when they are used
as type operators, they produce no annotations.

Test Plan: Validate

Reviewers: simonpj, bgamari, alanz, RyanGlScott

Reviewed By: RyanGlScott

Subscribers: RyanGlScott, rwbarton, mpickering, carter

GHC Trac Issues: #15457, #15675

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

15 files changed, 58 insertions, 7 deletions

diff --git a/testsuite/tests/parser/should_compile/T15457.hs b/testsuite/tests/parser/should_compile/T15457.hs
new file mode 100644
index 0000000000..7ce80fea1c
--- /dev/null
+++ b/testsuite/tests/parser/should_compile/T15457.hs
@@ -0,0 +1,12 @@
+{-# LANGUAGE TypeOperators #-}
+module T15457 where
+
+import Data.Type.Equality
+
+data a ! b; infix 0 !
+data a + b; infix 9 +
+
+fixityProof :: (Int ! Int + Int) :~: (Int ! (Int + Int))
+fixityProof = Refl
+
+data Foo a b = MkFoo (a ! b) !Int !(Bool ! Bool)
diff --git a/testsuite/tests/parser/should_compile/T15675.hs b/testsuite/tests/parser/should_compile/T15675.hs
new file mode 100644
index 0000000000..f5fe410370
--- /dev/null
+++ b/testsuite/tests/parser/should_compile/T15675.hs
@@ -0,0 +1,13 @@
+{-# LANGUAGE TypeOperators, MultiParamTypeClasses, ExistentialQuantification #-}
+
+module T15675 where
+
+class a + b
+
+data D1 = forall a b. (a + b) => D1 a b
+data D2 = forall a b.  a + b  => D2 a b
+
+class a ! b
+
+data D3 = forall a b. (a ! b) => D3 !a !b
+data D4 = forall a b.  a ! b  => D4 !a !b
diff --git a/testsuite/tests/parser/should_compile/all.T b/testsuite/tests/parser/should_compile/all.T
index d949f2b42e..50fa1a71e7 100644
--- a/testsuite/tests/parser/should_compile/all.T
+++ b/testsuite/tests/parser/should_compile/all.T
@@ -130,3 +130,5 @@ def only_MG_loc(x):
                 if mg.strip().startswith("(MG"))
     return '\n'.join(mgLocs)
 test('T15279', normalise_errmsg_fun(only_MG_loc), compile, [''])
+test('T15457', normal, compile, [''])
+test('T15675', normal, compile, [''])
diff --git a/testsuite/tests/parser/should_fail/T3811b.stderr b/testsuite/tests/parser/should_fail/T3811b.stderr
index e2360b23ef..f4e44c603c 100644
--- a/testsuite/tests/parser/should_fail/T3811b.stderr
+++ b/testsuite/tests/parser/should_fail/T3811b.stderr
@@ -1,3 +1,4 @@
 
-T3811b.hs:4:14:
-    Cannot parse data constructor in a data/newtype declaration: !B
+T3811b.hs:4:14: error:
+    Cannot parse data constructor in a data/newtype declaration:
+      ! B
diff --git a/testsuite/tests/parser/should_fail/T3811c.stderr b/testsuite/tests/parser/should_fail/T3811c.stderr
index dd219184e7..431318e268 100644
--- a/testsuite/tests/parser/should_fail/T3811c.stderr
+++ b/testsuite/tests/parser/should_fail/T3811c.stderr
@@ -1,5 +1,5 @@
 
-T3811c.hs:6:10: error:
-    • Unexpected strictness annotation: !Show
-      strictness annotation cannot appear nested inside a type
-    • In the instance declaration for ‘!Show D’
+T3811c.hs:6:11: error:
+    Strictness annotation applied to a compound type.
+    Did you mean to add parentheses?
+      !(Show D)
diff --git a/testsuite/tests/parser/should_fail/T3811f.stderr b/testsuite/tests/parser/should_fail/T3811f.stderr
index 882ae06706..2d31fa86cf 100644
--- a/testsuite/tests/parser/should_fail/T3811f.stderr
+++ b/testsuite/tests/parser/should_fail/T3811f.stderr
@@ -1,2 +1,5 @@
 
-T3811f.hs:4:7: Malformed head of type or class declaration: !Foo a
+T3811f.hs:4:8: error:
+    Strictness annotation applied to a compound type.
+    Did you mean to add parentheses?
+      !(Foo a)
diff --git a/testsuite/tests/parser/should_fail/all.T b/testsuite/tests/parser/should_fail/all.T
index 960144c9cb..1ae1abb709 100644
--- a/testsuite/tests/parser/should_fail/all.T
+++ b/testsuite/tests/parser/should_fail/all.T
@@ -129,3 +129,7 @@ test('typeops_B', normal, compile_fail, [''])
 test('typeops_C', normal, compile_fail, [''])
 test('typeops_D', normal, compile_fail, [''])
 test('T15053', normal, compile_fail, [''])
+test('typeopsDataCon_A', normal, compile_fail, [''])
+test('typeopsDataCon_B', normal, compile_fail, [''])
+test('strictnessDataCon_A', normal, compile_fail, [''])
+test('strictnessDataCon_B', normal, compile_fail, [''])
diff --git a/testsuite/tests/parser/should_fail/strictnessDataCon_A.hs b/testsuite/tests/parser/should_fail/strictnessDataCon_A.hs
new file mode 100644
index 0000000000..43851c9b27
--- /dev/null
+++ b/testsuite/tests/parser/should_fail/strictnessDataCon_A.hs
@@ -0,0 +1 @@
+type T = MkT { a :: ! + Int }
diff --git a/testsuite/tests/parser/should_fail/strictnessDataCon_A.stderr b/testsuite/tests/parser/should_fail/strictnessDataCon_A.stderr
new file mode 100644
index 0000000000..99d1eb88ec
--- /dev/null
+++ b/testsuite/tests/parser/should_fail/strictnessDataCon_A.stderr
@@ -0,0 +1,3 @@
+
+strictnessDataCon_A.hs:1:21: error:
+    Strictness annotation cannot appear in this position.
diff --git a/testsuite/tests/parser/should_fail/strictnessDataCon_B.hs b/testsuite/tests/parser/should_fail/strictnessDataCon_B.hs
new file mode 100644
index 0000000000..58ba137bee
--- /dev/null
+++ b/testsuite/tests/parser/should_fail/strictnessDataCon_B.hs
@@ -0,0 +1 @@
+type T = MkT { a :: {-# UNPACK #-} + Int }
diff --git a/testsuite/tests/parser/should_fail/strictnessDataCon_B.stderr b/testsuite/tests/parser/should_fail/strictnessDataCon_B.stderr
new file mode 100644
index 0000000000..7b5e239a53
--- /dev/null
+++ b/testsuite/tests/parser/should_fail/strictnessDataCon_B.stderr
@@ -0,0 +1,3 @@
+
+strictnessDataCon_B.hs:1:21: error:
+    {-# UNPACK #-} cannot appear in this position.
diff --git a/testsuite/tests/parser/should_fail/typeopsDataCon_A.hs b/testsuite/tests/parser/should_fail/typeopsDataCon_A.hs
new file mode 100644
index 0000000000..e334c2d1bb
--- /dev/null
+++ b/testsuite/tests/parser/should_fail/typeopsDataCon_A.hs
@@ -0,0 +1 @@
+data T = Int :+ Int :+ Int
diff --git a/testsuite/tests/parser/should_fail/typeopsDataCon_A.stderr b/testsuite/tests/parser/should_fail/typeopsDataCon_A.stderr
new file mode 100644
index 0000000000..a4f089654e
--- /dev/null
+++ b/testsuite/tests/parser/should_fail/typeopsDataCon_A.stderr
@@ -0,0 +1,4 @@
+
+typeopsDataCon_A.hs:1:10: error:
+    Cannot parse an infix data constructor in a data/newtype declaration:
+      Int :+ Int :+ Int
diff --git a/testsuite/tests/parser/should_fail/typeopsDataCon_B.hs b/testsuite/tests/parser/should_fail/typeopsDataCon_B.hs
new file mode 100644
index 0000000000..aa85c2e645
--- /dev/null
+++ b/testsuite/tests/parser/should_fail/typeopsDataCon_B.hs
@@ -0,0 +1 @@
+data T = Int + Int
diff --git a/testsuite/tests/parser/should_fail/typeopsDataCon_B.stderr b/testsuite/tests/parser/should_fail/typeopsDataCon_B.stderr
new file mode 100644
index 0000000000..16dd0a8d0b
--- /dev/null
+++ b/testsuite/tests/parser/should_fail/typeopsDataCon_B.stderr
@@ -0,0 +1,2 @@
+
+typeopsDataCon_B.hs:1:14: error: Not a data constructor: ‘+’