GitLab

Try the following program

compareDouble :: Double -> Double -> Ordering
compareDouble x y =
       case (isNaN x, isNaN y) of
       (True, True)   -> EQ
       (True, False)  -> LT
       (False, True)  -> GT
       (False, False) ->
          -- Make -0 less than 0
          case (x == 0, y == 0, isNegativeZero x, isNegativeZero y) of
          (True, True, True, False) -> LT
          (True, True, False, True) -> GT
          _                         -> x `compare` y

main = do
    let l = [-0, 0]
    print [ (x, y, compareDouble x y) | x <- l, y <- l ]

Compile and run with -O0

$ ghc -O0 -fforce-recomp D.hs
[1 of 1] Compiling Main             ( D.hs, D.o )
Linking D.exe ...
$ ./D
[(-0.0,-0.0,EQ),(-0.0,0.0,LT),(0.0,-0.0,GT),(0.0,0.0,EQ)]

This is the correct output.

Compile and run with -O1

$ ghc -O1 -fforce-recomp D.hs
[1 of 1] Compiling Main             ( D.hs, D.o )
Linking D.exe ...
$ ./D
[(-0.0,-0.0,LT),(-0.0,0.0,LT),(0.0,-0.0,EQ),(0.0,0.0,EQ)]

This is wrong.

Put a NOINLINE pragma on compareDouble:

$ ghc -O1 -fforce-recomp D.hs
[1 of 1] Compiling Main             ( D.hs, D.o )
Linking D.exe ...
$ ./D
[(-0.0,-0.0,EQ),(-0.0,0.0,EQ),(0.0,-0.0,EQ),(0.0,0.0,EQ)]

This is wrong in a different way.