Negative zero broken
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.