<div dir="ltr">I'd in general expect good C code to optimize a little better; and in particular, decomposing an IEEE float is almost certainly more expensive in Haskell than in C, because unions let you cheat. (And I recall looking at the implementation of decodeFloat once; it's significantly longer than that C.) But I have to wonder if that code would be better done with something more native; the implementation may be a portable default, and you might be able to find something x86-specific that is faster.</div><div class="gmail_extra"><br><div class="gmail_quote">On Tue, Mar 6, 2018 at 5:35 AM, Mateusz Kowalczyk <span dir="ltr"><<a href="mailto:fuuzetsu@fuuzetsu.co.uk" target="_blank">fuuzetsu@fuuzetsu.co.uk</a>></span> wrote:<br><blockquote class="gmail_quote" style="margin:0 0 0 .8ex;border-left:1px #ccc solid;padding-left:1ex"><span class="">On 03/05/2018 10:23 PM, Brandon Allbery wrote:<br>
> If the FFI version is done with "safe", consider using "unsafe" instead.<br>
> There are technical reasons why this is slightly incorrect, but unless<br>
> you're fiddling with the CPU's FP control flags they're mostly irrelevant<br>
> and you can treat isNaN as pure and non-side-effectful, significantly<br>
> reducing the overhead. You may also be able to use "ccall" to take<br>
> advantage of C compiler level optimizations, or simply to directly invoke a<br>
> CPU-based test with asm(); but you'll need to hide that in a C preprocessor<br>
> #define, so that it looks syntactically like a function call to the FFI.<br>
><br>
> (One of the technical reasons is that various OSes have been known to<br>
> introduce bugs in their FP register and state handling across system calls,<br>
> in which case the "safe" version may turn "complete FP chaos" into merely<br>
> "wrong answer". It's your call whether, or which side, of this bothers you.)<br>
<br>
</span>Perhaps I was a little unclear. The FFI-using isDoubleNaN is something<br>
GHC does!<br>
<br>
```<br>
libraries/base/GHC/Float.hs:<wbr>foreign import ccall unsafe "isDoubleNaN"<br>
isDoubleNaN :: Double -> Int<br>
```<br>
```<br>
HsInt<br>
isDoubleNaN(HsDouble d)<br>
{<br>
union stg_ieee754_dbl u;<br>
<br>
u.d = d;<br>
<br>
return (<br>
u.ieee.exponent == 2047 /* 2^11 - 1 */ && /* Is the exponent all<br>
ones? */<br>
(u.ieee.mantissa0 != 0 || u.ieee.mantissa1 != 0)<br>
/* and the mantissa non-zero? */<br>
);<br>
}<br>
```<br>
<br>
My question is whether it could do better by not doing FFI and instead<br>
computing natively and if not, why not?<br>
<div><div class="h5"><br>
> On Mon, Mar 5, 2018 at 4:53 PM, Mateusz Kowalczyk <<a href="mailto:fuuzetsu@fuuzetsu.co.uk">fuuzetsu@fuuzetsu.co.uk</a>><br>
> wrote:<br>
><br>
>> Hi,<br>
>><br>
>> Recently at a client I was profiling some code and isDoubleNaN lit up.<br>
>> We were checking a lot of doubles for NaN as that's what customer would<br>
>> send in.<br>
>><br>
>> I went to investigate and I found that FFI is used to achieve this. I<br>
>> was always under the impression that FFI costs a little. I had at the<br>
>> time replaced the code with a hack with great results:<br>
>><br>
>> ```<br>
>> isNaN' :: Double -> Bool<br>
>> isNaN' d = d /= d<br>
>> ```<br>
>><br>
>> While this worked and provided good speedup in my case, this fails<br>
>> catastrophically if the program is compiled with -ffast-math. This is<br>
>> expected. I have since reverted it. Seeking an alternative solution I<br>
>> have thought about re-implementing the C code with a native Haskell<br>
>> version: after all it just checks a few bits. Apparently unsafeCoerce#<br>
>> and friends were a big no-no but I found<br>
>> <a href="https://phabricator.haskell.org/D3358" rel="noreferrer" target="_blank">https://phabricator.haskell.<wbr>org/D3358</a> . I have implemented the code at<br>
>> the bottom of this post. Obviously it's missing endianness (compile-time<br>
>> switch).<br>
>><br>
>> This seems to be faster for smaller `mkInput` list than Prelude.isNaN<br>
>> but slower slightly on the one below. The `/=` version is the fastest<br>
>> but very fragile.<br>
>><br>
>> My question to you all is whether implementing a version of this<br>
>> function in Haskell makes sense and if not, why not? The<br>
>> stgDoubleToWord64 is implemented in CMM and I don't know anything about<br>
>> the costs of that.<br>
>><br>
>> * Is there a cheaper alternative to FFI way?<br>
>> * If yes, does anyone know how to write it such that it compiles to same<br>
>> code but without the call overhead? I must have failed below as it's<br>
>> slower on some inputs.<br>
>><br>
>> Basically if a faster way exists for isNaN, something I have to do a<br>
>> lot, I'd love to hear about it.<br>
>><br>
>> I leave you with basic code I managed to come up with. 8.4.x only.<br>
>><br>
>><br>
>> ```<br>
>> {-# LANGUAGE MagicHash #-}<br>
>> {-# OPTIONS_GHC -O2 -ddump-simpl -ddump-stg -ddump-to-file -ddump-asm #-}<br>
>> module Main (main) where<br>
>><br>
>> import GHC.Float<br>
>> import GHC.Prim<br>
>><br>
>> isNaN' :: Double -> Bool<br>
>> isNaN' d = d /= d<br>
>><br>
>> isNaNBits :: Double -> Bool<br>
>> isNaNBits (D# d) = case (bits `and#` expMask) `eqWord#` expMask of<br>
>> 1# -> case bits `and#` mantissaMask of<br>
>> 0## -> False<br>
>> _ -> True<br>
>> _ -> False<br>
>> where<br>
>> bits :: Word#<br>
>> bits = stgDoubleToWord64 d<br>
>><br>
>> expMask, mantissaMask :: Word#<br>
>> expMask = 0x7FF0000000000000##<br>
>> mantissaMask = 0x000FFFFFFFFFFFFF##<br>
>><br>
>> main :: IO ()<br>
>> main = sumFilter isNaN {-isNaN'-} {-isNaNBits-} (mkInput 100000000)<br>
>> `seq` pure ()<br>
>> where<br>
>> nan :: Double<br>
>> nan = log (-1)<br>
>><br>
>> mkInput :: Int -> [Double]<br>
>> mkInput n = take n $ cycle [1, nan]<br>
>><br>
>> sumFilter :: (Double -> Bool) -> [Double] -> Double<br>
>> sumFilter p = Prelude.sum . Prelude.filter (not . p)<br>
>> ```<br>
>><br>
>> --<br>
>> Mateusz K.<br>
>> ______________________________<wbr>_________________<br>
>> ghc-devs mailing list<br>
>> <a href="mailto:ghc-devs@haskell.org">ghc-devs@haskell.org</a><br>
>> <a href="http://mail.haskell.org/cgi-bin/mailman/listinfo/ghc-devs" rel="noreferrer" target="_blank">http://mail.haskell.org/cgi-<wbr>bin/mailman/listinfo/ghc-devs</a><br>
>><br>
><br>
><br>
><br>
<br>
<br>
--<br>
</div></div>Mateusz K.<br>
</blockquote></div><br><br clear="all"><div><br></div>-- <br><div class="gmail_signature" data-smartmail="gmail_signature"><div dir="ltr"><div>brandon s allbery kf8nh sine nomine associates</div><div><a href="mailto:allbery.b@gmail.com" target="_blank">allbery.b@gmail.com</a> <a href="mailto:ballbery@sinenomine.net" target="_blank">ballbery@sinenomine.net</a></div><div>unix, openafs, kerberos, infrastructure, xmonad <a href="http://sinenomine.net" target="_blank">http://sinenomine.net</a></div></div></div>
</div>