Fix PostfixOperators (#18151)

This fixes a regression introduced in 2b89ca5b850b4097447cc4908cbb0631011ce979
See the new T18151x test case.

4 files changed, 33 insertions, 1 deletions

diff --git a/compiler/GHC/HsToCore/Expr.hs b/compiler/GHC/HsToCore/Expr.hs
index c9868cc381..24b4a76892 100644
--- a/compiler/GHC/HsToCore/Expr.hs
+++ b/compiler/GHC/HsToCore/Expr.hs
@@ -70,6 +70,8 @@ import GHC.Utils.Panic
 import GHC.Core.PatSyn
 import Control.Monad
 
+import qualified GHC.LanguageExtensions as LangExt
+
 {-
 ************************************************************************
 *                                                                      *
@@ -347,7 +349,11 @@ converting to core it must become a CO.
 
 Note [Desugaring operator sections]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-At first it looks as if we can convert
+Desugaring left sections with -XPostfixOperators is straightforward: convert
+(expr `op`) to (op expr).
+
+Without -XPostfixOperators it's a bit more tricky. At first it looks as if we
+can convert
 
     (expr `op`)
 
@@ -398,6 +404,13 @@ dsExpr e@(OpApp _ e1 op e2)
 -- See Note [Desugaring operator sections].
 -- N.B. this also must handle postfix operator sections due to -XPostfixOperators.
 dsExpr e@(SectionL _ expr op) = do
+  postfix_operators <- xoptM LangExt.PostfixOperators
+  if postfix_operators then
+    -- Desugar (e !) to ((!) e)
+    do { op' <- dsLExpr op
+       ; dsWhenNoErrs (dsLExprNoLP expr) $ \expr' ->
+         mkCoreAppDs (text "sectionl" <+> ppr expr) op' expr' }
+  else do
     core_op <- dsLExpr op
     x_core <- dsLExpr expr
     case splitFunTys (exprType core_op) of
diff --git a/testsuite/tests/deSugar/should_run/T18151x.hs b/testsuite/tests/deSugar/should_run/T18151x.hs
new file mode 100644
index 0000000000..213ca9969f
--- /dev/null
+++ b/testsuite/tests/deSugar/should_run/T18151x.hs
@@ -0,0 +1,17 @@
+{-# LANGUAGE PostfixOperators #-}
+
+import Control.Exception
+
+data MyException = MyE
+  deriving (Show)
+
+instance Exception MyException
+
+(#) :: Bool -> Bool -> Bool
+(#) = throw MyE
+
+main = do
+  r <- try (evaluate (seq (True #) ()))
+  case r of
+    Left MyE -> putStrLn "PostfixOperators ok"
+    Right () -> putStrLn "PostfixOperators broken"
diff --git a/testsuite/tests/deSugar/should_run/T18151x.stdout b/testsuite/tests/deSugar/should_run/T18151x.stdout
new file mode 100644
index 0000000000..cbd3ad0a5b
--- /dev/null
+++ b/testsuite/tests/deSugar/should_run/T18151x.stdout
@@ -0,0 +1 @@
+PostfixOperators ok
diff --git a/testsuite/tests/deSugar/should_run/all.T b/testsuite/tests/deSugar/should_run/all.T
index 2df9586b7d..406cb24863 100644
--- a/testsuite/tests/deSugar/should_run/all.T
+++ b/testsuite/tests/deSugar/should_run/all.T
@@ -65,6 +65,7 @@ test('T11747', normal, compile_and_run, ['-dcore-lint'])
 test('T12595', normal, compile_and_run, [''])
 test('T13285', normal, compile_and_run, [''])
 test('T18151', normal, compile_and_run, [''])
+test('T18151x', normal, compile_and_run, [''])
 test('T18172', [], ghci_script, ['T18172.script'])
 
 test('DsDoExprFailMsg', exit_code(1), compile_and_run, [''])