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. -- ryan On Mon, Jul 30, 2012 at 1:43 PM, Евгений Пермяков <permea...@gmail.com>wrote: > On 07/31/2012 12:04 AM, Artyom Kazak wrote: > >> Евгений Пермяков <permea...@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<http://www.haskell.org/mailman/listinfo/haskell-cafe> >> > Still no way to detect overflow in *. > > 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<http://www.haskell.org/mailman/listinfo/haskell-cafe> >
_______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe