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 On Tue, Jul 31, 2012 at 1:56 AM, Ryan Ingram <ryani.s...@gmail.com> wrote: > 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