[Git][ghc/ghc][wip/T22524] Adjust error message for trailing whitespace in as-pattern.

[Jade (@Jade)]

Jade pushed to branch wip/T22524 at Glasgow Haskell Compiler / GHC


Commits:
2199ed0e by Jade at 2024-02-03T20:04:01+01:00
Adjust error message for trailing whitespace in as-pattern.

Fixes #22524

- - - - -


2 changed files:

- compiler/GHC/Parser/Errors/Ppr.hs
- compiler/GHC/Parser/Lexer.x


Changes:

=====================================
compiler/GHC/Parser/Errors/Ppr.hs
=====================================
@@ -386,7 +386,8 @@ instance Diagnostic PsMessage where
       -> mkSimpleDecorated $ text "primitive string literal must contain only characters <= \'\\xFF\'"
     PsErrSuffixAT
       -> mkSimpleDecorated $
-           text "Suffix occurrence of @. For an as-pattern, remove the leading whitespace."
+           text "The symbol '@' occurs as a suffix." $$
+           text "For an as-pattern, there must not be any whitespace surrounding '@'."
     PsErrPrecedenceOutOfRange i
       -> mkSimpleDecorated $ text "Precedence out of range: " <> int i
     PsErrSemiColonsInCondExpr c st t se e


=====================================
compiler/GHC/Parser/Lexer.x
=====================================
@@ -1784,6 +1784,21 @@ qvarsym, qconsym :: StringBuffer -> Int -> Token
 qvarsym buf len = ITqvarsym $! splitQualName buf len False
 qconsym buf len = ITqconsym $! splitQualName buf len False
 
+
+errSuffixAt :: PsSpan -> P a
+errSuffixAt span = do
+    input <- getInput
+    failLocMsgP start (go input start) (\srcSpan -> mkPlainErrorMsgEnvelope srcSpan $ PsErrSuffixAT)
+  where
+    start = psRealLoc (psSpanStart span)
+    go inp loc
+      | Just (c, i) <- alexGetChar inp
+      , let next = advanceSrcLoc loc c =
+          if c == ' '
+          then go i next
+          else next
+      | otherwise = loc
+
 -- See Note [Whitespace-sensitive operator parsing]
 varsym :: OpWs -> Action
 varsym opws at OpWsPrefix = sym $ \span exts s ->
@@ -1817,7 +1832,7 @@ varsym opws at OpWsPrefix = sym $ \span exts s ->
          do { warnOperatorWhitespace opws span s
             ; return (ITvarsym s) }
 varsym opws at OpWsSuffix = sym $ \span _ s ->
-  if | s == fsLit "@" -> failMsgP (\srcLoc -> mkPlainErrorMsgEnvelope srcLoc $ PsErrSuffixAT)
+  if | s == fsLit "@" -> errSuffixAt span
      | s == fsLit "." -> return ITdot
      | otherwise ->
          do { warnOperatorWhitespace opws span s



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2199ed0e39a1da23d6c8206ff9a5ca3de6c60a09

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2199ed0e39a1da23d6c8206ff9a5ca3de6c60a09
You're receiving this email because of your account on gitlab.haskell.org.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20240203/9c9d8c6a/attachment-0001.html>