Trouble with asinh (c calls with Doubles) in Windows

Hello all – I’m trying to debug a problem with asinh in Windows.
On Linux (Ubuntu 18.04.5 LTS) running GHC 8.10.7, I get (I think correctly):
GHCi, version 8.10.7: https://www.haskell.org/ghc/ :? for help
Prelude> asinh 1.7976931348623157e308
710.4758600739439
But on Windows I get:
GHCi, version 8.10.7: https://www.haskell.org/ghc/ :? for help
Prelude> asinh 1.7976931348623157e308
NaN
My understanding is that, since commit c6f4eb4f8https://gitlab.haskell.org/ghc/ghc/-/commit/c6f4eb4f8bc5e00024c74198ab9126bf... (released in GHC 8.8.1, I think), asinh is defined as a primop that just calls the c asinh function, so I tried the following code:
In Main.hs:
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE CApiFFI #-}
module Main (main) where
import Foreign
import Foreign.C.Types
foreign import ccall unsafe "math.h asinh" c_asinh :: Double -> Double
foreign import ccall unsafe "CAsinh.c testFn" c_testFn :: IO ()
main :: IO ()
main = do
putStrLn $ "asinh 1.7976931348623157e308 = " ++ show ( asinh 1.7976931348623157e308)
putStrLn $ "c_asinh 1.7976931348623157e308 = " ++ show (c_asinh 1.7976931348623157e308)
putStrLn "Calling c_testFn..."
c_testFn
In CAsinh.c:
#include

Hi David, If I understand correctly, GHC uses mingw-w64’s libc implementation on Windows. Since mingw-w64’s math functions are not of very good quality, it is likely that asinh returns NaN for a very large input. As to why `asinh(1.7976931348623157e308)` in CAsinh.c produces (seemingly-correct) 710.4758, it is probably because the C compiler (GCC) uses a different implementation of asinh when doing constant folding. As a note, you may get a different (compile-time computed) result for `asinh(x)` if you set a more aggressive optimization flag. Mizuki

I would also note that %f is the wrong printf flag to use with a double;
you want %d. This shouldn't affect the result since you're only printing
one value, but I don't know the Windows ABI so conceivably it might.
On Fri, Sep 3, 2021 at 8:43 AM arata, mizuki
Hi David,
If I understand correctly, GHC uses mingw-w64’s libc implementation on Windows. Since mingw-w64’s math functions are not of very good quality, it is likely that asinh returns NaN for a very large input.
As to why `asinh(1.7976931348623157e308)` in CAsinh.c produces (seemingly-correct) 710.4758, it is probably because the C compiler (GCC) uses a different implementation of asinh when doing constant folding. As a note, you may get a different (compile-time computed) result for `asinh(x)` if you set a more aggressive optimization flag.
Mizuki
_______________________________________________ Haskell-Cafe mailing list To (un)subscribe, modify options or view archives go to: http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe Only members subscribed via the mailman list are allowed to post.
-- brandon s allbery kf8nh allbery.b@gmail.com

Hi - thank you for this. I was unaware of the “constant folding” in GCC (and I’m surprised it works for functions like asinh), but I can see that it explains the difference in behaviour. So I think this is a (possibly minor) bug that Haskell inherits from mingw-w64. I guess I should raise a GHC issue – though I’m not sure whether it would be best to try to fix within Haskell or within mingw-w64. Also, I think the FloatFnInverses.hshttps://gitlab.haskell.org/ghc/ghc/-/blob/master/testsuite/tests/numeric/sho... test doesn’t should be showing as a fail somewhere in the CI testing. (It doesn’t give the expected output when I run it on Windows). Do you know whether/where I can see that? (I don’t know what CI happens or how to view its output). Thanks again, David. From: arata, mizukimailto:minorinoki@gmail.com Sent: 03 September 2021 13:43 To: David Jamesmailto:dj112358@outlook.com Cc: haskell-cafe@haskell.orgmailto:haskell-cafe@haskell.org Subject: Re: [Haskell-cafe] Trouble with asinh (c calls with Doubles) in Windows Hi David, If I understand correctly, GHC uses mingw-w64’s libc implementation on Windows. Since mingw-w64’s math functions are not of very good quality, it is likely that asinh returns NaN for a very large input. As to why `asinh(1.7976931348623157e308)` in CAsinh.c produces (seemingly-correct) 710.4758, it is probably because the C compiler (GCC) uses a different implementation of asinh when doing constant folding. As a note, you may get a different (compile-time computed) result for `asinh(x)` if you set a more aggressive optimization flag. Mizuki

FloatFnInverses is marked as ‘expect_broken’ on Windows: https://gitlab.haskell.org/ghc/ghc/-/blob/922c6bc8dd8d089cfe4b90ec2120cb4895... https://gitlab.haskell.org/ghc/ghc/-/blob/922c6bc8dd8d089cfe4b90ec2120cb4895... And there’s a relevant issue: https://gitlab.haskell.org/ghc/ghc/-/issues/15670 https://gitlab.haskell.org/ghc/ghc/-/issues/15670 Mizuki
2021/09/04 18:46、David James
のメール: Hi - thank you for this. I was unaware of the “constant folding” in GCC (and I’m surprised it works for functions like asinh), but I can see that it explains the difference in behaviour.
So I think this is a (possibly minor) bug that Haskell inherits from mingw-w64. I guess I should raise a GHC issue – though I’m not sure whether it would be best to try to fix within Haskell or within mingw-w64.
Also, I think the FloatFnInverses.hs https://gitlab.haskell.org/ghc/ghc/-/blob/master/testsuite/tests/numeric/sho... test doesn’t should be showing as a fail somewhere in the CI testing. (It doesn’t give the expected output when I run it on Windows). Do you know whether/where I can see that? (I don’t know what CI happens or how to view its output).
Thanks again, David.
From: arata, mizuki mailto:minorinoki@gmail.com Sent: 03 September 2021 13:43 To: David James mailto:dj112358@outlook.com Cc: haskell-cafe@haskell.org mailto:haskell-cafe@haskell.org Subject: Re: [Haskell-cafe] Trouble with asinh (c calls with Doubles) in Windows
Hi David,
If I understand correctly, GHC uses mingw-w64’s libc implementation on Windows. Since mingw-w64’s math functions are not of very good quality, it is likely that asinh returns NaN for a very large input.
As to why `asinh(1.7976931348623157e308)` in CAsinh.c produces (seemingly-correct) 710.4758, it is probably because the C compiler (GCC) uses a different implementation of asinh when doing constant folding. As a note, you may get a different (compile-time computed) result for `asinh(x)` if you set a more aggressive optimization flag.
Mizuki

