Actually, looking at the docs, I'm not sure if case expressions work on unboxed ints; you may need
addCarry (I# x) (I# y) = case addIntC# x y of (# s, c #) -> (I# s, c /=# 0#)
which is somewhat simpler anyways.
-- ryan
Sure, but it's easy to roll your own from those primitives:
{-# LANGUAGE MagicHash, UnboxedTuples #-}
import GHC.Exts
addCarry :: Int -> Int -> (Int, Bool)
addCarry (I# x) (I# y) = case addIntC# x y of
(# s, c #) -> case c of
0# -> (I# s, False)
_ -> (I# s, True)
or something along those lines.
-- ryanOn Mon, Jul 30, 2012 at 1:43 PM, Евгений Пермяков <permeakra@gmail.com> wrote:
Still no way to detect overflow in *.On 07/31/2012 12:04 AM, Artyom Kazak wrote:
Евгений Пермяков <permeakra@gmail.com> писал в своём письме Mon, 30 Jul 2012 09:47:48 +0300:
Can someone tell me if there are any primitives, that used to detect machine type overflows, in ghc haskell ? I perfectly understand, that I can build something based on preconditioning of variables, but this will kill any performance, if needed.
In GHC.Prim — primitives addIntC# and subIntC#:
addIntC# :: Int# -> Int# -> (#Int#, Int##)
Add with carry. First member of result is (wrapped) sum; second member is 0 iff no overflow occured.
subIntC# :: Int# -> Int# -> (#Int#, Int##)
Subtract with carry. First member of result is (wrapped) difference; second member is 0 iff no overflow occured.
_______________________________________________
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe
Strangely enough, I found some relevant descriptions in *.pp in dev branch, so I expect them in 7.6.1. They applies to native-size Word and Int only.
_______________________________________________
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe