Whitespace-sensitive bang patterns (#1087, #17162)

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

* the bang operator (!)
* the tilde operator (~)
* the at operator (@)

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

This patch does NOT cover ($), ($$), and (-), which are left as future
work.

Metric Increase:
    parsing001
    Naperian
    T4801
Metric Increase (test_env='i386-linux-deb9'):
    haddock.base
    haddock.Cabal
    haddock.compiler
    T14683

33 files changed, 429 insertions, 330 deletions

diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index 70f50f2a8b..f21f4ccf38 100644
--- a/compiler/main/DynFlags.hs
+++ b/compiler/main/DynFlags.hs
@@ -4136,7 +4136,8 @@ wWarningFlagsDeps = [
   flagSpec "unrecognised-warning-flags"  Opt_WarnUnrecognisedWarningFlags,
   flagSpec "star-binder"                 Opt_WarnStarBinder,
   flagSpec "star-is-type"                Opt_WarnStarIsType,
-  flagSpec "missing-space-after-bang"    Opt_WarnSpaceAfterBang,
+  depFlagSpec "missing-space-after-bang" Opt_WarnSpaceAfterBang
+    "bang patterns can no longer be written with a space",
   flagSpec "partial-fields"              Opt_WarnPartialFields,
   flagSpec "prepositive-qualified-module"
                                          Opt_WarnPrepositiveQualifiedModule,
diff --git a/compiler/parser/Lexer.x b/compiler/parser/Lexer.x
index 2ada289db4..1a61aac18d 100644
--- a/compiler/parser/Lexer.x
+++ b/compiler/parser/Lexer.x
@@ -204,7 +204,7 @@ haskell :-
 -- Alex "Rules"
 
 -- everywhere: skip whitespace
-$white_no_nl+ ;
+$white_no_nl+ { whitespace }
 $tab          { warnTab }
 
 -- Everywhere: deal with nested comments.  We explicitly rule out
@@ -264,11 +264,11 @@ $tab          { warnTab }
 -- as a nested comment.  We don't bother with this: if the line begins
 -- with {-#, then we'll assume it's a pragma we know about and go for do_bol.
 <bol> {
-  \n                                    ;
+  \n                                    { whitespace }
   ^\# line                              { begin line_prag1 }
   ^\# / { followedByDigit }             { begin line_prag1 }
-  ^\# pragma .* \n                      ; -- GCC 3.3 CPP generated, apparently
-  ^\# \! .* \n                          ; -- #!, for scripts
+  ^\# pragma .* \n                      { whitespace } -- GCC 3.3 CPP generated, apparently
+  ^\# \! .* \n                          { whitespace } -- #!, for scripts
   ()                                    { do_bol }
 }
 
@@ -278,7 +278,7 @@ $tab          { warnTab }
 <layout, layout_do, layout_if> {
   \{ / { notFollowedBy '-' }            { hopefully_open_brace }
         -- we might encounter {-# here, but {- has been handled already
-  \n                                    ;
+  \n                                    { whitespace }
   ^\# (line)?                           { begin line_prag1 }
 }
 
@@ -398,14 +398,6 @@ $tab          { warnTab }
     { token (ITcloseQuote UnicodeSyntax) }
 }
 
-  -- See Note [Lexing type applications]
-<0> {
-    [^ $idchar \) ] ^
-  "@"
-    / { ifExtension TypeApplicationsBit `alexAndPred` notFollowedBySymbol }
-    { token ITtypeApp }
-}
-
 <0> {
   "(|"
     / { ifExtension ArrowsBit `alexAndPred`
@@ -561,13 +553,6 @@ $tab          { warnTab }
 -- expressions and patterns use the same parser, and also because we want
 -- to allow type patterns within expression patterns.
 --
--- Disambiguation is accomplished by requiring *something* to appear between
--- type application and the preceding token. This something must end with
--- a character that cannot be the end of the variable bound in an as-pattern.
--- Currently (June 2015), this means that the something cannot end with a
--- $idchar or a close-paren. (The close-paren is necessary if the as-bound
--- identifier is symbolic.)
---
 -- Note that looking for whitespace before the '@' is insufficient, because
 -- of this pathological case:
 --
@@ -860,6 +845,94 @@ reservedWordsFM = listToUFM $
          ( "proc",           ITproc,          xbit ArrowsBit)
      ]
 
+data TokenSort =
+  TokenSort {
+    tok_sort_opening :: !Bool,
+    tok_sort_closing :: !Bool
+  } deriving (Show)
+
+opening_token_sort, closing_token_sort,
+  opening_closing_token_sort, default_token_sort :: TokenSort
+default_token_sort = TokenSort False False
+opening_token_sort = default_token_sort { tok_sort_opening = True }
+closing_token_sort = default_token_sort { tok_sort_closing = True }
+opening_closing_token_sort = TokenSort True True
+
+get_token_sort :: Token -> TokenSort
+
+-- Opening tokens:
+--   ( [ { [: (# (| [| [p| [t| [d| [||
+get_token_sort IToparen             = opening_token_sort
+get_token_sort ITobrack             = opening_token_sort
+get_token_sort ITocurly             = opening_token_sort
+get_token_sort ITopabrack           = opening_token_sort
+get_token_sort IToubxparen          = opening_token_sort
+get_token_sort (IToparenbar _)      = opening_token_sort
+get_token_sort (ITopenExpQuote _ _) = opening_token_sort
+get_token_sort ITopenPatQuote       = opening_token_sort
+get_token_sort ITopenTypQuote       = opening_token_sort
+get_token_sort ITopenDecQuote       = opening_token_sort
+get_token_sort (ITopenTExpQuote _)  = opening_token_sort
+
+-- Closing tokens:
+--   ) ] } :] #) |) |] ||]
+--   ?ipvar #lbl
+get_token_sort ITcparen             = closing_token_sort
+get_token_sort ITcbrack             = closing_token_sort
+get_token_sort ITccurly             = closing_token_sort
+get_token_sort ITcpabrack           = closing_token_sort
+get_token_sort ITcubxparen          = closing_token_sort
+get_token_sort (ITcparenbar _)      = closing_token_sort
+get_token_sort (ITcloseQuote _)     = closing_token_sort
+get_token_sort ITcloseTExpQuote     = closing_token_sort
+get_token_sort (ITdupipvarid _)     = closing_token_sort
+get_token_sort (ITlabelvarid _)     = closing_token_sort
+
+-- Opening and closing at the same time:
+--   varid ConId % :% Q.varid Q.ConId Q.% Q.:% _ ' '' `
+--   'x' "str" 55 0.3 'x'# "str"# 5# 5## 0.3# 0.3##
+get_token_sort (ITvarid  _)       = opening_closing_token_sort
+get_token_sort (ITconid  _)       = opening_closing_token_sort
+get_token_sort (ITvarsym _)       = opening_closing_token_sort
+get_token_sort (ITconsym _)       = opening_closing_token_sort
+get_token_sort (ITqvarid _)       = opening_closing_token_sort
+get_token_sort (ITqconid _)       = opening_closing_token_sort
+get_token_sort (ITqvarsym _)      = opening_closing_token_sort
+get_token_sort (ITqconsym _)      = opening_closing_token_sort
+get_token_sort ITunderscore       = opening_closing_token_sort
+get_token_sort ITsimpleQuote      = opening_closing_token_sort
+get_token_sort ITtyQuote          = opening_closing_token_sort
+get_token_sort ITbackquote        = opening_closing_token_sort
+get_token_sort (ITchar _ _)       = opening_closing_token_sort
+get_token_sort (ITstring _ _)     = opening_closing_token_sort
+get_token_sort (ITinteger _)      = opening_closing_token_sort
+get_token_sort (ITrational _)     = opening_closing_token_sort
+get_token_sort (ITprimchar _ _)   = opening_closing_token_sort
+get_token_sort (ITprimstring _ _) = opening_closing_token_sort
+get_token_sort (ITprimint _ _)    = opening_closing_token_sort
+get_token_sort (ITprimword _ _)   = opening_closing_token_sort
+get_token_sort (ITprimfloat _)    = opening_closing_token_sort
+get_token_sort (ITprimdouble _)   = opening_closing_token_sort
+
+-- pseudo-keywords
+get_token_sort ITas         = opening_closing_token_sort
+get_token_sort IThiding     = opening_closing_token_sort
+get_token_sort ITqualified  = opening_closing_token_sort
+get_token_sort ITfamily     = opening_closing_token_sort
+get_token_sort ITrole       = opening_closing_token_sort
+get_token_sort ITstock      = opening_closing_token_sort
+get_token_sort ITanyclass   = opening_closing_token_sort
+get_token_sort ITvia        = opening_closing_token_sort
+get_token_sort ITunit       = opening_closing_token_sort
+get_token_sort ITdependency = opening_closing_token_sort
+get_token_sort ITsignature  = opening_closing_token_sort
+
+-- in patterns, we can write:  forall@(HsForAllTy ...)
+get_token_sort (ITforall NormalSyntax) = opening_closing_token_sort
+
+-- Neither opening nor closing
+get_token_sort _ = default_token_sort
+
 {-----------------------------------
 Note [Lexing type pseudo-keywords]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -889,11 +962,8 @@ reservedSymsFM = listToUFM $
        ,("|",   ITvbar,                     NormalSyntax,  0 )
        ,("<-",  ITlarrow NormalSyntax,      NormalSyntax,  0 )
        ,("->",  ITrarrow NormalSyntax,      NormalSyntax,  0 )
-       ,("@",   ITat,                       NormalSyntax,  0 )
-       ,("~",   ITtilde,                    NormalSyntax,  0 )
        ,("=>",  ITdarrow NormalSyntax,      NormalSyntax,  0 )
        ,("-",   ITminus,                    NormalSyntax,  0 )
-       ,("!",   ITbang,                     NormalSyntax,  0 )
 
        ,("*",   ITstar NormalSyntax,        NormalSyntax,  xbit StarIsTypeBit)
 
@@ -1083,9 +1153,12 @@ multiline_doc_comment span buf _len = withLexedDocType (worker "")
           Nothing -> input
 
 lineCommentToken :: Action
-lineCommentToken span buf len = do
-  b <- getBit RawTokenStreamBit
-  if b then strtoken ITlineComment span buf len else lexToken
+lineCommentToken span buf len =
+  lookaheadShortCircuit dummy_tok $ do
+    b <- getBit RawTokenStreamBit
+    if b then strtoken ITlineComment span buf len else lexToken
+  where
+    dummy_tok = L span (ITlineComment "")
 
 {-
   nested comments require traversing by hand, they can't be parsed
@@ -1099,7 +1172,8 @@ nested_comment cont span buf len = do
     go commentAcc 0 input = do
       setInput input
       b <- getBit RawTokenStreamBit
-      if b
+      lookahead <- getBit InLookaheadBit
+      if lookahead || b
         then docCommentEnd input commentAcc ITblockComment buf span
         else cont
     go commentAcc n input = case alexGetChar' input of
@@ -1348,11 +1422,31 @@ qvarsym, qconsym :: StringBuffer -> Int -> Token
 qvarsym buf len = ITqvarsym $! splitQualName buf len False
 qconsym buf len = ITqconsym $! splitQualName buf len False
 
-varsym, consym :: Action
-varsym = sym ITvarsym
-consym = sym ITconsym
-
-sym :: (FastString -> Token) -> Action
+varsym :: Action
+varsym = sym $ \s -> do
+  exts <- getExts
+  ltk_sort <- getLastTokenSort
+  ntk_sort <-
+    P $ \sBeforeLookahead ->
+      case unP (setLookaheadBit *> lexToken) sBeforeLookahead of
+        PFailed sFailed -> PFailed sFailed
+        POk sAfterLookahead _ntk ->
+          POk sBeforeLookahead (last_tk_sort sAfterLookahead)
+  let varsym_occ_sort = varsym_occurrence_sort ltk_sort ntk_sort
+  return (varsym_override exts varsym_occ_sort s)
+
+setLookaheadBit :: P ()
+setLookaheadBit = setExts (.|. xbit InLookaheadBit)
+
+lookaheadShortCircuit :: RealLocated Token -> P (RealLocated Token) -> P (RealLocated Token)
+lookaheadShortCircuit tok cont = do
+  lookahead <- getBit InLookaheadBit
+  if lookahead then return tok else cont
+
+consym :: Action
+consym = sym (return . ITconsym)
+
+sym :: (FastString -> P Token) -> Action
 sym con span buf len =
   case lookupUFM reservedSymsFM fs of
     Just (keyword, NormalSyntax, 0) ->
@@ -1361,19 +1455,19 @@ sym con span buf len =
       exts <- getExts
       if exts .&. i /= 0
         then return $ L span keyword
-        else return $ L span (con fs)
+        else L span <$> con fs
     Just (keyword, UnicodeSyntax, 0) -> do
       exts <- getExts
       if xtest UnicodeSyntaxBit exts
         then return $ L span keyword
-        else return $ L span (con fs)
+        else L span <$> con fs
     Just (keyword, UnicodeSyntax, i) -> do
       exts <- getExts
       if exts .&. i /= 0 && xtest UnicodeSyntaxBit exts
         then return $ L span keyword
-        else return $ L span (con fs)
+        else L span <$> con fs
     Nothing ->
-      return $ L span $! con fs
+      L span <$!> con fs
   where
     !fs = lexemeToFastString buf len
 
@@ -1610,7 +1704,7 @@ lex_string_prag mkTok span _buf _len
 -- This stuff is horrible.  I hates it.
 
 lex_string_tok :: Action
-lex_string_tok span buf _len = do
+lex_string_tok span buf _len = lookaheadShortCircuit dummy_tok $ do
   tok <- lex_string ""
   (AI end bufEnd) <- getInput
   let
@@ -1620,6 +1714,8 @@ lex_string_tok span buf _len = do
             _ -> panic "lex_string_tok"
     src = lexemeToString buf (cur bufEnd - cur buf)
   return (L (mkRealSrcSpan (realSrcSpanStart span) end) tok')
+  where
+    dummy_tok = L span (ITstring (SourceText "") (mkFastString ""))
 
 lex_string :: String -> P Token
 lex_string s = do
@@ -1869,7 +1965,7 @@ lex_qquasiquote_tok span buf len = do
                            mkRealSrcSpan quoteStart end)))
 
 lex_quasiquote_tok :: Action
-lex_quasiquote_tok span buf len = do
+lex_quasiquote_tok span buf len = lookaheadShortCircuit dummy_tok $ do
   let quoter = tail (lexemeToString buf (len - 1))
                 -- 'tail' drops the initial '[',
                 -- while the -1 drops the trailing '|'
@@ -1880,6 +1976,8 @@ lex_quasiquote_tok span buf len = do
            (ITquasiQuote (mkFastString quoter,
                           mkFastString (reverse quote),
                           mkRealSrcSpan quoteStart end)))
+  where
+    dummy_tok = L span (ITquasiQuote (mkFastString "", mkFastString "", span))
 
 lex_quasiquote :: RealSrcLoc -> String -> P String
 lex_quasiquote start s = do
@@ -1904,12 +2002,29 @@ quasiquote_error start = do
   reportLexError start end buf "unterminated quasiquotation"
 
 -- -----------------------------------------------------------------------------
+-- Whitespace
+
+whitespace :: Action
+whitespace srcspan _buf _len =
+  P $ \s ->
+    if InLookaheadBit `xtest` pExtsBitmap (options s)
+    then POk s{ last_tk_sort = default_token_sort } (L srcspan tok)
+    else unP lexToken s{ last_tk_sort = default_token_sort }
+  where
+    -- We don't have a dedicated token for whitespace,
+    -- but ITeof will do fine. We only care that:
+    --
+    --   get_token_sort tok = default_token_sort
+    --
+    tok = ITeof
+
+-- -----------------------------------------------------------------------------
 -- Warnings
 
 warnTab :: Action
-warnTab srcspan _buf _len = do
+warnTab srcspan buf len = do
     addTabWarning srcspan
-    lexToken
+    whitespace srcspan buf len
 
 warnThen :: WarningFlag -> SDoc -> Action -> Action
 warnThen option warning action srcspan buf len = do
@@ -1967,7 +2082,8 @@ data PState = PState {
         messages   :: DynFlags -> Messages,
         tab_first  :: Maybe RealSrcSpan, -- pos of first tab warning in the file
         tab_count  :: !Int,              -- number of tab warnings in the file
-        last_tk    :: Maybe Token,
+        last_tk    :: !(Maybe Token),
+        last_tk_sort :: !TokenSort,
         last_loc   :: RealSrcSpan, -- pos of previous token
         last_len   :: !Int,        -- len of previous token
         loc        :: RealSrcLoc,  -- current loc (end of prev token + 1)
@@ -2083,12 +2199,12 @@ setLastToken loc len = P $ \s -> POk s {
   last_len=len
   } ()
 
-setLastTk :: Token -> P ()
-setLastTk tk = P $ \s -> POk s { last_tk = Just tk } ()
-
 getLastTk :: P (Maybe Token)
 getLastTk = P $ \s@(PState { last_tk = last_tk }) -> POk s last_tk
 
+getLastTokenSort :: P TokenSort
+getLastTokenSort = P $ \s -> POk s (last_tk_sort s)
+
 data AlexInput = AI RealSrcLoc StringBuffer
 
 {-
@@ -2339,6 +2455,7 @@ data ExtBits
   -- Flags that are updated once parsing starts
   | InRulePragBit
   | InNestedCommentBit -- See Note [Nested comment line pragmas]
+  | InLookaheadBit
   | UsePosPragsBit
     -- ^ If this is enabled, '{-# LINE ... -#}' and '{-# COLUMN ... #-}'
     -- update the internal position. Otherwise, those pragmas are lexed as
@@ -2458,6 +2575,7 @@ mkPStatePure options buf loc =
       messages      = const emptyMessages,
       tab_first     = Nothing,
       tab_count     = 0,
+      last_tk_sort  = default_token_sort,
       last_tk       = Nothing,
       last_loc      = mkRealSrcSpan loc loc,
       last_len      = 0,
@@ -2933,24 +3051,56 @@ lexToken = do
     AlexEOF -> do
         let span = mkRealSrcSpan loc1 loc1
         setLastToken span 0
-        return (L span ITeof)
+        P $ \s -> POk s{ last_tk_sort = default_token_sort } (L span ITeof)
     AlexError (AI loc2 buf) ->
         reportLexError loc1 loc2 buf "lexical error"
-    AlexSkip inp2 _ -> do
-        setInput inp2
-        lexToken
+    AlexSkip _ _ ->
+      -- if this happens, check that all rules have an action associated with them
+      panic "lexToken: AlexSkip"
     AlexToken inp2@(AI end buf2) _ t -> do
         setInput inp2
         let span = mkRealSrcSpan loc1 end
         let bytes = byteDiff buf buf2
         span `seq` setLastToken span bytes
         lt <- t span buf bytes
-        case unRealSrcSpan lt of
-          ITlineComment _  -> return lt
-          ITblockComment _ -> return lt
-          lt' -> do
-            setLastTk lt'
-            return lt
+        let lt' = unRealSrcSpan lt
+        P $ \s ->
+          POk s{ last_tk = if isComment lt' then last_tk s else Just lt'
+               , last_tk_sort = get_token_sort lt' }
+              lt
+
+data VarsymOccurrenceSort
+  = VarsymPrefix
+  | VarsymSuffix
+  | VarsymTightInfix
+  | VarsymLooseInfix
+  deriving (Eq, Show)
+
+varsym_occurrence_sort :: TokenSort -> TokenSort -> VarsymOccurrenceSort
+varsym_occurrence_sort prev_tok next_tok =
+    check (tok_sort_closing prev_tok) (tok_sort_opening next_tok)
+  where
+    check False True  = VarsymPrefix
+    check True  False = VarsymSuffix
+    check True  True  = VarsymTightInfix
+    check False False = VarsymLooseInfix
+
+varsym_override :: ExtsBitmap -> VarsymOccurrenceSort -> FastString -> Token
+varsym_override _ occ_sort s | s == fsLit "@" =
+  case occ_sort of
+    VarsymPrefix -> ITtypeApp -- Note [Lexing type applications]
+    VarsymSuffix -> ITat
+    VarsymTightInfix -> ITat
+    VarsymLooseInfix -> ITvarsym s
+varsym_override _ occ_sort s | s == fsLit "!" =
+  case occ_sort of
+    VarsymPrefix -> ITbang
+    _ -> ITvarsym s
+varsym_override _ occ_sort s | s == fsLit "~" =
+  case occ_sort of
+    VarsymPrefix -> ITtilde
+    _ -> ITvarsym s
+varsym_override _ _ s = ITvarsym s
 
 reportLexError :: RealSrcLoc -> RealSrcLoc -> StringBuffer -> [Char] -> P a
 reportLexError loc1 loc2 buf str
diff --git a/compiler/parser/Parser.y b/compiler/parser/Parser.y
index 5fea8646a4..e969e31e1e 100644
--- a/compiler/parser/Parser.y
+++ b/compiler/parser/Parser.y
@@ -93,7 +93,7 @@ import Util             ( looksLikePackageName, fstOf3, sndOf3, thdOf3 )
 import GhcPrelude
 }
 
-%expect 236 -- shift/reduce conflicts
+%expect 237 -- shift/reduce conflicts
 
 {- Last updated: 04 June 2018
 
@@ -542,10 +542,10 @@ are the most common patterns, rewritten as regular expressions for clarity:
  '<-'           { L _ (ITlarrow _) }
  '->'           { L _ (ITrarrow _) }
  '@'            { L _ ITat }
- '~'            { L _ ITtilde }
  '=>'           { L _ (ITdarrow _) }
  '-'            { L _ ITminus }
- '!'            { L _ ITbang }
+ PREFIX_TILDE   { L _ ITtilde }
+ PREFIX_BANG    { L _ ITbang }
  '*'            { L _ (ITstar _) }
  '-<'           { L _ (ITlarrowtail _) }            -- for arrow notation
  '>-'           { L _ (ITrarrowtail _) }            -- for arrow notation
@@ -647,8 +647,6 @@ identifier :: { Located RdrName }
         | qconop                        { $1 }
     | '(' '->' ')'      {% ams (sLL $1 $> $ getRdrName funTyCon)
                                [mop $1,mu AnnRarrow $2,mcp $3] }
-    | '(' '~' ')'       {% ams (sLL $1 $> $ eqTyCon_RDR)
-                               [mop $1,mj AnnTilde $2,mcp $3] }
 
 -----------------------------------------------------------------------------
 -- Backpack stuff
@@ -1681,13 +1679,22 @@ rule_activation :: { ([AddAnn],Maybe Activation) }
         : {- empty -}                           { ([],Nothing) }
         | rule_explicit_activation              { (fst $1,Just (snd $1)) }
 
+rule_activation_marker :: { [AddAnn] }
+      : PREFIX_TILDE { [mj AnnTilde $1] }
+      | VARSYM  {% if (getVARSYM $1 == fsLit "~")
+                   then return [mj AnnTilde $1]
+                   else do { addError (getLoc $1) $ text "Invalid rule activation marker"
+                           ; return [] } }
+
 rule_explicit_activation :: { ([AddAnn]
                               ,Activation) }  -- In brackets
         : '[' INTEGER ']'       { ([mos $1,mj AnnVal $2,mcs $3]
                                   ,ActiveAfter  (getINTEGERs $2) (fromInteger (il_value (getINTEGER $2)))) }
-        | '[' '~' INTEGER ']'   { ([mos $1,mj AnnTilde $2,mj AnnVal $3,mcs $4]
+        | '[' rule_activation_marker INTEGER ']'
+                                { ($2++[mos $1,mj AnnVal $3,mcs $4]
                                   ,ActiveBefore (getINTEGERs $3) (fromInteger (il_value (getINTEGER $3)))) }
-        | '[' '~' ']'           { ([mos $1,mj AnnTilde $2,mcs $3]
+        | '[' rule_activation_marker ']'
+                                { ($2++[mos $1,mcs $3]
                                   ,NeverActive) }
 
 rule_foralls :: { ([AddAnn], Maybe [LHsTyVarBndr GhcPs], [LRuleBndr GhcPs]) }
@@ -2027,9 +2034,7 @@ tyapps :: { [Located TyEl] } -- NB: This list is reversed
 tyapp :: { Located TyEl }
         : atype                         { sL1 $1 $ TyElOpd (unLoc $1) }
         | TYPEAPP atype                 { sLL $1 $> $ (TyElKindApp (comb2 $1 $2) $2) }
-        | qtyconop                      { sL1 $1 $ if isBangRdr (unLoc $1) then TyElBang else
-                                                   if isTildeRdr (unLoc $1) then TyElTilde else
-                                                   TyElOpr (unLoc $1) }
+        | qtyconop                      { sL1 $1 $ TyElOpr (unLoc $1) }
         | tyvarop                       { sL1 $1 $ TyElOpr (unLoc $1) }
         | SIMPLEQUOTE qconop            {% ams (sLL $1 $> $ TyElOpr (unLoc $2))
                                                [mj AnnSimpleQuote $1,mj AnnVal $2] }
@@ -2042,6 +2047,8 @@ atype :: { LHsType GhcPs }
         | tyvar                          { sL1 $1 (HsTyVar noExtField NotPromoted $1) }      -- (See Note [Unit tuples])
         | '*'                            {% do { warnStarIsType (getLoc $1)
                                                ; return $ sL1 $1 (HsStarTy noExtField (isUnicode $1)) } }
+        | PREFIX_TILDE atype             {% ams (sLL $1 $> (mkBangTy SrcLazy $2)) [mj AnnTilde $1] }
+        | PREFIX_BANG  atype             {% ams (sLL $1 $> (mkBangTy SrcStrict $2)) [mj AnnBang $1] }
         | '{' fielddecls '}'             {% amms (checkRecordSyntax
                                                     (sLL $1 $> $ HsRecTy noExtField $2))
                                                         -- Constructor sigs only
@@ -2411,25 +2418,8 @@ docdecld :: { LDocDecl }
 decl_no_th :: { LHsDecl GhcPs }
         : sigdecl               { $1 }
 
-        | '!' aexp rhs          {% runECP_P $2 >>= \ $2 ->
-                                   do { let { e = patBuilderBang (getLoc $1) $2
-                                            ; l = comb2 $1 $> };
-                                        (ann, r) <- checkValDef SrcStrict e Nothing $3 ;
-                                        runPV $ hintBangPat (comb2 $1 $2) (unLoc e) ;
-                                        -- Depending upon what the pattern looks like we might get either
-                                        -- a FunBind or PatBind back from checkValDef. See Note
-                                        -- [FunBind vs PatBind]
-                                        case r of {
-                                          (FunBind _ n _ _ _) ->
-                                                amsL l [mj AnnFunId n] >> return () ;
-                                          (PatBind _ (dL->L l _) _rhs _) ->
-                                                amsL l [] >> return () } ;
-
-                                        _ <- amsL l (ann ++ fst (unLoc $3) ++ [mj AnnBang $1]) ;
-                                        return $! (sL l $ ValD noExtField r) } }
-
         | infixexp_top opt_sig rhs  {% runECP_P $1 >>= \ $1 ->
-                                       do { (ann,r) <- checkValDef NoSrcStrict $1 (snd $2) $3;
+                                       do { (ann,r) <- checkValDef $1 (snd $2) $3;
                                         let { l = comb2 $1 $> };
                                         -- Depending upon what the pattern looks like we might get either
                                         -- a FunBind or PatBind back from checkValDef. See Note
@@ -2551,8 +2541,8 @@ activation :: { ([AddAnn],Maybe Activation) }
 explicit_activation :: { ([AddAnn],Activation) }  -- In brackets
         : '[' INTEGER ']'       { ([mj AnnOpenS $1,mj AnnVal $2,mj AnnCloseS $3]
                                   ,ActiveAfter  (getINTEGERs $2) (fromInteger (il_value (getINTEGER $2)))) }
-        | '[' '~' INTEGER ']'   { ([mj AnnOpenS $1,mj AnnTilde $2,mj AnnVal $3
-                                                 ,mj AnnCloseS $4]
+        | '[' rule_activation_marker INTEGER ']'
+                                { ($2++[mj AnnOpenS $1,mj AnnVal $3,mj AnnCloseS $4]
                                   ,ActiveBefore (getINTEGERs $3) (fromInteger (il_value (getINTEGER $3)))) }
 
 -----------------------------------------------------------------------------
@@ -2712,10 +2702,14 @@ aexp    :: { ECP }
             -- If you change the parsing, make sure to understand
             -- Note [Lexing type applications] in Lexer.x
 
-        | '~' aexp              { ECP $
+        | PREFIX_TILDE aexp     { ECP $
                                    runECP_PV $2 >>= \ $2 ->
                                    amms (mkHsLazyPatPV (comb2 $1 $>) $2) [mj AnnTilde $1] }
 
+        | PREFIX_BANG aexp      { ECP $
+                                   runECP_PV $2 >>= \ $2 ->
+                                   amms (mkHsBangPatPV (comb2 $1 $>) $2) [mj AnnBang $1] }
+
         | '\\' apat apats '->' exp
                    {  ECP $
                       runECP_PV $5 >>= \ $5 ->
@@ -3194,24 +3188,14 @@ gdpat   :: { forall b. DisambECP b => PV (LGRHS GhcPs (Located b)) }
 -- we parse them right when bang-patterns are off
 pat     :: { LPat GhcPs }
 pat     :  exp          {% (checkPattern <=< runECP_P) $1 }
-        | '!' aexp      {% runECP_P $2 >>= \ $2 ->
-                           amms (checkPattern (patBuilderBang (getLoc $1) $2))
-                                [mj AnnBang $1] }
 
 bindpat :: { LPat GhcPs }
 bindpat :  exp            {% -- See Note [Parser-Validator ReaderT SDoc] in RdrHsSyn
                              checkPattern_msg (text "Possibly caused by a missing 'do'?")
                                               (runECP_PV $1) }
-        | '!' aexp        {% -- See Note [Parser-Validator ReaderT SDoc] in RdrHsSyn
-                             amms (checkPattern_msg (text "Possibly caused by a missing 'do'?")
-                                     (patBuilderBang (getLoc $1) `fmap` runECP_PV $2))
-                                  [mj AnnBang $1] }
 
 apat   :: { LPat GhcPs }
 apat    : aexp                  {% (checkPattern <=< runECP_P) $1 }
-        | '!' aexp              {% runECP_P $2 >>= \ $2 ->
-                                   amms (checkPattern (patBuilderBang (getLoc $1) $2))
-                                        [mj AnnBang $1] }
 
 apats  :: { [LPat GhcPs] }
         : apat apats            { $1 : $2 }
@@ -3473,7 +3457,6 @@ oqtycon_no_varcon :: { Located RdrName }  -- Type constructor which cannot be mi
         | '(' ':' ')'        {% let { name :: Located RdrName
                                     ; name = sL1 $2 $! consDataCon_RDR }
                                 in ams (sLL $1 $> (unLoc name)) [mop $1,mj AnnVal name,mcp $3] }
-        | '(' '~' ')'        {% ams (sLL $1 $> $ eqTyCon_RDR) [mop $1,mj AnnTilde $2,mcp $3] }
 
 {- Note [Type constructors in export list]
 ~~~~~~~~~~~~~~~~~~~~~
@@ -3519,12 +3502,13 @@ qtyconsym :: { Located RdrName }
 
 tyconsym :: { Located RdrName }
         : CONSYM                { sL1 $1 $! mkUnqual tcClsName (getCONSYM $1) }
-        | VARSYM                { sL1 $1 $! mkUnqual tcClsName (getVARSYM $1) }
+        | VARSYM                { sL1 $1 $!
+                                    if getVARSYM $1 == fsLit "~"
+                                      then eqTyCon_RDR
+                                      else mkUnqual tcClsName (getVARSYM $1) }
         | ':'                   { sL1 $1 $! consDataCon_RDR }
         | '-'                   { sL1 $1 $! mkUnqual tcClsName (fsLit "-") }
-        | '!'                   { sL1 $1 $! mkUnqual tcClsName (fsLit "!") }
         | '.'                   { sL1 $1 $! mkUnqual tcClsName (fsLit ".") }
-        | '~'                   { sL1 $1 $ eqTyCon_RDR }
 
 
 -----------------------------------------------------------------------------
@@ -3534,7 +3518,6 @@ op      :: { Located RdrName }   -- used in infix decls
         : varop                 { $1 }
         | conop                 { $1 }
         | '->'                  { sL1 $1 $ getRdrName funTyCon }
-        | '~'                   { sL1 $1 $ eqTyCon_RDR }
 
 varop   :: { Located RdrName }
         : varsym                { $1 }
@@ -3677,8 +3660,7 @@ special_id
         | 'signature'           { sL1 $1 (fsLit "signature") }
 
 special_sym :: { Located FastString }
-special_sym : '!'       {% ams (sL1 $1 (fsLit "!")) [mj AnnBang $1] }
-            | '.'       { sL1 $1 (fsLit ".") }
+special_sym : '.'       { sL1 $1 (fsLit ".") }
             | '*'       { sL1 $1 (fsLit (starSym (isUnicode $1))) }
 
 -----------------------------------------------------------------------------
@@ -4015,10 +3997,6 @@ in ApiAnnotation.hs
 mj :: HasSrcSpan e => AnnKeywordId -> e -> AddAnn
 mj a l = AddAnn a (gl l)
 
-mjL :: AnnKeywordId -> SrcSpan -> AddAnn
-mjL = AddAnn
-
-
 
 -- |Construct an AddAnn from the annotation keyword and the Located Token. If
 -- the token has a unicode equivalent and this has been used, provide the
@@ -4101,12 +4079,12 @@ mcs ll = mj AnnCloseS ll
 -- |Given a list of the locations of commas, provide a [AddAnn] with an AnnComma
 --  entry for each SrcSpan
 mcommas :: [SrcSpan] -> [AddAnn]
-mcommas ss = map (mjL AnnCommaTuple) ss
+mcommas = map (AddAnn AnnCommaTuple)
 
 -- |Given a list of the locations of '|'s, provide a [AddAnn] with an AnnVbar
 --  entry for each SrcSpan
 mvbars :: [SrcSpan] -> [AddAnn]
-mvbars ss = map (mjL AnnVbar) ss
+mvbars = map (AddAnn AnnVbar)
 
 -- |Get the location of the last element of a OrdList, or noSrcSpan
 oll :: HasSrcSpan a => OrdList a -> SrcSpan
diff --git a/compiler/parser/RdrHsSyn.hs b/compiler/parser/RdrHsSyn.hs
index cb70078fd3..e149886633 100644
--- a/compiler/parser/RdrHsSyn.hs
+++ b/compiler/parser/RdrHsSyn.hs
@@ -56,8 +56,6 @@ module   RdrHsSyn (
         checkContext,         -- HsType -> P HsContext
         checkPattern,         -- HsExp -> P HsPat
         checkPattern_msg,
-        isBangRdr,
-        isTildeRdr,
         checkMonadComp,       -- P (HsStmtContext RdrName)
         checkValDef,          -- (SrcLoc, HsExp, HsRhs, [HsDecl]) -> P HsDecl
         checkValSigLhs,
@@ -68,6 +66,7 @@ module   RdrHsSyn (
         checkEmptyGADTs,
         addFatalError, hintBangPat,
         TyEl(..), mergeOps, mergeDataCon,
+        mkBangTy,
 
         -- Help with processing exports
         ImpExpSubSpec(..),
@@ -100,7 +99,6 @@ module   RdrHsSyn (
         ecpFromExp,
         ecpFromCmd,
         PatBuilder,
-        patBuilderBang,
 
     ) where
 
@@ -564,14 +562,13 @@ declarations and types as a reversed list of TyEl:
 
   data TyEl = TyElOpr RdrName
             | TyElOpd (HsType GhcPs)
-            | TyElBang | TyElTilde
             | ...
 
 For example, both occurences of (C ! D) in the following example are parsed
 into equal lists of TyEl:
 
   data T = C ! D => C ! D   results in   [ TyElOpd (HsTyVar "D")
-                                         , TyElBang
+                                         , TyElOpr "!"
                                          , TyElOpd (HsTyVar "C") ]
 
 Note that elements are in reverse order. Also, 'C' is parsed as a type
@@ -1088,12 +1085,6 @@ checkPat loc (dL->L l e@(PatBuilderVar (dL->L _ c))) args
   | not (null args) && patIsRec c =
       localPV_msg (\_ -> text "Perhaps you intended to use RecursiveDo") $
       patFail l (ppr e)
-checkPat loc e args     -- OK to let this happen even if bang-patterns
-                        -- are not enabled, because there is no valid
-                        -- non-bang-pattern parse of (C ! e)
-  | Just (e', args') <- splitBang e
-  = do  { args'' <- mapM checkLPat args'
-        ; checkPat loc e' (args'' ++ args) }
 checkPat loc (dL->L _ (PatBuilderApp f e)) args
   = do p <- checkLPat e
        checkPat loc f (p : args)
@@ -1115,12 +1106,6 @@ checkAPat loc e0 = do
    -- NB. Negative *primitive* literals are already handled by the lexer
    PatBuilderOverLit pos_lit -> return (mkNPat (cL loc pos_lit) Nothing)
 
-   PatBuilderBang lb e   -- (! x)
-        -> do { hintBangPat loc e0
-              ; e' <- checkLPat e
-              ; addAnnotation loc AnnBang lb
-              ; return  (BangPat noExtField e') }
-
    -- n+k patterns
    PatBuilderOpApp
            (dL->L nloc (PatBuilderVar (dL->L _ n)))
@@ -1148,11 +1133,6 @@ plus_RDR, pun_RDR :: RdrName
 plus_RDR = mkUnqual varName (fsLit "+") -- Hack
 pun_RDR  = mkUnqual varName (fsLit "pun-right-hand-side")
 
-isBangRdr, isTildeRdr :: RdrName -> Bool
-isBangRdr (Unqual occ) = occNameFS occ == fsLit "!"
-isBangRdr _ = False
-isTildeRdr = (==eqTyCon_RDR)
-
 checkPatField :: LHsRecField GhcPs (Located (PatBuilder GhcPs))
               -> PV (LHsRecField GhcPs (LPat GhcPs))
 checkPatField (dL->L l fld) = do p <- checkLPat (hsRecFieldArg fld)
@@ -1167,22 +1147,21 @@ patIsRec e = e == mkUnqual varName (fsLit "rec")
 ---------------------------------------------------------------------------
 -- Check Equation Syntax
 
-checkValDef :: SrcStrictness
-            -> Located (PatBuilder GhcPs)
+checkValDef :: Located (PatBuilder GhcPs)
             -> Maybe (LHsType GhcPs)
             -> Located (a,GRHSs GhcPs (LHsExpr GhcPs))
             -> P ([AddAnn],HsBind GhcPs)
 
-checkValDef _strictness lhs (Just sig) grhss
+checkValDef lhs (Just sig) grhss
         -- x :: ty = rhs  parses as a *pattern* binding
   = do lhs' <- runPV $ mkHsTySigPV (combineLocs lhs sig) lhs sig >>= checkLPat
        checkPatBind lhs' grhss
 
-checkValDef strictness lhs Nothing g@(dL->L l (_,grhss))
+checkValDef lhs Nothing g@(dL->L l (_,grhss))
   = do  { mb_fun <- isFunLhs lhs
         ; case mb_fun of
             Just (fun, is_infix, pats, ann) ->
-              checkFunBind strictness ann (getLoc lhs)
+              checkFunBind NoSrcStrict ann (getLoc lhs)
                            fun is_infix pats (cL l grhss)
             Nothing -> do
               lhs' <- checkPattern lhs
@@ -1222,9 +1201,22 @@ makeFunBind fn ms
               fun_co_fn = idHsWrapper,
               fun_tick = [] }
 
+-- See Note [FunBind vs PatBind]
 checkPatBind :: LPat GhcPs
              -> Located (a,GRHSs GhcPs (LHsExpr GhcPs))
              -> P ([AddAnn],HsBind GhcPs)
+checkPatBind lhs (dL->L match_span (_,grhss))
+    | BangPat _ p <- unLoc lhs
+    , VarPat _ v <- unLoc p
+    = return ([], makeFunBind v [cL match_span (m v)])
+  where
+    m v = Match { m_ext = noExtField
+                , m_ctxt = FunRhs { mc_fun    = cL (getLoc lhs) (unLoc v)
+                                  , mc_fixity = Prefix
+                                  , mc_strictness = SrcStrict }
+                , m_pats = []
+                , m_grhss = grhss }
+
 checkPatBind lhs (dL->L _ (_,grhss))
   = return ([],PatBind noExtField lhs grhss ([],[]))
 
@@ -1278,21 +1270,6 @@ checkDoAndIfThenElse guardExpr semiThen thenExpr semiElse elseExpr
                  text "then" <+> ppr thenExpr  <> pprOptSemi semiElse <+>
                  text "else" <+> ppr elseExpr
 
-
-        -- The parser left-associates, so there should
-        -- not be any OpApps inside the e's
-splitBang :: Located (PatBuilder GhcPs) -> Maybe (Located (PatBuilder GhcPs), [Located (PatBuilder GhcPs)])
--- Splits (f ! g a b) into (f, [(! g), a, b])
-splitBang (dL->L _ (PatBuilderOpApp l_arg op r_arg))
-  | isBangRdr (unLoc op)
-  = Just (l_arg, cL l' (PatBuilderBang (getLoc op) arg1) : argns)
-  where
-    l' = combineLocs op arg1
-    (arg1,argns) = split_bang r_arg []
-    split_bang (dL->L _ (PatBuilderApp f e)) es = split_bang f (e:es)
-    split_bang e                       es = (e,es)
-splitBang _ = Nothing
-
 -- See Note [isFunLhs vs mergeDataCon]
 isFunLhs :: Located (PatBuilder GhcPs)
       -> P (Maybe (Located RdrName, LexicalFixity, [Located (PatBuilder GhcPs)],[AddAnn]))
@@ -1314,31 +1291,7 @@ isFunLhs e = go e [] []
        | not (isRdrDataCon f)        = return (Just (cL loc f, Prefix, es, ann))
    go (dL->L _ (PatBuilderApp f e)) es       ann = go f (e:es) ann
    go (dL->L l (PatBuilderPar e))   es@(_:_) ann = go e es (ann ++ mkParensApiAnn l)
-
-        -- Things of the form `!x` are also FunBinds
-        -- See Note [FunBind vs PatBind]
-   go (dL->L _ (PatBuilderBang _ (L _ (PatBuilderVar (dL -> L l var))))) [] ann
-        | not (isRdrDataCon var)     = return (Just (cL l var, Prefix, [], ann))
-
-      -- For infix function defns, there should be only one infix *function*
-      -- (though there may be infix *datacons* involved too).  So we don't
-      -- need fixity info to figure out which function is being defined.
-      --      a `K1` b `op` c `K2` d
-      -- must parse as
-      --      (a `K1` b) `op` (c `K2` d)
-      -- The renamer checks later that the precedences would yield such a parse.
-      --
-      -- There is a complication to deal with bang patterns.
-      --
-      -- ToDo: what about this?
-      --              x + 1 `op` y = ...
-
-   go e@(L loc (PatBuilderOpApp l (dL->L loc' op) r)) es ann
-        | Just (e',es') <- splitBang e
-        = do { bang_on <- getBit BangPatBit
-             ; if bang_on then go e' (es' ++ es) ann
-               else return (Just (cL loc' op, Infix, (l:r:es), ann)) }
-                -- No bangs; behave just like the next case
+   go (dL->L loc (PatBuilderOpApp l (dL->L loc' op) r)) es ann
         | not (isRdrDataCon op)         -- We have found the function!
         = return (Just (cL loc' op, Infix, (l:r:es), ann))
         | otherwise                     -- Infix data con; keep going
@@ -1356,7 +1309,6 @@ isFunLhs e = go e [] []
 data TyEl = TyElOpr RdrName | TyElOpd (HsType GhcPs)
           | TyElKindApp SrcSpan (LHsType GhcPs)
           -- See Note [TyElKindApp SrcSpan interpretation]
-          | TyElTilde | TyElBang
           | TyElUnpackedness ([AddAnn], SourceText, SrcUnpackedness)
           | TyElDocPrev HsDocString
 
@@ -1379,40 +1331,22 @@ instance Outputable TyEl where
   ppr (TyElOpr name) = ppr name
   ppr (TyElOpd ty) = ppr ty
   ppr (TyElKindApp _ ki) = text "@" <> ppr ki
-  ppr TyElTilde = text "~"
-  ppr TyElBang = text "!"
   ppr (TyElUnpackedness (_, _, unpk)) = ppr unpk
   ppr (TyElDocPrev doc) = ppr doc
 
-tyElStrictness :: TyEl -> Maybe (AnnKeywordId, SrcStrictness)
-tyElStrictness TyElTilde = Just (AnnTilde, SrcLazy)
-tyElStrictness TyElBang = Just (AnnBang, SrcStrict)
-tyElStrictness _ = Nothing
-
 -- | Extract a strictness/unpackedness annotation from the front of a reversed
 -- 'TyEl' list.
-pStrictMark
+pUnpackedness
   :: [Located TyEl] -- reversed TyEl
-  -> Maybe ( Located HsSrcBang {- a strictness/upnackedness marker -}
+  -> Maybe ( SrcSpan
            , [AddAnn]
+           , SourceText
+           , SrcUnpackedness
            , [Located TyEl] {- remaining TyEl -})
-pStrictMark ((dL->L l1 x1) : (dL->L l2 x2) : xs)
-  | Just (strAnnId, str) <- tyElStrictness x1
-  , TyElUnpackedness (unpkAnns, prag, unpk) <- x2
-  = Just ( cL (combineSrcSpans l1 l2) (HsSrcBang prag unpk str)
-         , unpkAnns ++ [AddAnn strAnnId l1]
-         , xs )
-pStrictMark ((dL->L l x1) : xs)
-  | Just (strAnnId, str) <- tyElStrictness x1
-  = Just ( cL l (HsSrcBang NoSourceText NoSrcUnpack str)
-         , [AddAnn strAnnId l]
-         , xs )
-pStrictMark ((dL->L l x1) : xs)
+pUnpackedness ((dL->L l x1) : xs)
   | TyElUnpackedness (anns, prag, unpk) <- x1
-  = Just ( cL l (HsSrcBang prag unpk NoSrcStrict)
-         , anns
-         , xs )
-pStrictMark _ = Nothing
+  = Just (l, anns, prag, unpk, xs)
+pUnpackedness _ = Nothing
 
 pBangTy
   :: LHsType GhcPs  -- a type to be wrapped inside HsBangTy
@@ -1422,13 +1356,24 @@ pBangTy
      , P ()           {- add annotations -}
      , [Located TyEl] {- remaining TyEl -})
 pBangTy lt@(dL->L l1 _) xs =
-  case pStrictMark xs of
+  case pUnpackedness xs of
     Nothing -> (False, lt, pure (), xs)
-    Just (dL->L l2 strictMark, anns, xs') ->
+    Just (l2, anns, prag, unpk, xs') ->
       let bl = combineSrcSpans l1 l2
-          bt = HsBangTy noExtField strictMark lt
+          bt = addUnpackedness (prag, unpk) lt
       in (True, cL bl bt, addAnnsAt bl anns, xs')
 
+mkBangTy :: SrcStrictness -> LHsType GhcPs -> HsType GhcPs
+mkBangTy strictness =
+  HsBangTy noExtField (HsSrcBang NoSourceText NoSrcUnpack strictness)
+
+addUnpackedness :: (SourceText, SrcUnpackedness) -> LHsType GhcPs -> HsType GhcPs
+addUnpackedness (prag, unpk) (unLoc -> HsBangTy x bang t)
+  | HsSrcBang NoSourceText NoSrcUnpack strictness <- bang
+  = HsBangTy x (HsSrcBang prag unpk strictness) t
+addUnpackedness (prag, unpk) t
+  = HsBangTy noExtField (HsSrcBang prag unpk NoSrcStrict) t
+
 -- | Merge a /reversed/ and /non-empty/ soup of operators and operands
 --   into a type.
 --
@@ -1479,26 +1424,6 @@ mergeOps all_xs = go (0 :: Int) [] id all_xs
     go _ _ _ ((dL->L l (TyElDocPrev _)):_) =
       failOpDocPrev l
 
-    -- to improve error messages, we do a bit of guesswork to determine if the
-    -- user intended a '!' or a '~' as a strictness annotation
-    go k acc ops_acc ((dL->L l x) : xs)
-      | Just (_, str) <- tyElStrictness x
-      , let guess [] = True
-            guess ((dL->L _ (TyElOpd _)):_) = False
-            guess ((dL->L _ (TyElOpr _)):_) = True
-            guess ((dL->L _ (TyElKindApp _ _)):_) = False
-            guess ((dL->L _ (TyElTilde)):_) = True
-            guess ((dL->L _ (TyElBang)):_) = True
-            guess ((dL->L _ (TyElUnpackedness _)):_) = True
-            guess ((dL->L _ (TyElDocPrev _)):xs') = guess xs'
-            guess _ = panic "mergeOps.go.guess: Impossible Match"
-                      -- due to #15884
-        in guess xs
-      = if not (null acc) && (k > 1 || length acc > 1)
-        then do { a <- eitherToP (mergeOpsAcc acc)
-                ; failOpStrictnessCompound (cL l str) (ops_acc a) }
-        else failOpStrictnessPosition (cL l str)
-
     -- clause [opr]:
     -- when we encounter an operator, we must have accumulated
     -- something for its rhs, and there must be something left
@@ -1512,16 +1437,6 @@ mergeOps all_xs = go (0 :: Int) [] id all_xs
         isTyElOpd (dL->L _ (TyElOpd _)) = True
         isTyElOpd _ = False
 
-    -- clause [opr.1]: interpret 'TyElTilde' as an operator
-    go k acc ops_acc ((dL->L l TyElTilde):xs) =
-      let op = eqTyCon_RDR
-      in go k acc ops_acc (cL l (TyElOpr op):xs)
-
-    -- clause [opr.2]: interpret 'TyElBang' as an operator
-    go k acc ops_acc ((dL->L l TyElBang):xs) =
-      let op = mkUnqual tcClsName (fsLit "!")
-      in go k acc ops_acc (cL l (TyElOpr op):xs)
-
     -- clause [opd]:
     -- whenever an operand is encountered, it is added to the accumulator
     go k acc ops_acc ((dL->L l (TyElOpd a)):xs) = go k (HsValArg (cL l a):acc) ops_acc xs
@@ -1700,7 +1615,7 @@ This approach does not suffer from the issues of 'isFunLhs':
 --   into a data constructor.
 --
 -- User input: @C !A B -- ^ doc@
--- Input to 'mergeDataCon': ["doc", B, !, A, C]
+-- Input to 'mergeDataCon': ["doc", B, !A, C]
 -- Output: (C, PrefixCon [!A, B], "doc")
 --
 -- See Note [Parsing data constructors is hard]
@@ -1950,6 +1865,8 @@ class b ~ (Body b) GhcPs => DisambECP b where
   mkHsAsPatPV :: SrcSpan -> Located RdrName -> Located b -> PV (Located b)
   -- | Disambiguate "~a" (lazy pattern)
   mkHsLazyPatPV :: SrcSpan -> Located b -> PV (Located b)
+  -- | Disambiguate "!a" (bang pattern)
+  mkHsBangPatPV :: SrcSpan -> Located b -> PV (Located b)
   -- | Disambiguate tuple sections and unboxed sums
   mkSumOrTuplePV :: SrcSpan -> Boxity -> SumOrTuple b -> PV (Located b)
 
@@ -2039,6 +1956,8 @@ instance p ~ GhcPs => DisambECP (HsCmd p) where
     pprPrefixOcc (unLoc v) <> text "@" <> ppr c
   mkHsLazyPatPV l c = cmdFail l $
     text "~" <> ppr c
+  mkHsBangPatPV l c = cmdFail l $
+    text "!" <> ppr c
   mkSumOrTuplePV l boxity a = cmdFail l (pprSumOrTuple boxity a)
 
 cmdFail :: SrcSpan -> SDoc -> PV a
@@ -2083,21 +2002,20 @@ instance p ~ GhcPs => DisambECP (HsExpr p) where
     checkRecordSyntax (cL l r)
   mkHsNegAppPV l a = return $ cL l (NegApp noExtField a noSyntaxExpr)
   mkHsSectionR_PV l op e = return $ cL l (SectionR noExtField op e)
-  mkHsViewPatPV l a b = patSynErr l (ppr a <+> text "->" <+> ppr b) empty
-  mkHsAsPatPV l v e = do
-    opt_TypeApplications <- getBit TypeApplicationsBit
-    let msg | opt_TypeApplications
-            = "Type application syntax requires a space before '@'"
-            | otherwise
-            = "Did you mean to enable TypeApplications?"
-    patSynErr l (pprPrefixOcc (unLoc v) <> text "@" <> ppr e) (text msg)
-  mkHsLazyPatPV l e = patSynErr l (text "~" <> ppr e) empty
+  mkHsViewPatPV l a b = patSynErr "View pattern" l (ppr a <+> text "->" <+> ppr b) empty
+  mkHsAsPatPV l v e =
+    patSynErr "@-pattern" l (pprPrefixOcc (unLoc v) <> text "@" <> ppr e) $
+    text "Type application syntax requires a space before '@'"
+  mkHsLazyPatPV l e = patSynErr "Lazy pattern" l (text "~" <> ppr e) $
+    text "Did you mean to add a space after the '~'?"
+  mkHsBangPatPV l e = patSynErr "Bang pattern" l (text "!" <> ppr e) $
+    text "Did you mean to add a space after the '!'?"
   mkSumOrTuplePV = mkSumOrTupleExpr
 
-patSynErr :: SrcSpan -> SDoc -> SDoc -> PV (LHsExpr GhcPs)
-patSynErr l e explanation =
+patSynErr :: String -> SrcSpan -> SDoc -> SDoc -> PV (LHsExpr GhcPs)
+patSynErr item l e explanation =
   do { addError l $
-        sep [text "Pattern syntax in expression context:",
+        sep [text item <+> text "in expression context:",
              nest 4 (ppr e)] $$
         explanation
      ; return (cL l hsHoleExpr) }
@@ -2108,21 +2026,14 @@ hsHoleExpr = HsUnboundVar noExtField (mkVarOcc "_")
 -- | See Note [Ambiguous syntactic categories] and Note [PatBuilder]
 data PatBuilder p
   = PatBuilderPat (Pat p)
-  | PatBuilderBang SrcSpan (Located (PatBuilder p))
   | PatBuilderPar (Located (PatBuilder p))
   | PatBuilderApp (Located (PatBuilder p)) (Located (PatBuilder p))
   | PatBuilderOpApp (Located (PatBuilder p)) (Located RdrName) (Located (PatBuilder p))
   | PatBuilderVar (Located RdrName)
   | PatBuilderOverLit (HsOverLit GhcPs)
 
-patBuilderBang :: SrcSpan -> Located (PatBuilder p) -> Located (PatBuilder p)
-patBuilderBang bang p =
-  cL (bang `combineSrcSpans` getLoc p) $
-  PatBuilderBang bang p
-
 instance Outputable (PatBuilder GhcPs) where
   ppr (PatBuilderPat p) = ppr p
-  ppr (PatBuilderBang _ (L _ p)) = text "!" <+> ppr p
   ppr (PatBuilderPar (L _ p)) = parens (ppr p)
   ppr (PatBuilderApp (L _ p1) (L _ p2)) = ppr p1 <+> ppr p2
   ppr (PatBuilderOpApp (L _ p1) op (L _ p2)) = ppr p1 <+> ppr op <+> ppr p2
@@ -2143,9 +2054,7 @@ instance DisambECP (PatBuilder GhcPs) where
   mkHsLetPV l _ _ = addFatalError l $ text "(let ... in ...)-syntax in pattern"
   type InfixOp (PatBuilder GhcPs) = RdrName
   superInfixOp m = m
-  mkHsOpAppPV l p1 op p2 = do
-    warnSpaceAfterBang op (getLoc p2)
-    return $ cL l $ PatBuilderOpApp p1 op p2
+  mkHsOpAppPV l p1 op p2 = return $ cL l $ PatBuilderOpApp p1 op p2
   mkHsCasePV l _ _ = addFatalError l $ text "(case ... of ...)-syntax in pattern"
   type FunArg (PatBuilder GhcPs) = PatBuilder GhcPs
   superFunArg m = m
@@ -2174,9 +2083,7 @@ instance DisambECP (PatBuilder GhcPs) where
       PatBuilderOverLit pos_lit -> return (cL lp pos_lit)
       _ -> patFail l (text "-" <> ppr p)
     return $ cL l (PatBuilderPat (mkNPat lit (Just noSyntaxExpr)))
-  mkHsSectionR_PV l op p
-    | isBangRdr (unLoc op) = return $ cL l $ PatBuilderBang (getLoc op) p
-    | otherwise = patFail l (pprInfixOcc (unLoc op) <> ppr p)
+  mkHsSectionR_PV l op p = patFail l (pprInfixOcc (unLoc op) <> ppr p)
   mkHsViewPatPV l a b = do
     p <- checkLPat b
     return $ cL l (PatBuilderPat (ViewPat noExtField a p))
@@ -2186,6 +2093,11 @@ instance DisambECP (PatBuilder GhcPs) where
   mkHsLazyPatPV l e = do
     p <- checkLPat e
     return $ cL l (PatBuilderPat (LazyPat noExtField p))
+  mkHsBangPatPV l e = do
+    p <- checkLPat e
+    let pb = BangPat noExtField p
+    hintBangPat l pb
+    return $ cL l (PatBuilderPat pb)
   mkSumOrTuplePV = mkSumOrTuplePat
 
 checkUnboxedStringLitPat :: Located (HsLit GhcPs) -> PV ()
@@ -2206,19 +2118,6 @@ mkPatRec (unLoc -> PatBuilderVar c) (HsRecFields fs dd)
 mkPatRec p _ =
   addFatalError (getLoc p) $ text "Not a record constructor:" <+> ppr p
 
--- | Warn about missing space after bang
-warnSpaceAfterBang :: Located RdrName -> SrcSpan -> PV ()
-warnSpaceAfterBang (dL->L opLoc op) argLoc = do
-    bang_on <- getBit BangPatBit
-    when (not bang_on && noSpace && isBangRdr op) $
-      addWarning Opt_WarnSpaceAfterBang span msg
-    where
-      span = combineSrcSpans opLoc argLoc
-      noSpace = srcSpanEnd opLoc == srcSpanStart argLoc
-      msg = text "Did you forget to enable BangPatterns?" $$
-            text "If you mean to bind (!) then perhaps you want" $$
-            text "to add a space after the bang for clarity."
-
 {- Note [Ambiguous syntactic categories]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 
@@ -3014,18 +2913,6 @@ failOpDocPrev loc = addFatalError loc msg
   where
     msg = text "Unexpected documentation comment."
 
-failOpStrictnessCompound :: Located SrcStrictness -> LHsType GhcPs -> P a
-failOpStrictnessCompound (dL->L _ str) (dL->L loc ty) = addFatalError loc msg
-  where
-    msg = text "Strictness annotation applied to a compound type." $$
-          text "Did you mean to add parentheses?" $$
-          nest 2 (ppr str <> parens (ppr ty))
-
-failOpStrictnessPosition :: Located SrcStrictness -> P a
-failOpStrictnessPosition (dL->L loc _) = addFatalError loc msg
-  where
-    msg = text "Strictness annotation cannot appear in this position."
-
 -----------------------------------------------------------------------------
 -- Misc utils
 
@@ -3191,11 +3078,11 @@ no effect on the error messages.
 -}
 
 -- | Hint about bang patterns, assuming @BangPatterns@ is off.
-hintBangPat :: SrcSpan -> PatBuilder GhcPs -> PV ()
+hintBangPat :: SrcSpan -> Pat GhcPs -> PV ()
 hintBangPat span e = do
     bang_on <- getBit BangPatBit
     unless bang_on $
-      addFatalError span
+      addError span
         (text "Illegal bang-pattern (use BangPatterns):" $$ ppr e)
 
 data SumOrTuple b
diff --git a/compiler/rename/RnEnv.hs b/compiler/rename/RnEnv.hs
index c84e7bd328..06c999b2eb 100644
--- a/compiler/rename/RnEnv.hs
+++ b/compiler/rename/RnEnv.hs
@@ -1555,7 +1555,12 @@ dataTcOccs rdr_name
   = [rdr_name]
   where
     occ = rdrNameOcc rdr_name
-    rdr_name_tc = setRdrNameSpace rdr_name tcName
+    rdr_name_tc =
+      case rdr_name of
+        -- The (~) type operator is always in scope, so we need a special case
+        -- for it here, or else  :info (~)  fails in GHCi.
+        Unqual occ | occNameFS occ == fsLit "~" -> eqTyCon_RDR
+        _ -> setRdrNameSpace rdr_name tcName
 
 {-
 Note [dataTcOccs and Exact Names]
diff --git a/testsuite/tests/ghc-api/annotations/T10358.stdout b/testsuite/tests/ghc-api/annotations/T10358.stdout
index 604c7dab36..28f516cb5e 100644
--- a/testsuite/tests/ghc-api/annotations/T10358.stdout
+++ b/testsuite/tests/ghc-api/annotations/T10358.stdout
@@ -16,12 +16,12 @@
 ((Test10358.hs:(4,1)-(8,6),AnnSemi), [Test10358.hs:9:1]),
 ((Test10358.hs:(5,3)-(8,6),AnnIn), [Test10358.hs:8:3-4]),
 ((Test10358.hs:(5,3)-(8,6),AnnLet), [Test10358.hs:5:3-5]),
-((Test10358.hs:5:7-16,AnnBang), [Test10358.hs:5:7]),
+((Test10358.hs:5:7-10,AnnBang), [Test10358.hs:5:7]),
 ((Test10358.hs:5:7-16,AnnEqual), [Test10358.hs:5:12]),
 ((Test10358.hs:5:7-16,AnnFunId), [Test10358.hs:5:8-10]),
 ((Test10358.hs:5:7-16,AnnSemi), [Test10358.hs:5:17]),
 ((Test10358.hs:5:14-16,AnnVal), [Test10358.hs:5:15]),
-((Test10358.hs:5:19-32,AnnBang), [Test10358.hs:5:19]),
+((Test10358.hs:5:19-22,AnnBang), [Test10358.hs:5:19]),
 ((Test10358.hs:5:19-32,AnnEqual), [Test10358.hs:5:24]),
 ((Test10358.hs:5:19-32,AnnFunId), [Test10358.hs:5:20-22]),
 ((Test10358.hs:5:19-32,AnnSemi), [Test10358.hs:6:7]),
diff --git a/testsuite/tests/module/mod69.stderr b/testsuite/tests/module/mod69.stderr
index db7487485e..dea161115e 100644
--- a/testsuite/tests/module/mod69.stderr
+++ b/testsuite/tests/module/mod69.stderr
@@ -1,4 +1,4 @@
 
 mod69.hs:3:7: error:
-    Pattern syntax in expression context: x@1
-    Did you mean to enable TypeApplications?
+    @-pattern in expression context: x@1
+    Type application syntax requires a space before '@'
diff --git a/testsuite/tests/module/mod70.stderr b/testsuite/tests/module/mod70.stderr
index 093f166ebd..6e9f854b7a 100644
--- a/testsuite/tests/module/mod70.stderr
+++ b/testsuite/tests/module/mod70.stderr
@@ -1,2 +1,4 @@
 
-mod70.hs:3:9: error: Pattern syntax in expression context: ~1
+mod70.hs:3:9: error:
+    Lazy pattern in expression context: ~1
+    Did you mean to add a space after the '~'?
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..8b919f1b38 100644
--- a/testsuite/tests/parser/should_compile/all.T
+++ b/testsuite/tests/parser/should_compile/all.T
@@ -145,3 +145,7 @@ 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, [''])
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_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: !
diff --git a/testsuite/tests/rename/should_fail/T12879.stderr b/testsuite/tests/rename/should_fail/T12879.stderr
index 1b3559c255..0c6b7f36f5 100644
--- a/testsuite/tests/rename/should_fail/T12879.stderr
+++ b/testsuite/tests/rename/should_fail/T12879.stderr
@@ -1,4 +1,4 @@
 
 T12879.hs:4:7: error:
-    Pattern syntax in expression context: x@x
+    @-pattern in expression context: x@x
     Type application syntax requires a space before '@'
diff --git a/testsuite/tests/rename/should_fail/rnfail016.stderr b/testsuite/tests/rename/should_fail/rnfail016.stderr
index 47436132f2..6ed450ce0b 100644
--- a/testsuite/tests/rename/should_fail/rnfail016.stderr
+++ b/testsuite/tests/rename/should_fail/rnfail016.stderr
@@ -1,4 +1,4 @@
 
 rnfail016.hs:6:7: error:
-    Pattern syntax in expression context: x@x
-    Did you mean to enable TypeApplications?
+    @-pattern in expression context: x@x
+    Type application syntax requires a space before '@'
diff --git a/testsuite/tests/rename/should_fail/rnfail016a.stderr b/testsuite/tests/rename/should_fail/rnfail016a.stderr
index 3a59ee7478..544cf58cac 100644
--- a/testsuite/tests/rename/should_fail/rnfail016a.stderr
+++ b/testsuite/tests/rename/should_fail/rnfail016a.stderr
@@ -1,2 +1,2 @@
 
-rnfail016a.hs:6:7: error: Pattern syntax in expression context: ~x
+rnfail016a.hs:6:7: error: parse error on input ‘~’
diff --git a/testsuite/tests/rename/should_fail/rnfail051.stderr b/testsuite/tests/rename/should_fail/rnfail051.stderr
index 9c45a6168b..c1f4f43a2f 100644
--- a/testsuite/tests/rename/should_fail/rnfail051.stderr
+++ b/testsuite/tests/rename/should_fail/rnfail051.stderr
@@ -1,3 +1,3 @@
 
 rnfail051.hs:7:17: error:
-    Pattern syntax in expression context: _ -> putStrLn "_"
+    View pattern in expression context: _ -> putStrLn "_"
diff --git a/testsuite/tests/th/T12411.stderr b/testsuite/tests/th/T12411.stderr
index 1f344323bd..22f7de0190 100644
--- a/testsuite/tests/th/T12411.stderr
+++ b/testsuite/tests/th/T12411.stderr
@@ -1,4 +1,6 @@
 
 T12411.hs:4:1: error:
-    Pattern syntax in expression context: pure@Q
-    Did you mean to enable TypeApplications?
+    Illegal visible type application ‘@Q’
+      Perhaps you intended to use TypeApplications
+
+T12411.hs:4:7: error: Not in scope: type constructor or class ‘Q’
diff --git a/testsuite/tests/typecheck/should_fail/T14761b.stderr b/testsuite/tests/typecheck/should_fail/T14761b.stderr
index 08a319cde3..af557c4725 100644
--- a/testsuite/tests/typecheck/should_fail/T14761b.stderr
+++ b/testsuite/tests/typecheck/should_fail/T14761b.stderr
@@ -1,5 +1,2 @@
 
-T14761b.hs:5:21: error:
-    Strictness annotation applied to a compound type.
-    Did you mean to add parentheses?
-      !(Maybe Int)
+T14761b.hs:5:19: error: Operator applied to too few arguments: !
diff --git a/testsuite/tests/typecheck/should_fail/T15527.stderr b/testsuite/tests/typecheck/should_fail/T15527.stderr
index dd03a0a0ca..8908b17218 100644
--- a/testsuite/tests/typecheck/should_fail/T15527.stderr
+++ b/testsuite/tests/typecheck/should_fail/T15527.stderr
@@ -1,4 +1,4 @@
 
 T15527.hs:4:6: error:
-    Pattern syntax in expression context: (.)@Int
-    Did you mean to enable TypeApplications?
+    Illegal visible type application ‘@Int’
+      Perhaps you intended to use TypeApplications
diff --git a/testsuite/tests/typecheck/should_fail/T7210.stderr b/testsuite/tests/typecheck/should_fail/T7210.stderr
index 4d7cb38a4d..d0ca04a84e 100644
--- a/testsuite/tests/typecheck/should_fail/T7210.stderr
+++ b/testsuite/tests/typecheck/should_fail/T7210.stderr
@@ -1,5 +1,7 @@
 
-T7210.hs:5:20: error:
-    Strictness annotation applied to a compound type.
-    Did you mean to add parentheses?
-      !(IntMap Int)
+T7210.hs:5:19: error:
+    • Unexpected strictness annotation: !IntMap
+      strictness annotation cannot appear nested inside a type
+    • In the type ‘!IntMap Int’
+      In the definition of data constructor ‘C’
+      In the data declaration for ‘T’