Thanks again. I��ve added a note to the issue, and raised a bughttps://sourceforge.net/p/mingw-w64/bugs/916/ against mingw. (And also updated anotherhttps://sourceforge.net/p/mingw-w64/bugs/515/ related one.)
Is the right solution here to get it fixed in mingw? (And would that then be picked up in some future Haskell release?).
I��m also still a bit confused about ming-w64 and GCC (which are all very new to me). Per Wikipediahttps://en.wikipedia.org/wiki/Mingw-w64 ��Mingw-w64 includes a port of the GNU Compiler Collection (GCC)��. So why does it have two different implementations of asinh? �C one for use by GCC (that gives good results), and one that is called at runtime (that gives bad results)?.
Thanks! David.
From: arata, mizukimailto:minorinoki@gmail.com
Sent: 04 September 2021 12:41
To: David Jamesmailto:dj112358@outlook.com
Cc: haskell-cafe@haskell.orgmailto:haskell-cafe@haskell.org
Subject: Re: [Haskell-cafe] Trouble with asinh (c calls with Doubles) in Windows
FloatFnInverses is marked as ��expect_broken�� on Windows:
https://gitlab.haskell.org/ghc/ghc/-/blob/922c6bc8dd8d089cfe4b90ec2120cb4895...
And there��s a relevant issue: https://gitlab.haskell.org/ghc/ghc/-/issues/15670
Mizuki
2021/09/04 18:46��David James

The problem of asinh should be fixed in the C runtime library, so it
should be fixed in mingw, or by using another C library implementation
than mingw's.
Actually, Microsoft's recent C library (Universal CRT) seems to have
better math functions than mingw, so using it might be an option if
possible.
(cf. https://mail.haskell.org/pipermail/haskell-cafe/2021-April/133931.html
https://awson.github.io/ghc-nw/ )
As to why GCC has two different implementations of asinh -- the
implementation of math functions that GCC uses for constant folding is
MPFR, which is a bit heavy for linking to every program that it
compiles.
2021年9月7日(火) 18:01 David James
Thanks again. I’ve added a note to the issue, and raised a bug against mingw. (And also updated another related one.)
Is the right solution here to get it fixed in mingw? (And would that then be picked up in some future Haskell release?).
I’m also still a bit confused about ming-w64 and GCC (which are all very new to me). Per Wikipedia “Mingw-w64 includes a port of the GNU Compiler Collection (GCC)”. So why does it have two different implementations of asinh? – one for use by GCC (that gives good results), and one that is called at runtime (that gives bad results)?.
Thanks! David.
From: arata, mizuki Sent: 04 September 2021 12:41 To: David James Cc: haskell-cafe@haskell.org Subject: Re: [Haskell-cafe] Trouble with asinh (c calls with Doubles) in Windows
FloatFnInverses is marked as ‘expect_broken’ on Windows:
https://gitlab.haskell.org/ghc/ghc/-/blob/922c6bc8dd8d089cfe4b90ec2120cb4895...
And there’s a relevant issue: https://gitlab.haskell.org/ghc/ghc/-/issues/15670
Mizuki
2021/09/04 18:46、David James
のメール: Hi - thank you for this. I was unaware of the “constant folding” in GCC (and I’m surprised it works for functions like asinh), but I can see that it explains the difference in behaviour.
So I think this is a (possibly minor) bug that Haskell inherits from mingw-w64. I guess I should raise a GHC issue – though I’m not sure whether it would be best to try to fix within Haskell or within mingw-w64.
Also, I think the FloatFnInverses.hs test doesn’t should be showing as a fail somewhere in the CI testing. (It doesn’t give the expected output when I run it on Windows). Do you know whether/where I can see that? (I don’t know what CI happens or how to view its output).
Thanks again,
David.
From: arata, mizuki Sent: 03 September 2021 13:43 To: David James Cc: haskell-cafe@haskell.org Subject: Re: [Haskell-cafe] Trouble with asinh (c calls with Doubles) in Windows
Hi David,
If I understand correctly, GHC uses mingw-w64’s libc implementation on Windows. Since mingw-w64’s math functions are not of very good quality, it is likely that asinh returns NaN for a very large input.
As to why `asinh(1.7976931348623157e308)` in CAsinh.c produces (seemingly-correct) 710.4758, it is probably because the C compiler (GCC) uses a different implementation of asinh when doing constant folding. As a note, you may get a different (compile-time computed) result for `asinh(x)` if you set a more aggressive optimization flag.
Mizuki
participants (4)
-
arata, mizuki
-
Brandon Allbery
-
David James
-
荒田 実樹