Whitespace-sensitive bang patterns (#1087, #17162)wip/whitespace-and-lookahead

This patch implements a part of GHC Proposal #229 that covers five
operators:

* the bang operator (!)
* the tilde operator (~)
* the at operator (@)
* the dollar operator ($)
* the double dollar operator ($$)

Based on surrounding whitespace, these operators are disambiguated into
bang patterns, lazy patterns, strictness annotations, type
applications, splices, and typed splices.

This patch doesn't cover the (-) operator or the -Woperator-whitespace
warning, which are left as future work.

21 files changed, 167 insertions, 19 deletions

diff --git a/testsuite/tests/parser/should_compile/Proposal229f_instances.hs b/testsuite/tests/parser/should_compile/Proposal229f_instances.hs
new file mode 100644
index 0000000000..2bd5a8ee19
--- /dev/null
+++ b/testsuite/tests/parser/should_compile/Proposal229f_instances.hs
@@ -0,0 +1,25 @@
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE TypeFamilies #-}
+
+module Proposal229f_instances where
+
+import GHC.Exts
+import Data.String
+import Language.Haskell.TH
+import Language.Haskell.TH.Syntax
+
+instance IsList (Q (TExp String)) where
+  type Item (Q (TExp String)) = Char
+  fromList = liftTyped
+  toList = undefined
+
+instance IsList (Q Exp) where
+  type Item (Q Exp) = Char
+  fromList = lift
+  toList = undefined
+
+instance IsString (Q (TExp String)) where
+  fromString = liftTyped
+
+instance IsString (Q Exp) where
+  fromString = lift
diff --git a/testsuite/tests/parser/should_compile/T1087.hs b/testsuite/tests/parser/should_compile/T1087.hs
new file mode 100644
index 0000000000..9ad85e2b7a
--- /dev/null
+++ b/testsuite/tests/parser/should_compile/T1087.hs
@@ -0,0 +1,14 @@
+{-# LANGUAGE BangPatterns #-}
+
+module T1087 where
+
+prefix_1 = let at a !b = False in at 1 2
+prefix_2 = let (.!.) a !b = False in 1 .!. 2
+
+infix_tilde_1 = let a `at` ~b = False in at 1 2
+infix_tilde_2 = let a .!. ~b = False in 1 .!. 2
+infix_tilde_3 = let ~a .!. b = False in 1 .!. 2
+
+infix_bang_1 = let a .!. !b = False in 1 .!. 2
+infix_bang_2 = let a `at` !b = False in at 1 2
+infix_bang_3 = let !a .!. b = False in 1 .!. 2
diff --git a/testsuite/tests/parser/should_compile/T16619.stderr b/testsuite/tests/parser/should_compile/T16619.stderr
new file mode 100644
index 0000000000..b5dfb89623
--- /dev/null
+++ b/testsuite/tests/parser/should_compile/T16619.stderr
@@ -0,0 +1,3 @@
+
+T16619.hs:2:12: warning:
+    -Wmissing-space-after-bang is deprecated: bang patterns can no longer be written with a space
diff --git a/testsuite/tests/parser/should_compile/all.T b/testsuite/tests/parser/should_compile/all.T
index 3d44e22510..91aae139ab 100644
--- a/testsuite/tests/parser/should_compile/all.T
+++ b/testsuite/tests/parser/should_compile/all.T
@@ -145,3 +145,20 @@ test('T16339', normal, compile, [''])
 test('T16619', req_th, multimod_compile, ['T16619', '-v0'])
 test('T504', normal, compile, [''])
 test('T515', literate, compile, ['-Wall'])
+test('T1087', normal, compile, [''])
+test('proposal-229a', normal, compile, [''])
+test('proposal-229b', normal, compile, [''])
+test('proposal-229d', normal, compile, [''])
+test('proposal-229e', normal, compile, [''])
+
+# We omit 'profasm' because it fails with:
+# Cannot load -prof objects when GHC is built with -dynamic
+#     To fix this, either:
+#       (1) Use -fexternal-interpreter, or
+#       (2) Build the program twice: once with -dynamic, and then
+#           with -prof using -osuf to set a different object file suffix.
+test('proposal-229f',
+     [ extra_files(['proposal-229f.hs', 'Proposal229f_instances.hs']),
+       omit_ways(['profasm', 'profthreaded'])
+     ],
+     multimod_compile_and_run, ['proposal-229f.hs', ''])
diff --git a/testsuite/tests/parser/should_compile/proposal-229a.hs b/testsuite/tests/parser/should_compile/proposal-229a.hs
new file mode 100644
index 0000000000..c773cee3a2
--- /dev/null
+++ b/testsuite/tests/parser/should_compile/proposal-229a.hs
@@ -0,0 +1,8 @@
+{-# LANGUAGE BangPatterns #-}
+
+module Proposal229a where
+
+data T a b = a :! b
+
+(!) :: x -> T a b -> (x, a, b)
+~u ! !(!m :! !n) = (u, m, n)
diff --git a/testsuite/tests/parser/should_compile/proposal-229b.hs b/testsuite/tests/parser/should_compile/proposal-229b.hs
new file mode 100644
index 0000000000..9182623e54
--- /dev/null
+++ b/testsuite/tests/parser/should_compile/proposal-229b.hs
@@ -0,0 +1,10 @@
+module Proposal229b ((~), (@)) where
+
+(~) :: a -> b -> (a, b)
+x ~ y = (x, y)
+
+(@) :: a -> b -> (a, b)
+x @ y = (x, y)
+
+r :: ((Bool, Bool), Bool)
+r = True ~ False @ True
diff --git a/testsuite/tests/parser/should_compile/proposal-229d.hs b/testsuite/tests/parser/should_compile/proposal-229d.hs
new file mode 100644
index 0000000000..24a57ca872
--- /dev/null
+++ b/testsuite/tests/parser/should_compile/proposal-229d.hs
@@ -0,0 +1,6 @@
+{-# LANGUAGE BangPatterns #-}
+
+module Proposal229d ((!)) where
+
+(!) :: a -> b -> (a, b)
+x ! y = (x,y)   -- parsed as an operator even with BangPatterns enabled
diff --git a/testsuite/tests/parser/should_compile/proposal-229e.hs b/testsuite/tests/parser/should_compile/proposal-229e.hs
new file mode 100644
index 0000000000..d7fc35d38e
--- /dev/null
+++ b/testsuite/tests/parser/should_compile/proposal-229e.hs
@@ -0,0 +1,18 @@
+{-# LANGUAGE BangPatterns #-}
+
+module Proposal229e ((!), f) where
+
+(!) :: Maybe a -> a -> (a, a)
+f :: a -> a
+
+-- the preceding '}' is not from a comment,
+-- so (!) is tight infix (therefore an operator)
+Nothing{}!x = (x, x)
+
+-- the following '{' opens a multi-line comment,
+-- so (!) is loose infix (therefore an operator)
+Just a !{-comment-}x = (a, x)
+
+-- the preceding '}' is closing a multi-line comment,
+-- so (!) is prefix (therefore a bang pattern)
+f{-comment-}!x = x
diff --git a/testsuite/tests/parser/should_compile/proposal-229f.hs b/testsuite/tests/parser/should_compile/proposal-229f.hs
new file mode 100644
index 0000000000..75b1341c6f
--- /dev/null
+++ b/testsuite/tests/parser/should_compile/proposal-229f.hs
@@ -0,0 +1,13 @@
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE OverloadedLists #-}
+
+import System.IO
+import Proposal229f_instances
+
+-- Testing that we can parse $[...] and $"..."
+main = do
+  hPutStrLn stderr $['1','2','3']
+  hPutStrLn stderr $$['1','2','3']
+  hPutStrLn stderr $"123"
+  hPutStrLn stderr $$"123"
diff --git a/testsuite/tests/parser/should_compile/proposal-229f.stderr b/testsuite/tests/parser/should_compile/proposal-229f.stderr
new file mode 100644
index 0000000000..310be0621c
--- /dev/null
+++ b/testsuite/tests/parser/should_compile/proposal-229f.stderr
@@ -0,0 +1,4 @@
+123
+123
+123
+123
diff --git a/testsuite/tests/parser/should_fail/T14588.stderr b/testsuite/tests/parser/should_fail/T14588.stderr
index cb64103814..2efd9561e8 100644
--- a/testsuite/tests/parser/should_fail/T14588.stderr
+++ b/testsuite/tests/parser/should_fail/T14588.stderr
@@ -1,4 +1,4 @@
 
 T14588.hs:3:19: error:
     Illegal bang-pattern (use BangPatterns):
-    ! x
+    !x
diff --git a/testsuite/tests/parser/should_fail/T16270.stderr b/testsuite/tests/parser/should_fail/T16270.stderr
index f4e90e40fc..a74bdeb8f0 100644
--- a/testsuite/tests/parser/should_fail/T16270.stderr
+++ b/testsuite/tests/parser/should_fail/T16270.stderr
@@ -1,4 +1,7 @@
 
+T16270.hs:2:12: warning:
+    -Werror=missing-space-after-bang is deprecated: bang patterns can no longer be written with a space
+
 T16270.hs:7:1: warning: [-Wtabs (in -Wdefault)]
     Tab character found here, and in five further locations.
     Please use spaces instead.
@@ -46,10 +49,9 @@ T16270.hs:23:10: error:
     Perhaps you intended to use GADTs or a similar language
     extension to enable syntax: data T where
 
-T16270.hs:25:12: error: [-Wmissing-space-after-bang (in -Wdefault), -Werror=missing-space-after-bang]
-    Did you forget to enable BangPatterns?
-    If you mean to bind (!) then perhaps you want
-    to add a space after the bang for clarity.
+T16270.hs:25:12: error:
+    Illegal bang-pattern (use BangPatterns):
+    !i
 
 T16270.hs:27:9: error:
     Multi-way if-expressions need MultiWayIf turned on
@@ -57,13 +59,13 @@ T16270.hs:27:9: error:
 T16270.hs:29:9: error:
     Multi-way if-expressions need MultiWayIf turned on
 
-T16270.hs:32:6: Illegal lambda-case (use LambdaCase)
+T16270.hs:32:6: error: Illegal lambda-case (use LambdaCase)
 
-T16270.hs:35:5:
+T16270.hs:35:5: error:
     Use NumericUnderscores to allow underscores in integer literals
 
-T16270.hs:37:5:
-    primitive string literal must contain only characters <= '/xFF'
+T16270.hs:37:5: error:
+    primitive string literal must contain only characters <= '\xFF'
 
 T16270.hs:43:1: error:
     parse error (possibly incorrect indentation or mismatched brackets)
diff --git a/testsuite/tests/parser/should_fail/T17162.hs b/testsuite/tests/parser/should_fail/T17162.hs
new file mode 100644
index 0000000000..6419da7544
--- /dev/null
+++ b/testsuite/tests/parser/should_fail/T17162.hs
@@ -0,0 +1,13 @@
+-- {-# LANGUAGE NoBangPatterns #-}
+
+module T17162 where
+
+charIsRepresentable :: TextEncoding -> Char -> IO Bool
+charIsRepresentable !enc c =
+  withCString enc [c]
+              (\cstr -> do str <- peekCString enc cstr
+                           case str of
+                             [ch] | ch == c -> pure True
+                             _ -> pure False)
+    `catch`
+       \(_ :: IOException) -> pure False
diff --git a/testsuite/tests/parser/should_fail/T17162.stderr b/testsuite/tests/parser/should_fail/T17162.stderr
new file mode 100644
index 0000000000..d621e08ccc
--- /dev/null
+++ b/testsuite/tests/parser/should_fail/T17162.stderr
@@ -0,0 +1,4 @@
+
+T17162.hs:6:21: error:
+    Illegal bang-pattern (use BangPatterns):
+    !enc
diff --git a/testsuite/tests/parser/should_fail/T3811b.stderr b/testsuite/tests/parser/should_fail/T3811b.stderr
index f4e44c603c..65de1d5a75 100644
--- a/testsuite/tests/parser/should_fail/T3811b.stderr
+++ b/testsuite/tests/parser/should_fail/T3811b.stderr
@@ -1,4 +1,4 @@
 
 T3811b.hs:4:14: error:
     Cannot parse data constructor in a data/newtype declaration:
-      ! B
+      !B
diff --git a/testsuite/tests/parser/should_fail/T3811c.stderr b/testsuite/tests/parser/should_fail/T3811c.stderr
index 431318e268..52f081bbe6 100644
--- a/testsuite/tests/parser/should_fail/T3811c.stderr
+++ b/testsuite/tests/parser/should_fail/T3811c.stderr
@@ -1,5 +1,6 @@
 
-T3811c.hs:6:11: error:
-    Strictness annotation applied to a compound type.
-    Did you mean to add parentheses?
-      !(Show D)
+T3811c.hs:6:10: error:
+    Illegal class instance: ‘!Show D’
+      Class instances must be of the form
+        context => C ty_1 ... ty_n
+      where ‘C’ is a class
diff --git a/testsuite/tests/parser/should_fail/T3811f.stderr b/testsuite/tests/parser/should_fail/T3811f.stderr
index 2d31fa86cf..783a89e284 100644
--- a/testsuite/tests/parser/should_fail/T3811f.stderr
+++ b/testsuite/tests/parser/should_fail/T3811f.stderr
@@ -1,5 +1,3 @@
 
-T3811f.hs:4:8: error:
-    Strictness annotation applied to a compound type.
-    Did you mean to add parentheses?
-      !(Foo a)
+T3811f.hs:4:7: error:
+    Malformed head of type or class declaration: !Foo a
diff --git a/testsuite/tests/parser/should_fail/all.T b/testsuite/tests/parser/should_fail/all.T
index 2fc7f3d326..c4a7a4f67b 100644
--- a/testsuite/tests/parser/should_fail/all.T
+++ b/testsuite/tests/parser/should_fail/all.T
@@ -161,3 +161,5 @@ test('patFail006', normal, compile_fail, [''])
 test('patFail007', normal, compile_fail, [''])
 test('patFail008', normal, compile_fail, [''])
 test('patFail009', normal, compile_fail, [''])
+test('T17162', normal, compile_fail, [''])
+test('proposal-229c', normal, compile_fail, [''])
diff --git a/testsuite/tests/parser/should_fail/proposal-229c.hs b/testsuite/tests/parser/should_fail/proposal-229c.hs
new file mode 100644
index 0000000000..344311b2a1
--- /dev/null
+++ b/testsuite/tests/parser/should_fail/proposal-229c.hs
@@ -0,0 +1,6 @@
+{-# LANGUAGE NoBangPatterns #-}
+
+module Proposal229c (f) where
+
+-- should recommend to enable BangPatterns instead of parsing as an infix operator
+f !x = x
diff --git a/testsuite/tests/parser/should_fail/proposal-229c.stderr b/testsuite/tests/parser/should_fail/proposal-229c.stderr
new file mode 100644
index 0000000000..965801a3c3
--- /dev/null
+++ b/testsuite/tests/parser/should_fail/proposal-229c.stderr
@@ -0,0 +1,4 @@
+
+proposal-229c.hs:6:3: error:
+    Illegal bang-pattern (use BangPatterns):
+    !x
diff --git a/testsuite/tests/parser/should_fail/strictnessDataCon_A.stderr b/testsuite/tests/parser/should_fail/strictnessDataCon_A.stderr
index c02d2ee974..27e6c709a5 100644
--- a/testsuite/tests/parser/should_fail/strictnessDataCon_A.stderr
+++ b/testsuite/tests/parser/should_fail/strictnessDataCon_A.stderr
@@ -1,3 +1,3 @@
 
 strictnessDataCon_A.hs:1:27: error:
-    Strictness annotation cannot appear in this position.
+    Operator applied to too few arguments: !