diff options
author | John Ericson <git@JohnEricson.me> | 2019-10-19 18:59:48 -0400 |
---|---|---|
committer | John Ericson <John.Ericson@Obsidian.Systems> | 2021-04-29 21:09:36 -0400 |
commit | 4e1d9e0324f4649638c1f5d1d529f5afab109065 (patch) | |
tree | ec34d6a4c021a9831f3ba4c3890d850af14dd5ad | |
parent | 2d2985a79eec3d6ae9aee96b264c97c2b158f196 (diff) | |
download | haskell-wip/sized-arith-primops-for-sized-box.tar.gz |
Use fix-sized arithmetic primops for fixed size boxed typeswip/sized-arith-primops-for-sized-box
We think the compiler is ready, so we can do this for all over the 8-,
16-, and 32-bit boxed types.
We are holding off on doing all the primops at once so things are easier
to investigate.
-rw-r--r-- | libraries/base/GHC/Int.hs | 84 | ||||
-rw-r--r-- | libraries/base/GHC/Word.hs | 61 | ||||
-rw-r--r-- | libraries/ghc-prim/GHC/Classes.hs | 176 |
3 files changed, 211 insertions, 110 deletions
diff --git a/libraries/base/GHC/Int.hs b/libraries/base/GHC/Int.hs index 6713130c14..c3e8a62495 100644 --- a/libraries/base/GHC/Int.hs +++ b/libraries/base/GHC/Int.hs @@ -97,10 +97,10 @@ instance Show Int8 where -- | @since 2.01 instance Num Int8 where - (I8# x#) + (I8# y#) = I8# (intToInt8# ((int8ToInt# x#) +# (int8ToInt# y#))) - (I8# x#) - (I8# y#) = I8# (intToInt8# ((int8ToInt# x#) -# (int8ToInt# y#))) - (I8# x#) * (I8# y#) = I8# (intToInt8# ((int8ToInt# x#) *# (int8ToInt# y#))) - negate (I8# x#) = I8# (intToInt8# (negateInt# (int8ToInt# x#))) + (I8# x#) + (I8# y#) = I8# (x# `plusInt8#` y#) + (I8# x#) - (I8# y#) = I8# (x# `subInt8#` y#) + (I8# x#) * (I8# y#) = I8# (x# `timesInt8#` y#) + negate (I8# x#) = I8# (negateInt8# x#) abs x | x >= 0 = x | otherwise = negate x signum x | x > 0 = 1 @@ -133,7 +133,7 @@ instance Integral Int8 where quot x@(I8# x#) y@(I8# y#) | y == 0 = divZeroError | y == (-1) && x == minBound = overflowError -- Note [Order of tests] - | otherwise = I8# (intToInt8# ((int8ToInt# x#) `quotInt#` (int8ToInt# y#))) + | otherwise = I8# (x# `quotInt8#` y#) rem (I8# x#) y@(I8# y#) | y == 0 = divZeroError -- The quotRem CPU instruction might fail for 'minBound @@ -141,11 +141,11 @@ instance Integral Int8 where -- width of signed integer. But, 'minBound `rem` -1' is -- well-defined (0). We therefore special-case it. | y == (-1) = 0 - | otherwise = I8# (intToInt8# ((int8ToInt# x#) `remInt#` (int8ToInt# y#))) + | otherwise = I8# (x# `remInt8#` y#) div x@(I8# x#) y@(I8# y#) | y == 0 = divZeroError | y == (-1) && x == minBound = overflowError -- Note [Order of tests] - | otherwise = I8# (intToInt8# ((int8ToInt# x#) `divInt#` (int8ToInt# y#))) + | otherwise = I8# (x# `divInt8#` y#) mod (I8# x#) y@(I8# y#) | y == 0 = divZeroError -- The divMod CPU instruction might fail for 'minBound @@ -153,23 +153,19 @@ instance Integral Int8 where -- width of signed integer. But, 'minBound `mod` -1' is -- well-defined (0). We therefore special-case it. | y == (-1) = 0 - | otherwise = I8# (intToInt8# ((int8ToInt# x#) `modInt#` (int8ToInt# y#))) + | otherwise = I8# (x# `modInt8#` y#) quotRem x@(I8# x#) y@(I8# y#) | y == 0 = divZeroError -- Note [Order of tests] | y == (-1) && x == minBound = (overflowError, 0) - | otherwise = case (int8ToInt# x#) `quotRemInt#` (int8ToInt# y#) of - (# q, r #) -> - (I8# (intToInt8# q), - I8# (intToInt8# r)) + | otherwise = case x# `quotRemInt8#` y# of + (# q, r #) -> (I8# q, I8# r) divMod x@(I8# x#) y@(I8# y#) | y == 0 = divZeroError -- Note [Order of tests] | y == (-1) && x == minBound = (overflowError, 0) - | otherwise = case (int8ToInt# x#) `divModInt#` (int8ToInt# y#) of - (# d, m #) -> - (I8# (intToInt8# d), - I8# (intToInt8# m)) + | otherwise = case x# `divModInt8#` y# of + (# d, m #) -> (I8# d, I8# m) toInteger (I8# x#) = IS (int8ToInt# x#) -- | @since 2.01 @@ -314,10 +310,10 @@ instance Show Int16 where -- | @since 2.01 instance Num Int16 where - (I16# x#) + (I16# y#) = I16# (intToInt16# ((int16ToInt# x#) +# (int16ToInt# y#))) - (I16# x#) - (I16# y#) = I16# (intToInt16# ((int16ToInt# x#) -# (int16ToInt# y#))) - (I16# x#) * (I16# y#) = I16# (intToInt16# ((int16ToInt# x#) *# (int16ToInt# y#))) - negate (I16# x#) = I16# (intToInt16# (negateInt# (int16ToInt# x#))) + (I16# x#) + (I16# y#) = I16# (x# `plusInt16#` y#) + (I16# x#) - (I16# y#) = I16# (x# `subInt16#` y#) + (I16# x#) * (I16# y#) = I16# (x# `timesInt16#` y#) + negate (I16# x#) = I16# (negateInt16# x#) abs x | x >= 0 = x | otherwise = negate x signum x | x > 0 = 1 @@ -350,7 +346,7 @@ instance Integral Int16 where quot x@(I16# x#) y@(I16# y#) | y == 0 = divZeroError | y == (-1) && x == minBound = overflowError -- Note [Order of tests] - | otherwise = I16# (intToInt16# ((int16ToInt# x#) `quotInt#` (int16ToInt# y#))) + | otherwise = I16# (x# `quotInt16#` y#) rem (I16# x#) y@(I16# y#) | y == 0 = divZeroError -- The quotRem CPU instruction might fail for 'minBound @@ -358,11 +354,11 @@ instance Integral Int16 where -- width of signed integer. But, 'minBound `rem` -1' is -- well-defined (0). We therefore special-case it. | y == (-1) = 0 - | otherwise = I16# (intToInt16# ((int16ToInt# x#) `remInt#` (int16ToInt# y#))) + | otherwise = I16# (x# `remInt16#` y#) div x@(I16# x#) y@(I16# y#) | y == 0 = divZeroError | y == (-1) && x == minBound = overflowError -- Note [Order of tests] - | otherwise = I16# (intToInt16# ((int16ToInt# x#) `divInt#` (int16ToInt# y#))) + | otherwise = I16# (x# `divInt16#` y#) mod (I16# x#) y@(I16# y#) | y == 0 = divZeroError -- The divMod CPU instruction might fail for 'minBound @@ -370,23 +366,19 @@ instance Integral Int16 where -- width of signed integer. But, 'minBound `mod` -1' is -- well-defined (0). We therefore special-case it. | y == (-1) = 0 - | otherwise = I16# (intToInt16# ((int16ToInt# x#) `modInt#` (int16ToInt# y#))) + | otherwise = I16# (x# `modInt16#` y#) quotRem x@(I16# x#) y@(I16# y#) | y == 0 = divZeroError -- Note [Order of tests] | y == (-1) && x == minBound = (overflowError, 0) - | otherwise = case (int16ToInt# x#) `quotRemInt#` (int16ToInt# y#) of - (# q, r #) -> - (I16# (intToInt16# q), - I16# (intToInt16# r)) + | otherwise = case x# `quotRemInt16#` y# of + (# q, r #) -> (I16# q, I16# r) divMod x@(I16# x#) y@(I16# y#) | y == 0 = divZeroError -- Note [Order of tests] | y == (-1) && x == minBound = (overflowError, 0) - | otherwise = case (int16ToInt# x#) `divModInt#` (int16ToInt# y#) of - (# d, m #) -> - (I16# (intToInt16# d), - I16# (intToInt16# m)) + | otherwise = case x# `divModInt16#` y# of + (# d, m #) -> (I16# d, I16# m) toInteger (I16# x#) = IS (int16ToInt# x#) -- | @since 2.01 @@ -536,10 +528,10 @@ instance Show Int32 where -- | @since 2.01 instance Num Int32 where - (I32# x#) + (I32# y#) = I32# (intToInt32# ((int32ToInt# x#) +# (int32ToInt# y#))) - (I32# x#) - (I32# y#) = I32# (intToInt32# ((int32ToInt# x#) -# (int32ToInt# y#))) - (I32# x#) * (I32# y#) = I32# (intToInt32# ((int32ToInt# x#) *# (int32ToInt# y#))) - negate (I32# x#) = I32# (intToInt32# (negateInt# (int32ToInt# x#))) + (I32# x#) + (I32# y#) = I32# (x# `plusInt32#` y#) + (I32# x#) - (I32# y#) = I32# (x# `subInt32#` y#) + (I32# x#) * (I32# y#) = I32# (x# `timesInt32#` y#) + negate (I32# x#) = I32# (negateInt32# x#) abs x | x >= 0 = x | otherwise = negate x signum x | x > 0 = 1 @@ -572,7 +564,7 @@ instance Integral Int32 where quot x@(I32# x#) y@(I32# y#) | y == 0 = divZeroError | y == (-1) && x == minBound = overflowError -- Note [Order of tests] - | otherwise = I32# (intToInt32# ((int32ToInt# x#) `quotInt#` (int32ToInt# y#))) + | otherwise = I32# (x# `quotInt32#` y#) rem (I32# x#) y@(I32# y#) | y == 0 = divZeroError -- The quotRem CPU instruction might fail for 'minBound @@ -580,11 +572,11 @@ instance Integral Int32 where -- width of signed integer. But, 'minBound `rem` -1' is -- well-defined (0). We therefore special-case it. | y == (-1) = 0 - | otherwise = I32# (intToInt32# ((int32ToInt# x#) `remInt#` (int32ToInt# y#))) + | otherwise = I32# (x# `remInt32#` y#) div x@(I32# x#) y@(I32# y#) | y == 0 = divZeroError | y == (-1) && x == minBound = overflowError -- Note [Order of tests] - | otherwise = I32# (intToInt32# ((int32ToInt# x#) `divInt#` (int32ToInt# y#))) + | otherwise = I32# (x# `divInt32#` y#) mod (I32# x#) y@(I32# y#) | y == 0 = divZeroError -- The divMod CPU instruction might fail for 'minBound @@ -592,23 +584,19 @@ instance Integral Int32 where -- width of signed integer. But, 'minBound `mod` -1' is -- well-defined (0). We therefore special-case it. | y == (-1) = 0 - | otherwise = I32# (intToInt32# ((int32ToInt# x#) `modInt#` (int32ToInt# y#))) + | otherwise = I32# (x# `modInt32#` y#) quotRem x@(I32# x#) y@(I32# y#) | y == 0 = divZeroError -- Note [Order of tests] | y == (-1) && x == minBound = (overflowError, 0) - | otherwise = case (int32ToInt# x#) `quotRemInt#` (int32ToInt# y#) of - (# q, r #) -> - (I32# (intToInt32# q), - I32# (intToInt32# r)) + | otherwise = case x# `quotRemInt32#` y# of + (# q, r #) -> (I32# q, I32# r) divMod x@(I32# x#) y@(I32# y#) | y == 0 = divZeroError -- Note [Order of tests] | y == (-1) && x == minBound = (overflowError, 0) - | otherwise = case (int32ToInt# x#) `divModInt#` (int32ToInt# y#) of - (# d, m #) -> - (I32# (intToInt32# d), - I32# (intToInt32# m)) + | otherwise = case x# `divModInt32#` y# of + (# d, m #) -> (I32# d, I32# m) toInteger (I32# x#) = IS (int32ToInt# x#) -- | @since 2.01 diff --git a/libraries/base/GHC/Word.hs b/libraries/base/GHC/Word.hs index 77d63cc9d7..435cff797d 100644 --- a/libraries/base/GHC/Word.hs +++ b/libraries/base/GHC/Word.hs @@ -108,10 +108,10 @@ instance Show Word8 where -- | @since 2.01 instance Num Word8 where - (W8# x#) + (W8# y#) = W8# (wordToWord8# ((word8ToWord# x#) `plusWord#` (word8ToWord# y#))) - (W8# x#) - (W8# y#) = W8# (wordToWord8# ((word8ToWord# x#) `minusWord#` (word8ToWord# y#))) - (W8# x#) * (W8# y#) = W8# (wordToWord8# ((word8ToWord# x#) `timesWord#` (word8ToWord# y#))) - negate (W8# x#) = W8# (wordToWord8# (int2Word# (negateInt# (word2Int# ((word8ToWord# x#)))))) + (W8# x#) + (W8# y#) = W8# (x# `plusWord8#` y#) + (W8# x#) - (W8# y#) = W8# (x# `subWord8#` y#) + (W8# x#) * (W8# y#) = W8# (x# `timesWord8#` y#) + negate (W8# x#) = W8# (int8ToWord8# (negateInt8# (word8ToInt8# x#))) abs x = x signum 0 = 0 signum _ = 1 @@ -140,25 +140,24 @@ instance Enum Word8 where -- | @since 2.01 instance Integral Word8 where quot (W8# x#) y@(W8# y#) - | y /= 0 = W8# (wordToWord8# ((word8ToWord# x#) `quotWord#` (word8ToWord# y#))) + | y /= 0 = W8# (x# `quotWord8#` y#) | otherwise = divZeroError rem (W8# x#) y@(W8# y#) - | y /= 0 = W8# (wordToWord8# ((word8ToWord# x#) `remWord#` (word8ToWord# y#))) + | y /= 0 = W8# (x# `remWord8#` y#) | otherwise = divZeroError div (W8# x#) y@(W8# y#) - | y /= 0 = W8# (wordToWord8# ((word8ToWord# x#) `quotWord#` (word8ToWord# y#))) + | y /= 0 = W8# (x# `quotWord8#` y#) | otherwise = divZeroError mod (W8# x#) y@(W8# y#) - | y /= 0 = W8# (wordToWord8# ((word8ToWord# x#) `remWord#` (word8ToWord# y#))) + | y /= 0 = W8# (x# `remWord8#` y#) | otherwise = divZeroError quotRem (W8# x#) y@(W8# y#) - | y /= 0 = case (word8ToWord# x#) `quotRemWord#` (word8ToWord# y#) of - (# q, r #) -> - (W8# (wordToWord8# q), W8# (wordToWord8# r)) + | y /= 0 = case x# `quotRemWord8#` y# of + (# q, r #) -> (W8# q, W8# r) | otherwise = divZeroError divMod (W8# x#) y@(W8# y#) - | y /= 0 = (W8# (wordToWord8# ((word8ToWord# x#) `quotWord#` (word8ToWord# y#))) - ,W8# (wordToWord8# ((word8ToWord# x#) `remWord#` (word8ToWord# y#)))) + | y /= 0 = (W8# (x# `quotWord8#` y#) + ,W8# (x# `remWord8#` y#)) | otherwise = divZeroError toInteger (W8# x#) = IS (word2Int# (word8ToWord# x#)) @@ -299,10 +298,10 @@ instance Show Word16 where -- | @since 2.01 instance Num Word16 where - (W16# x#) + (W16# y#) = W16# (wordToWord16# ((word16ToWord# x#) `plusWord#` (word16ToWord# y#))) - (W16# x#) - (W16# y#) = W16# (wordToWord16# ((word16ToWord# x#) `minusWord#` (word16ToWord# y#))) - (W16# x#) * (W16# y#) = W16# (wordToWord16# ((word16ToWord# x#) `timesWord#` (word16ToWord# y#))) - negate (W16# x#) = W16# (wordToWord16# (int2Word# (negateInt# (word2Int# (word16ToWord# x#))))) + (W16# x#) + (W16# y#) = W16# (x# `plusWord16#` y#) + (W16# x#) - (W16# y#) = W16# (x# `subWord16#` y#) + (W16# x#) * (W16# y#) = W16# (x# `timesWord16#` y#) + negate (W16# x#) = W16# (int16ToWord16# (negateInt16# (word16ToInt16# x#))) abs x = x signum 0 = 0 signum _ = 1 @@ -529,10 +528,10 @@ gtWord32, geWord32, ltWord32, leWord32 :: Word32 -> Word32 -> Bool -- | @since 2.01 instance Num Word32 where - (W32# x#) + (W32# y#) = W32# (wordToWord32# ((word32ToWord# x#) `plusWord#` (word32ToWord# y#))) - (W32# x#) - (W32# y#) = W32# (wordToWord32# ((word32ToWord# x#) `minusWord#` (word32ToWord# y#))) - (W32# x#) * (W32# y#) = W32# (wordToWord32# ((word32ToWord# x#) `timesWord#` (word32ToWord# y#))) - negate (W32# x#) = W32# (wordToWord32# (int2Word# (negateInt# (word2Int# (word32ToWord# x#))))) + (W32# x#) + (W32# y#) = W32# (x# `plusWord32#` y#) + (W32# x#) - (W32# y#) = W32# (x# `subWord32#` y#) + (W32# x#) * (W32# y#) = W32# (x# `timesWord32#` y#) + negate (W32# x#) = W32# (int32ToWord32# (negateInt32# (word32ToInt32# x#))) abs x = x signum 0 = 0 signum _ = 1 @@ -571,25 +570,24 @@ instance Enum Word32 where -- | @since 2.01 instance Integral Word32 where quot (W32# x#) y@(W32# y#) - | y /= 0 = W32# (wordToWord32# ((word32ToWord# x#) `quotWord#` (word32ToWord# y#))) + | y /= 0 = W32# (x# `quotWord32#` y#) | otherwise = divZeroError rem (W32# x#) y@(W32# y#) - | y /= 0 = W32# (wordToWord32# ((word32ToWord# x#) `remWord#` (word32ToWord# y#))) + | y /= 0 = W32# (x# `remWord32#` y#) | otherwise = divZeroError div (W32# x#) y@(W32# y#) - | y /= 0 = W32# (wordToWord32# ((word32ToWord# x#) `quotWord#` (word32ToWord# y#))) + | y /= 0 = W32# (x# `quotWord32#` y#) | otherwise = divZeroError mod (W32# x#) y@(W32# y#) - | y /= 0 = W32# (wordToWord32# ((word32ToWord# x#) `remWord#` (word32ToWord# y#))) + | y /= 0 = W32# (x# `remWord32#` y#) | otherwise = divZeroError quotRem (W32# x#) y@(W32# y#) - | y /= 0 = case (word32ToWord# x#) `quotRemWord#` (word32ToWord# y#) of - (# q, r #) -> - (W32# (wordToWord32# q), W32# (wordToWord32# r)) + | y /= 0 = case x# `quotRemWord32#` y# of + (# q, r #) -> (W32# q, W32# r) | otherwise = divZeroError divMod (W32# x#) y@(W32# y#) - | y /= 0 = (W32# (wordToWord32# ((word32ToWord# x#) `quotWord#` (word32ToWord# y#))) - ,W32# (wordToWord32# ((word32ToWord# x#) `remWord#` (word32ToWord# y#)))) + | y /= 0 = (W32# (x# `quotWord32#` y#) + ,W32# (x# `remWord32#` y#)) | otherwise = divZeroError toInteger (W32# x#) #if WORD_SIZE_IN_BITS == 32 @@ -950,8 +948,7 @@ instance Integral Word64 where | otherwise = divZeroError quotRem (W64# x#) y@(W64# y#) | y /= 0 = case x# `quotRemWord#` y# of - (# q, r #) -> - (W64# q, W64# r) + (# q, r #) -> (W64# q, W64# r) | otherwise = divZeroError divMod (W64# x#) y@(W64# y#) | y /= 0 = (W64# (x# `quotWord#` y#), W64# (x# `remWord#` y#)) diff --git a/libraries/ghc-prim/GHC/Classes.hs b/libraries/ghc-prim/GHC/Classes.hs index 29a57afd91..d16674a2ba 100644 --- a/libraries/ghc-prim/GHC/Classes.hs +++ b/libraries/ghc-prim/GHC/Classes.hs @@ -51,7 +51,9 @@ module GHC.Classes( (&&), (||), not, -- * Integer arithmetic - divInt#, modInt#, divModInt# + divInt#, divInt8#, divInt16#, divInt32#, + modInt#, modInt8#, modInt16#, modInt32# + divModInt#, divModInt8#, divModInt16#, divModInt32# ) where -- GHC.Magic is used in some derived instances @@ -541,10 +543,7 @@ not False = True -- put them -- These functions have built-in rules. -{-# INLINE [0] divInt# #-} -{-# INLINE [0] modInt# #-} -{-# INLINE [0] divModInt# #-} - +{-# NOINLINE [0] divInt# #-} divInt# :: Int# -> Int# -> Int# x# `divInt#` y# = ((x# +# bias#) `quotInt#` y#) -# hard# where @@ -555,30 +554,41 @@ x# `divInt#` y# = ((x# +# bias#) `quotInt#` y#) -# hard# !bias# = c0# -# c1# !hard# = c0# `orI#` c1# -modInt# :: Int# -> Int# -> Int# -x# `modInt#` y# = r# +# k# - where - -- See Note [modInt# implementation] - !yn# = y# <# 0# - !c0# = (x# <# 0#) `andI#` (notI# yn#) - !c1# = (x# ># 0#) `andI#` yn# - !s# = 0# -# ((c0# `orI#` c1#) `andI#` (r# /=# 0#)) - !k# = s# `andI#` y# - !r# = x# `remInt#` y# - -divModInt# :: Int# -> Int# -> (# Int#, Int# #) -x# `divModInt#` y# = case (x# +# bias#) `quotRemInt#` y# of - (# q#, r# #) -> (# q# -# hard#, r# +# k# #) - where - -- See Note [divModInt# implementation] - !yn# = y# <# 0# - !c0# = (x# <# 0#) `andI#` (notI# yn#) - !c1# = (x# ># 0#) `andI#` yn# - !bias# = c0# -# c1# - !hard# = c0# `orI#` c1# - !s# = 0# -# hard# - !k# = (s# `andI#` y#) -# bias# - +{-# NOINLINE [0] divInt8# #-} +-- FIXME make branchless after we have sized bit-twiddling primops. +divInt8# :: Int8# -> Int8# -> Int8# +x# `divInt8#` y# + | y0x = ((x# `subInt8#` one#) `quotInt8#` y#) `subInt8#` one# + | x0y = ((x# `plusInt8#` one#) `quotInt8#` y#) `subInt8#` one# + | True = x# `quotInt8#` y# + where zero# = intToInt8# 0# + one# = intToInt8# 1# + y0x = isTrue# (x# `gtInt8#` zero#) && isTrue# (y# `ltInt8#` zero#) + x0y = isTrue# (x# `ltInt8#` zero#) && isTrue# (y# `gtInt8#` zero#) + +{-# NOINLINE [0] divInt16# #-} +-- FIXME make branchless after we have sized bit-twiddling primops. +divInt16# :: Int16# -> Int16# -> Int16# +x# `divInt16#` y# + | y0x = ((x# `subInt16#` one#) `quotInt16#` y#) `subInt16#` one# + | x0y = ((x# `plusInt16#` one#) `quotInt16#` y#) `subInt16#` one# + | True = x# `quotInt16#` y# + where zero# = intToInt16# 0# + one# = intToInt16# 1# + y0x = isTrue# (x# `gtInt16#` zero#) && isTrue# (y# `ltInt16#` zero#) + x0y = isTrue# (x# `ltInt16#` zero#) && isTrue# (y# `gtInt16#` zero#) + +{-# NOINLINE [0] divInt32# #-} +-- FIXME make branchless after we have sized bit-twiddling primops. +divInt32# :: Int32# -> Int32# -> Int32# +x# `divInt32#` y# + | y0x = ((x# `subInt32#` one#) `quotInt32#` y#) `subInt32#` one# + | x0y = ((x# `plusInt32#` one#) `quotInt32#` y#) `subInt32#` one# + | True = x# `quotInt32#` y# + where zero# = intToInt32# 0# + one# = intToInt32# 1# + y0x = isTrue# (x# `gtInt32#` zero#) && isTrue# (y# `ltInt32#` zero#) + x0y = isTrue# (x# `ltInt32#` zero#) && isTrue# (y# `gtInt32#` zero#) -- See Note [divInt# implementation] -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -638,6 +648,53 @@ x# `divModInt#` y# = case (x# +# bias#) `quotRemInt#` y# of -- | (x# ># 0#) && (y# <# 0#) = ((x# -# y#) -# 1#) `quotInt#` y# -- | (x# <# 0#) && (y# ># 0#) = ((x# -# y#) +# 1#) `quotInt#` y# +{-# INLINE [0] modInt# #-} +modInt# :: Int# -> Int# -> Int# +x# `modInt#` y# = r# +# k# + where + -- See Note [modInt# implementation] + !yn# = y# <# 0# + !c0# = (x# <# 0#) `andI#` (notI# yn#) + !c1# = (x# ># 0#) `andI#` yn# + !s# = 0# -# ((c0# `orI#` c1#) `andI#` (r# /=# 0#)) + !k# = s# `andI#` y# + !r# = x# `remInt#` y# + +{-# NOINLINE [0] modInt8# #-} +-- FIXME make branchless after we have sized bit-twiddling primops. +modInt8# :: Int8# -> Int8# -> Int8# +x# `modInt8#` y# + = if isTrue# (x# `gtInt8#` zero#) && isTrue# (y# `ltInt8#` zero#) || + isTrue# (x# `ltInt8#` zero#) && isTrue# (y# `gtInt8#` zero#) + then if isTrue# (r# `neInt8#` zero#) then r# `plusInt8#` y# else zero# + else r# + where + !r# = x# `remInt8#` y# + zero# = intToInt8# 0# + +{-# NOINLINE [0] modInt16# #-} +-- FIXME make branchless after we have sized bit-twiddling primops. +modInt16# :: Int16# -> Int16# -> Int16# +x# `modInt16#` y# + = if isTrue# (x# `gtInt16#` zero#) && isTrue# (y# `ltInt16#` zero#) || + isTrue# (x# `ltInt16#` zero#) && isTrue# (y# `gtInt16#` zero#) + then if isTrue# (r# `neInt16#` zero#) then r# `plusInt16#` y# else zero# + else r# + where + !r# = x# `remInt16#` y# + zero# = intToInt16# 0# + +{-# NOINLINE [0] modInt32# #-} +-- FIXME make branchless after we have sized bit-twiddling primops. +modInt32# :: Int32# -> Int32# -> Int32# +x# `modInt32#` y# + = if isTrue# (x# `gtInt32#` zero#) && isTrue# (y# `ltInt32#` zero#) || + isTrue# (x# `ltInt32#` zero#) && isTrue# (y# `gtInt32#` zero#) + then if isTrue# (r# `neInt32#` zero#) then r# `plusInt32#` y# else zero# + else r# + where + !r# = x# `remInt32#` y# + zero# = intToInt32# 0# -- Note [modInt# implementation] -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -673,7 +730,7 @@ x# `divModInt#` y# = case (x# +# bias#) `quotRemInt#` y# of -- then y# -- else 0# -- r# = x# `remInt#` y# --- +e- -- ===> { Select y# or 0# in branchless way } -- -- r# +# k# @@ -689,6 +746,65 @@ x# `divModInt#` y# = case (x# +# bias#) `quotRemInt#` y# of -- k# = s# &&# y# -- r# = x# `remInt#` y# +{-# INLINE [0] divModInt# #-} +divModInt# :: Int# -> Int# -> (# Int#, Int# #) +x# `divModInt#` y# = case (x# +# bias#) `quotRemInt#` y# of + (# q#, r# #) -> (# q# -# hard#, r# +# k# #) + where + -- See Note [divModInt# implementation] + !yn# = y# <# 0# + !c0# = (x# <# 0#) `andI#` (notI# yn#) + !c1# = (x# ># 0#) `andI#` yn# + !bias# = c0# -# c1# + !hard# = c0# `orI#` c1# + !s# = 0# -# hard# + !k# = (s# `andI#` y#) -# bias# + +{-# INLINE [0] divModInt8# #-} +-- FIXME make branchless after we have sized bit-twiddling primops. +divModInt8# :: Int8# -> Int8# -> (# Int8#, Int8# #) +x# `divModInt8#` y# + | isTrue# (x# `gtInt8#` zero#) && isTrue# (y# `ltInt8#` zero#) = + case (x# `subInt8#` one#) `quotRemInt8#` y# of + (# q, r #) -> (# q `subInt8#` one#, r `plusInt8#` y# `plusInt8#` one# #) + | isTrue# (x# `ltInt8#` zero#) && isTrue# (y# `gtInt8#` zero#) = + case (x# `plusInt8#` one#) `quotRemInt8#` y# of + (# q, r #) -> (# q `subInt8#` one#, r `plusInt8#` y# `subInt8#` one# #) + | otherwise = + x# `quotRemInt8#` y# + where zero# = intToInt8# 0# + one# = intToInt8# 1# + +{-# INLINE [0] divModInt16# #-} +-- FIXME make branchless after we have sized bit-twiddling primops. +divModInt16# :: Int16# -> Int16# -> (# Int16#, Int16# #) +x# `divModInt16#` y# + | isTrue# (x# `gtInt16#` zero#) && isTrue# (y# `ltInt16#` zero#) = + case (x# `subInt16#` one#) `quotRemInt16#` y# of + (# q, r #) -> (# q `subInt16#` one#, r `plusInt16#` y# `plusInt16#` one# #) + | isTrue# (x# `ltInt16#` zero#) && isTrue# (y# `gtInt16#` zero#) = + case (x# `plusInt16#` one#) `quotRemInt16#` y# of + (# q, r #) -> (# q `subInt16#` one#, r `plusInt16#` y# `subInt16#` one# #) + | otherwise = + x# `quotRemInt16#` y# + where zero# = intToInt16# 0# + one# = intToInt16# 1# + +{-# INLINE [0] divModInt32# #-} +-- FIXME make branchless after we have sized bit-twiddling primops. +divModInt32# :: Int32# -> Int32# -> (# Int32#, Int32# #) +x# `divModInt32#` y# + | isTrue# (x# `gtInt32#` zero#) && isTrue# (y# `ltInt32#` zero#) = + case (x# `subInt32#` one#) `quotRemInt32#` y# of + (# q, r #) -> (# q `subInt32#` one#, r `plusInt32#` y# `plusInt32#` one# #) + | isTrue# (x# `ltInt32#` zero#) && isTrue# (y# `gtInt32#` zero#) = + case (x# `plusInt32#` one#) `quotRemInt32#` y# of + (# q, r #) -> (# q `subInt32#` one#, r `plusInt32#` y# `subInt32#` one# #) + | otherwise = + x# `quotRemInt32#` y# + where zero# = intToInt32# 0# + one# = intToInt32# 1# + -- Note [divModInt# implementation] -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -- |