<div dir="ltr">You should be able to reduce the bit-twiddling a great deal IIRC in the word case.<div><br></div><div>SW a + SW b</div><div>  | c <- a + b, c >= min a b = SW c</div><div>  | otherwise = throw Overflow</div><div><br></div><div>There is a similar trick that escapes me at the moment for the signed case.</div><div><br></div></div><div class="gmail_extra"><br><div class="gmail_quote">On Sun, Jun 28, 2015 at 6:15 PM, Nikita Karetnikov <span dir="ltr"><<a href="mailto:nikita@karetnikov.org" target="_blank">nikita@karetnikov.org</a>></span> wrote:<br><blockquote class="gmail_quote" style="margin:0 0 0 .8ex;border-left:1px #ccc solid;padding-left:1ex">Haskell is often marketed as a safe (or safer) language, but there's<br>
an issue that makes it less safe as it could be.  I'm talking about<br>
arithmetic overflows and division by zero.  The safeint package tries<br>
to address this, but it only supports the Int type because (as I<br>
understand it) there are no useful primitives for other common types<br>
defined in Data.Int and Data.Word.<br>
<br>
I've tried adding Int64 support to safeint just to see how it would work<br>
without primops.  Here's a snippet (I haven't tested this code well, so<br>
it may be wrong, sorry about that):<br>
<br>
shiftRUnsigned :: Word64 -> Int -> Word64<br>
shiftRUnsigned = shiftR<br>
<br>
-- <a href="http://git.haskell.org/ghc.git/blob/HEAD:/compiler/codeGen/StgCmmPrim.hs#l930
plusSI64" rel="noreferrer" target="_blank">http://git.haskell.org/ghc.git/blob/HEAD:/compiler/codeGen/StgCmmPrim.hs#l930<br>
plusSI64</a> :: SafeInt64 -> SafeInt64 -> SafeInt64<br>
plusSI64 (SI64 a) (SI64 b) = if c == 0 then SI64 r else overflowError<br>
  where<br>
    r = a + b<br>
    c = (fromIntegral $ (complement (a `xor` b)) .&. (a `xor` r))<br>
        `shiftRUnsigned`<br>
        ((finiteBitSize a) - 1)<br>
<br>
-- <a href="http://git.haskell.org/ghc.git/blob/HEAD:/compiler/codeGen/StgCmmPrim.hs#l966
minusSI64" rel="noreferrer" target="_blank">http://git.haskell.org/ghc.git/blob/HEAD:/compiler/codeGen/StgCmmPrim.hs#l966<br>
minusSI64</a> :: SafeInt64 -> SafeInt64 -> SafeInt64<br>
minusSI64 (SI64 a) (SI64 b) = if c == 0 then SI64 r else overflowError<br>
  where<br>
    r = a - b<br>
    c = (fromIntegral $ (a `xor` b) .&. (a `xor` r))<br>
        `shiftRUnsigned`<br>
        ((finiteBitSize a) - 1)<br>
<br>
-- <a href="https://stackoverflow.com/a/1815371" rel="noreferrer" target="_blank">https://stackoverflow.com/a/1815371</a><br>
timesSI64 :: SafeInt64 -> SafeInt64 -> SafeInt64<br>
timesSI64 (SI64 a) (SI64 b) =<br>
  let x = a * b<br>
  in if a /= 0 && x `div` a /= b<br>
     then overflowError<br>
     else SI64 x<br>
<br>
I may be wrong, but my understanding is that new primops could reduce<br>
overhead here.  If so, would a patch adding them be accepted?  Are<br>
there any caveats?<br>
<br>
In the safeint package, would it be reasonable to return an Either<br>
value instead of throwing an exception?  Or would it be too much?<br>
<br>
I haven't created a wiki page or ticket because I don't know much, so<br>
I want to get some feedback before doing so.  That would be my first<br>
patch to GHC (if ever), so maybe I'm not the best candidate, but I've<br>
been thinking about it for too long to ignore. :\<br>
_______________________________________________<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-bin/mailman/listinfo/ghc-devs</a><br>
</blockquote></div><br></div>