<div dir="ltr">If the FFI version is done with "safe", consider using "unsafe" instead. There are technical reasons why this is slightly incorrect, but unless you're fiddling with the CPU's FP control flags they're mostly irrelevant and you can treat isNaN as pure and non-side-effectful, significantly reducing the overhead. You may also be able to use "ccall" to take advantage of C compiler level optimizations, or simply to directly invoke a CPU-based test with asm(); but you'll need to hide that in a C preprocessor #define, so that it looks syntactically like a function call to the FFI.<div><br></div><div>(One of the technical reasons is that various OSes have been known to introduce bugs in their FP register and state handling across system calls, in which case the "safe" version may turn "complete FP chaos" into merely "wrong answer". It's your call whether, or which side, of this bothers you.)</div></div><div class="gmail_extra"><br><div class="gmail_quote">On Mon, Mar 5, 2018 at 4:53 PM, 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">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>
<span class="HOEnZb"><font color="#888888"><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>
</font></span></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>