case over signum of Integer is incorrect in GHC 9.2

Summary

case over signum of Integer returns an incorrect result.

Steps to reproduce

GHCi, version 9.2.0.20210331: https://www.haskell.org/ghc/  :? for help
ghci> signum (-1 :: Integer)
-1
ghci> case signum (-1 :: Integer) of 1 -> "FOO"; -1 -> "OK"; 0 -> "BAR"; _ -> "FAIL"
"FAIL"

Expected behavior

I would expect the second line to return "OK".

Environment

• GHC version used: 9.2.0.20210331

added incorrect runtime result needs triage labels

changed milestone to %9.2.1

It looks like signum is not essential here, the real issue seems to be case alternatives that differ only in the sign of the value:

λ> case (-1 :: Integer) of 1 -> "BAD1"; -1 -> "OK"; _ -> "BAD2"
"BAD2"
λ> case (-1 :: Integer) of 2 -> "BAD1"; -1 -> "OK"; _ -> "BAD2"
"OK"
λ> case (1 :: Integer) of -1 -> "BAD1"; 1 -> "OK"; _ -> "BAD2"

<interactive>:17:24: warning: [-Woverlapping-patterns]
    Pattern match is redundant
    In a case alternative: -1 -> ...

<interactive>:17:49: warning: [-Woverlapping-patterns]
    Pattern match is redundant
    In a case alternative: _ -> ...
"BAD2"

@hsyl20 Any thoughts on this issue?

It's weird. I can't test right now but perhaps an issue with the pattern match checker. Or perhaps try enabling NegativeLiterals to see if it changes anything?

Turning on NegativeLiterals seems to fix the issue.

ghci> case ((-1) :: Integer) of { 1 -> "FOO"; (-1) -> "OK"; 0 -> "BAR"; i -> "FAIL" }
"FAIL"
ghci> :seti -XNegativeLiterals
ghci> case ((-1) :: Integer) of { 1 -> "FOO"; (-1) -> "OK"; 0 -> "BAR"; i -> "FAIL" }
"OK"

Here's the diff in the core produced respectively without and with NegativeLiterals:

 main :: IO ()
 main
   = $ (print ($fShow[] $fShowChar))
       (let {
          ds :: Integer
-         ds = negate $fNumInteger 1 } in
+         ds = -1 } in
        case == $fEqInteger ds 1 of {
          False ->
-           case == $fEqInteger ds 0 of {
-             False -> unpackCString# "FAIL"#;
-             True -> unpackCString# "BAR"#
+           case == $fEqInteger ds (-1) of {
+             False ->
+               case == $fEqInteger ds 0 of {
+                 False -> unpackCString# "FAIL"#;
+                 True -> unpackCString# "BAR"#
+               };
+             True -> unpackCString# "OK"#
            };
          True -> unpackCString# "FOO"#
        })

Simplifying the code (eliminating the 0 case) to:

{-# LANGUAGE NegativeLiterals #-}
main :: IO ()
main = do
    let x = -1 :: Integer
    print $ case x of
        1  -> "1"
        -1 -> "-1"
        _  -> "other"

The difference in the core becomes:

 main :: IO ()
 main
   = $ (print ($fShow[] $fShowChar))
-      (case == $fEqInteger (negate $fNumInteger 1) 1 of {
-         False -> unpackCString# "other"#;
+      (let {
+         ds :: Integer
+         ds = -1 } in
+       case == $fEqInteger ds 1 of {
+         False ->
+           case == $fEqInteger ds (-1) of {
+             False -> unpackCString# "other"#;
+             True -> unpackCString# "-1"#
+           };
          True -> unpackCString# "1"#
        })

as before the branch corresponding to (-1) is suppressed without NegativeLiterals.

This regression was introduced in commit 60bf4d7c (Fix typechecking time bug for large rationals (#15646)).

Perhaps @AndreasK could look into addressing this?

I still can't test, but reading the commit on my phone it seems like 'rationalFromFunctionalLit' doesn't take 'fl_neg' into account.

I still can't test, but reading the commit on my phone it seems like 'rationalFromFunctionalLit' doesn't take 'fl_neg' into account

That does sound like a smoking gun! Do keep us posted.

added Phighest label

I am not sure negateFractionalLit is correct either. It seems to flip the negation flag but also calls negate on the value.

assigned to @mpickering

Fix: !5525 (closed)

mentioned in merge request !5525 (closed)

mentioned in commit 51aa037a

added Tbug ghc-bignum labels and removed needs triage label

added backport needed:9.2 label

mentioned in commit 00e94eda

mentioned in commit 54d3994c

mentioned in merge request !5506 (merged)

mentioned in commit 65ad9e59

closed with commit cc1ba576

mentioned in commit cc1ba576

mentioned in commit a42e30bc

removed backport needed:9.2 label