diff options
-rw-r--r-- | libraries/base/GHC/Base.hs | 66 | ||||
-rw-r--r-- | libraries/base/GHC/Int.hs | 229 | ||||
-rw-r--r-- | libraries/base/GHC/Word.hs | 186 | ||||
-rw-r--r-- | libraries/ghc-prim/GHC/Classes.hs | 72 |
4 files changed, 355 insertions, 198 deletions
diff --git a/libraries/base/GHC/Base.hs b/libraries/base/GHC/Base.hs index 205fee906b..ea4b4e5f4d 100644 --- a/libraries/base/GHC/Base.hs +++ b/libraries/base/GHC/Base.hs @@ -1665,6 +1665,18 @@ shiftL# :: Word# -> Int# -> Word# a `shiftL#` b | isTrue# (b >=# WORD_SIZE_IN_BITS#) = 0## | otherwise = a `uncheckedShiftL#` b +shiftLWord8# :: Word8# -> Int# -> Word8# +a `shiftLWord8#` b | isTrue# (b >=# 8#) = wordToWord8# 0## + | otherwise = a `uncheckedShiftLWord8#` b + +shiftLWord16# :: Word16# -> Int# -> Word16# +a `shiftLWord16#` b | isTrue# (b >=# 16#) = wordToWord16# 0## + | otherwise = a `uncheckedShiftLWord16#` b + +shiftLWord32# :: Word32# -> Int# -> Word32# +a `shiftLWord32#` b | isTrue# (b >=# 32#) = wordToWord32# 0## + | otherwise = a `uncheckedShiftLWord32#` b + -- | Shift the argument right by the specified number of bits -- (which must be non-negative). -- The "RL" means "right, logical" (as opposed to RA for arithmetic) @@ -1673,12 +1685,36 @@ shiftRL# :: Word# -> Int# -> Word# a `shiftRL#` b | isTrue# (b >=# WORD_SIZE_IN_BITS#) = 0## | otherwise = a `uncheckedShiftRL#` b +shiftRLWord8# :: Word8# -> Int# -> Word8# +a `shiftRLWord8#` b | isTrue# (b >=# 8#) = wordToWord8# 0## + | otherwise = a `uncheckedShiftRLWord8#` b + +shiftRLWord16# :: Word16# -> Int# -> Word16# +a `shiftRLWord16#` b | isTrue# (b >=# 16#) = wordToWord16# 0## + | otherwise = a `uncheckedShiftRLWord16#` b + +shiftRLWord32# :: Word32# -> Int# -> Word32# +a `shiftRLWord32#` b | isTrue# (b >=# 32#) = wordToWord32# 0## + | otherwise = a `uncheckedShiftRLWord32#` b + -- | Shift the argument left by the specified number of bits -- (which must be non-negative). iShiftL# :: Int# -> Int# -> Int# a `iShiftL#` b | isTrue# (b >=# WORD_SIZE_IN_BITS#) = 0# | otherwise = a `uncheckedIShiftL#` b +shiftLInt8# :: Int8# -> Int# -> Int8# +a `shiftLInt8#` b | isTrue# (b >=# 8#) = intToInt8# 0# + | otherwise = a `uncheckedShiftLInt8#` b + +shiftLInt16# :: Int16# -> Int# -> Int16# +a `shiftLInt16#` b | isTrue# (b >=# 16#) = intToInt16# 0# + | otherwise = a `uncheckedShiftLInt16#` b + +shiftLInt32# :: Int32# -> Int# -> Int32# +a `shiftLInt32#` b | isTrue# (b >=# 32#) = intToInt32# 0# + | otherwise = a `uncheckedShiftLInt32#` b + -- | Shift the argument right (signed) by the specified number of bits -- (which must be non-negative). -- The "RA" means "right, arithmetic" (as opposed to RL for logical) @@ -1688,6 +1724,24 @@ a `iShiftRA#` b | isTrue# (b >=# WORD_SIZE_IN_BITS#) = if isTrue# (a <# 0#) else 0# | otherwise = a `uncheckedIShiftRA#` b +shiftRAInt8# :: Int8# -> Int# -> Int8# +a `shiftRAInt8#` b | isTrue# (b >=# 8#) = if isTrue# (a `ltInt8#` (intToInt8# 0#)) + then intToInt8# (-1#) + else intToInt8# 0# + | otherwise = a `uncheckedShiftRAInt8#` b + +shiftRAInt16# :: Int16# -> Int# -> Int16# +a `shiftRAInt16#` b | isTrue# (b >=# 16#) = if isTrue# (a `ltInt16#` (intToInt16# 0#)) + then intToInt16# (-1#) + else intToInt16# 0# + | otherwise = a `uncheckedShiftRAInt16#` b + +shiftRAInt32# :: Int32# -> Int# -> Int32# +a `shiftRAInt32#` b | isTrue# (b >=# 32#) = if isTrue# (a `ltInt32#` (intToInt32# 0#)) + then intToInt32# (-1#) + else intToInt32# 0# + | otherwise = a `uncheckedShiftRAInt32#` b + -- | Shift the argument right (unsigned) by the specified number of bits -- (which must be non-negative). -- The "RL" means "right, logical" (as opposed to RA for arithmetic) @@ -1695,6 +1749,18 @@ iShiftRL# :: Int# -> Int# -> Int# a `iShiftRL#` b | isTrue# (b >=# WORD_SIZE_IN_BITS#) = 0# | otherwise = a `uncheckedIShiftRL#` b +shiftRLInt8# :: Int8# -> Int# -> Int8# +a `shiftRLInt8#` b | isTrue# (b >=# 8#) = intToInt8# 0# + | otherwise = a `uncheckedShiftRLInt8#` b + +shiftRLInt16# :: Int16# -> Int# -> Int16# +a `shiftRLInt16#` b | isTrue# (b >=# 16#) = intToInt16# 0# + | otherwise = a `uncheckedShiftRLInt16#` b + +shiftRLInt32# :: Int32# -> Int# -> Int32# +a `shiftRLInt32#` b | isTrue# (b >=# 32#) = intToInt32# 0# + | otherwise = a `uncheckedShiftRLInt32#` b + -- Rules for C strings (the functions themselves are now in GHC.CString) {-# RULES "unpack" [~1] forall a . unpackCString# a = build (unpackFoldrCString# a) diff --git a/libraries/base/GHC/Int.hs b/libraries/base/GHC/Int.hs index 6713130c14..3042e3adf1 100644 --- a/libraries/base/GHC/Int.hs +++ b/libraries/base/GHC/Int.hs @@ -69,8 +69,8 @@ instance Eq Int8 where (/=) = neInt8 eqInt8, neInt8 :: Int8 -> Int8 -> Bool -eqInt8 (I8# x) (I8# y) = isTrue# ((int8ToInt# x) ==# (int8ToInt# y)) -neInt8 (I8# x) (I8# y) = isTrue# ((int8ToInt# x) /=# (int8ToInt# y)) +eqInt8 (I8# x) (I8# y) = isTrue# (x `eqInt8#` y) +neInt8 (I8# x) (I8# y) = isTrue# (x `neInt8#` y) {-# INLINE [1] eqInt8 #-} {-# INLINE [1] neInt8 #-} @@ -86,10 +86,10 @@ instance Ord Int8 where {-# INLINE [1] ltInt8 #-} {-# INLINE [1] leInt8 #-} gtInt8, geInt8, ltInt8, leInt8 :: Int8 -> Int8 -> Bool -(I8# x) `gtInt8` (I8# y) = isTrue# ((int8ToInt# x) ># (int8ToInt# y)) -(I8# x) `geInt8` (I8# y) = isTrue# ((int8ToInt# x) >=# (int8ToInt# y)) -(I8# x) `ltInt8` (I8# y) = isTrue# ((int8ToInt# x) <# (int8ToInt# y)) -(I8# x) `leInt8` (I8# y) = isTrue# ((int8ToInt# x) <=# (int8ToInt# y)) +(I8# x) `gtInt8` (I8# y) = isTrue# (x `gtInt8#` y) +(I8# x) `geInt8` (I8# y) = isTrue# (x `geInt8#` y) +(I8# x) `ltInt8` (I8# y) = isTrue# (x `ltInt8#` y) +(I8# x) `leInt8` (I8# y) = isTrue# (x `leInt8#` y) -- | @since 2.01 instance Show Int8 where @@ -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,25 +153,34 @@ 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#) +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# + -- | @since 2.01 instance Bounded Int8 where minBound = -0x80 @@ -194,29 +203,29 @@ instance Bits Int8 where {-# INLINE testBit #-} {-# INLINE popCount #-} - (I8# x#) .&. (I8# y#) = I8# (intToInt8# ((int8ToInt# x#) `andI#` (int8ToInt# y#))) - (I8# x#) .|. (I8# y#) = I8# (intToInt8# ((int8ToInt# x#) `orI#` (int8ToInt# y#))) - (I8# x#) `xor` (I8# y#) = I8# (intToInt8# ((int8ToInt# x#) `xorI#` (int8ToInt# y#))) - complement (I8# x#) = I8# (intToInt8# (notI# (int8ToInt# x#))) + (I8# x#) .&. (I8# y#) = I8# (word8ToInt8# (int8ToWord8# x# `andWord8#` int8ToWord8# y#)) + (I8# x#) .|. (I8# y#) = I8# (word8ToInt8# (int8ToWord8# x# `orWord8#` int8ToWord8# y#)) + (I8# x#) `xor` (I8# y#) = I8# (word8ToInt8# (int8ToWord8# x# `xorWord8#` int8ToWord8# y#)) + complement (I8# x#) = I8# (word8ToInt8# (notWord8# (int8ToWord8# x#))) (I8# x#) `shift` (I# i#) - | isTrue# (i# >=# 0#) = I8# (intToInt8# ((int8ToInt# x#) `iShiftL#` i#)) - | otherwise = I8# (intToInt8# ((int8ToInt# x#) `iShiftRA#` negateInt# i#)) + | isTrue# (i# >=# 0#) = I8# (x# `shiftLInt8#` i#) + | otherwise = I8# (x# `shiftRAInt8#` negateInt# i#) (I8# x#) `shiftL` (I# i#) - | isTrue# (i# >=# 0#) = I8# (intToInt8# ((int8ToInt# x#) `iShiftL#` i#)) + | isTrue# (i# >=# 0#) = I8# (x# `shiftLInt8#` i#) | otherwise = overflowError - (I8# x#) `unsafeShiftL` (I# i#) = I8# (intToInt8# ((int8ToInt# x#) `uncheckedIShiftL#` i#)) + (I8# x#) `unsafeShiftL` (I# i#) = I8# (x# `uncheckedShiftLInt8#` i#) (I8# x#) `shiftR` (I# i#) - | isTrue# (i# >=# 0#) = I8# (intToInt8# ((int8ToInt# x#) `iShiftRA#` i#)) + | isTrue# (i# >=# 0#) = I8# (x# `shiftRAInt8#` i#) | otherwise = overflowError - (I8# x#) `unsafeShiftR` (I# i#) = I8# (intToInt8# ((int8ToInt# x#) `uncheckedIShiftRA#` i#)) + (I8# x#) `unsafeShiftR` (I# i#) = I8# (x# `uncheckedShiftRAInt8#` i#) (I8# x#) `rotate` (I# i#) | isTrue# (i'# ==# 0#) = I8# x# | otherwise - = I8# (intToInt8# (word2Int# ((x'# `uncheckedShiftL#` i'#) `or#` - (x'# `uncheckedShiftRL#` (8# -# i'#))))) + = I8# (word8ToInt8# ((x'# `uncheckedShiftLWord8#` i'#) `orWord8#` + (x'# `uncheckedShiftRLWord8#` (8# -# i'#)))) where - !x'# = narrow8Word# (int2Word# (int8ToInt# x#)) + !x'# = int8ToWord8# x# !i'# = word2Int# (int2Word# i# `and#` 7##) bitSizeMaybe i = Just (finiteBitSize i) bitSize i = finiteBitSize i @@ -286,8 +295,8 @@ instance Eq Int16 where (/=) = neInt16 eqInt16, neInt16 :: Int16 -> Int16 -> Bool -eqInt16 (I16# x) (I16# y) = isTrue# ((int16ToInt# x) ==# (int16ToInt# y)) -neInt16 (I16# x) (I16# y) = isTrue# ((int16ToInt# x) /=# (int16ToInt# y)) +eqInt16 (I16# x) (I16# y) = isTrue# (x `eqInt16#` y) +neInt16 (I16# x) (I16# y) = isTrue# (x `neInt16#` y) {-# INLINE [1] eqInt16 #-} {-# INLINE [1] neInt16 #-} @@ -303,10 +312,10 @@ instance Ord Int16 where {-# INLINE [1] ltInt16 #-} {-# INLINE [1] leInt16 #-} gtInt16, geInt16, ltInt16, leInt16 :: Int16 -> Int16 -> Bool -(I16# x) `gtInt16` (I16# y) = isTrue# ((int16ToInt# x) ># (int16ToInt# y)) -(I16# x) `geInt16` (I16# y) = isTrue# ((int16ToInt# x) >=# (int16ToInt# y)) -(I16# x) `ltInt16` (I16# y) = isTrue# ((int16ToInt# x) <# (int16ToInt# y)) -(I16# x) `leInt16` (I16# y) = isTrue# ((int16ToInt# x) <=# (int16ToInt# y)) +(I16# x) `gtInt16` (I16# y) = isTrue# (x `gtInt16#` y) +(I16# x) `geInt16` (I16# y) = isTrue# (x `geInt16#` y) +(I16# x) `ltInt16` (I16# y) = isTrue# (x `ltInt16#` y) +(I16# x) `leInt16` (I16# y) = isTrue# (x `leInt16#` y) -- | @since 2.01 instance Show Int16 where @@ -314,10 +323,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 +359,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 +367,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,25 +379,34 @@ 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#) +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# + -- | @since 2.01 instance Bounded Int16 where minBound = -0x8000 @@ -411,29 +429,29 @@ instance Bits Int16 where {-# INLINE testBit #-} {-# INLINE popCount #-} - (I16# x#) .&. (I16# y#) = I16# (intToInt16# ((int16ToInt# x#) `andI#` (int16ToInt# y#))) - (I16# x#) .|. (I16# y#) = I16# (intToInt16# ((int16ToInt# x#) `orI#` (int16ToInt# y#))) - (I16# x#) `xor` (I16# y#) = I16# (intToInt16# ((int16ToInt# x#) `xorI#` (int16ToInt# y#))) - complement (I16# x#) = I16# (intToInt16# (notI# (int16ToInt# x#))) + (I16# x#) .&. (I16# y#) = I16# (word16ToInt16# (int16ToWord16# x# `andWord16#` int16ToWord16# y#)) + (I16# x#) .|. (I16# y#) = I16# (word16ToInt16# (int16ToWord16# x# `orWord16#` int16ToWord16# y#)) + (I16# x#) `xor` (I16# y#) = I16# (word16ToInt16# (int16ToWord16# x# `xorWord16#` int16ToWord16# y#)) + complement (I16# x#) = I16# (word16ToInt16# (notWord16# (int16ToWord16# x#))) (I16# x#) `shift` (I# i#) - | isTrue# (i# >=# 0#) = I16# (intToInt16# ((int16ToInt# x#) `iShiftL#` i#)) - | otherwise = I16# (intToInt16# ((int16ToInt# x#) `iShiftRA#` negateInt# i#)) + | isTrue# (i# >=# 0#) = I16# (x# `shiftLInt16#` i#) + | otherwise = I16# (x# `shiftRAInt16#` negateInt# i#) (I16# x#) `shiftL` (I# i#) - | isTrue# (i# >=# 0#) = I16# (intToInt16# ((int16ToInt# x#) `iShiftL#` i#)) + | isTrue# (i# >=# 0#) = I16# (x# `shiftLInt16#` i#) | otherwise = overflowError - (I16# x#) `unsafeShiftL` (I# i#) = I16# (intToInt16# ((int16ToInt# x#) `uncheckedIShiftL#` i#)) + (I16# x#) `unsafeShiftL` (I# i#) = I16# (x# `uncheckedShiftLInt16#` i#) (I16# x#) `shiftR` (I# i#) - | isTrue# (i# >=# 0#) = I16# (intToInt16# ((int16ToInt# x#) `iShiftRA#` i#)) + | isTrue# (i# >=# 0#) = I16# (x# `shiftRAInt16#` i#) | otherwise = overflowError - (I16# x#) `unsafeShiftR` (I# i#) = I16# (intToInt16# ((int16ToInt# x#) `uncheckedIShiftRA#` i#)) + (I16# x#) `unsafeShiftR` (I# i#) = I16# (x# `uncheckedShiftRAInt16#` i#) (I16# x#) `rotate` (I# i#) | isTrue# (i'# ==# 0#) = I16# x# | otherwise - = I16# (intToInt16# (word2Int# ((x'# `uncheckedShiftL#` i'#) `or#` - (x'# `uncheckedShiftRL#` (16# -# i'#))))) + = I16# (word16ToInt16# ((x'# `uncheckedShiftLWord16#` i'#) `orWord16#` + (x'# `uncheckedShiftRLWord16#` (16# -# i'#)))) where - !x'# = narrow16Word# (int2Word# (int16ToInt# x#)) + !x'# = int16ToWord16# x# !i'# = word2Int# (int2Word# i# `and#` 15##) bitSizeMaybe i = Just (finiteBitSize i) bitSize i = finiteBitSize i @@ -508,8 +526,8 @@ instance Eq Int32 where (/=) = neInt32 eqInt32, neInt32 :: Int32 -> Int32 -> Bool -eqInt32 (I32# x) (I32# y) = isTrue# ((int32ToInt# x) ==# (int32ToInt# y)) -neInt32 (I32# x) (I32# y) = isTrue# ((int32ToInt# x) /=# (int32ToInt# y)) +eqInt32 (I32# x) (I32# y) = isTrue# (x `eqInt32#` y) +neInt32 (I32# x) (I32# y) = isTrue# (x `neInt32#` y) {-# INLINE [1] eqInt32 #-} {-# INLINE [1] neInt32 #-} @@ -525,10 +543,10 @@ instance Ord Int32 where {-# INLINE [1] ltInt32 #-} {-# INLINE [1] leInt32 #-} gtInt32, geInt32, ltInt32, leInt32 :: Int32 -> Int32 -> Bool -(I32# x) `gtInt32` (I32# y) = isTrue# ((int32ToInt# x) ># (int32ToInt# y)) -(I32# x) `geInt32` (I32# y) = isTrue# ((int32ToInt# x) >=# (int32ToInt# y)) -(I32# x) `ltInt32` (I32# y) = isTrue# ((int32ToInt# x) <# (int32ToInt# y)) -(I32# x) `leInt32` (I32# y) = isTrue# ((int32ToInt# x) <=# (int32ToInt# y)) +(I32# x) `gtInt32` (I32# y) = isTrue# (x `gtInt32#` y) +(I32# x) `geInt32` (I32# y) = isTrue# (x `geInt32#` y) +(I32# x) `ltInt32` (I32# y) = isTrue# (x `ltInt32#` y) +(I32# x) `leInt32` (I32# y) = isTrue# (x `leInt32#` y) -- | @since 2.01 instance Show Int32 where @@ -536,10 +554,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 +590,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 +598,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,25 +610,34 @@ 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#) +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# + -- | @since 2.01 instance Read Int32 where readsPrec p s = [(fromIntegral (x::Int), r) | (x, r) <- readsPrec p s] @@ -627,25 +654,25 @@ instance Bits Int32 where (I32# x#) `xor` (I32# y#) = I32# (intToInt32# ((int32ToInt# x#) `xorI#` (int32ToInt# y#))) complement (I32# x#) = I32# (intToInt32# (notI# (int32ToInt# x#))) (I32# x#) `shift` (I# i#) - | isTrue# (i# >=# 0#) = I32# (intToInt32# ((int32ToInt# x#) `iShiftL#` i#)) - | otherwise = I32# (intToInt32# ((int32ToInt# x#) `iShiftRA#` negateInt# i#)) + | isTrue# (i# >=# 0#) = I32# (x# `shiftLInt32#` i#) + | otherwise = I32# (x# `shiftRAInt32#` negateInt# i#) (I32# x#) `shiftL` (I# i#) - | isTrue# (i# >=# 0#) = I32# (intToInt32# ((int32ToInt# x#) `iShiftL#` i#)) + | isTrue# (i# >=# 0#) = I32# (x# `shiftLInt32#` i#) | otherwise = overflowError (I32# x#) `unsafeShiftL` (I# i#) = - I32# (intToInt32# ((int32ToInt# x#) `uncheckedIShiftL#` i#)) + I32# (x# `uncheckedShiftLInt32#` i#) (I32# x#) `shiftR` (I# i#) - | isTrue# (i# >=# 0#) = I32# (intToInt32# ((int32ToInt# x#) `iShiftRA#` i#)) + | isTrue# (i# >=# 0#) = I32# (x# `shiftRAInt32#` i#) | otherwise = overflowError - (I32# x#) `unsafeShiftR` (I# i#) = I32# (intToInt32# ((int32ToInt# x#) `uncheckedIShiftRA#` i#)) + (I32# x#) `unsafeShiftR` (I# i#) = I32# (x# `uncheckedShiftRAInt32#` i#) (I32# x#) `rotate` (I# i#) | isTrue# (i'# ==# 0#) = I32# x# | otherwise - = I32# (intToInt32# (word2Int# ((x'# `uncheckedShiftL#` i'#) `or#` - (x'# `uncheckedShiftRL#` (32# -# i'#))))) + = I32# (word32ToInt32# ((x'# `uncheckedShiftLWord32#` i'#) `orWord32#` + (x'# `uncheckedShiftRLWord32#` (32# -# i'#)))) where - !x'# = narrow32Word# (int2Word# (int32ToInt# x#)) + !x'# = int32ToWord32# x# !i'# = word2Int# (int2Word# i# `and#` 31##) bitSizeMaybe i = Just (finiteBitSize i) bitSize i = finiteBitSize i diff --git a/libraries/base/GHC/Word.hs b/libraries/base/GHC/Word.hs index 77d63cc9d7..0d21a22075 100644 --- a/libraries/base/GHC/Word.hs +++ b/libraries/base/GHC/Word.hs @@ -80,8 +80,8 @@ instance Eq Word8 where (/=) = neWord8 eqWord8, neWord8 :: Word8 -> Word8 -> Bool -eqWord8 (W8# x) (W8# y) = isTrue# ((word8ToWord# x) `eqWord#` (word8ToWord# y)) -neWord8 (W8# x) (W8# y) = isTrue# ((word8ToWord# x) `neWord#` (word8ToWord# y)) +eqWord8 (W8# x) (W8# y) = isTrue# (x `eqWord8#` y) +neWord8 (W8# x) (W8# y) = isTrue# (x `neWord8#` y) {-# INLINE [1] eqWord8 #-} {-# INLINE [1] neWord8 #-} @@ -97,10 +97,10 @@ instance Ord Word8 where {-# INLINE [1] ltWord8 #-} {-# INLINE [1] leWord8 #-} gtWord8, geWord8, ltWord8, leWord8 :: Word8 -> Word8 -> Bool -(W8# x) `gtWord8` (W8# y) = isTrue# ((word8ToWord# x) `gtWord#` (word8ToWord# y)) -(W8# x) `geWord8` (W8# y) = isTrue# ((word8ToWord# x) `geWord#` (word8ToWord# y)) -(W8# x) `ltWord8` (W8# y) = isTrue# ((word8ToWord# x) `ltWord#` (word8ToWord# y)) -(W8# x) `leWord8` (W8# y) = isTrue# ((word8ToWord# x) `leWord#` (word8ToWord# y)) +(W8# x) `gtWord8` (W8# y) = isTrue# (x `gtWord8#` y) +(W8# x) `geWord8` (W8# y) = isTrue# (x `geWord8#` y) +(W8# x) `ltWord8` (W8# y) = isTrue# (x `ltWord8#` y) +(W8# x) `leWord8` (W8# y) = isTrue# (x `leWord8#` y) -- | @since 2.01 instance Show Word8 where @@ -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#)) @@ -180,26 +179,26 @@ instance Bits Word8 where {-# INLINE testBit #-} {-# INLINE popCount #-} - (W8# x#) .&. (W8# y#) = W8# (wordToWord8# ((word8ToWord# x#) `and#` (word8ToWord# y#))) - (W8# x#) .|. (W8# y#) = W8# (wordToWord8# ((word8ToWord# x#) `or#` (word8ToWord# y#))) - (W8# x#) `xor` (W8# y#) = W8# (wordToWord8# ((word8ToWord# x#) `xor#` (word8ToWord# y#))) - complement (W8# x#) = W8# (wordToWord8# (not# (word8ToWord# x#))) + (W8# x#) .&. (W8# y#) = W8# (x# `andWord8#` y#) + (W8# x#) .|. (W8# y#) = W8# (x# `orWord8#` y#) + (W8# x#) `xor` (W8# y#) = W8# (x# `xorWord8#` y#) + complement (W8# x#) = W8# (notWord8# x#) (W8# x#) `shift` (I# i#) - | isTrue# (i# >=# 0#) = W8# (wordToWord8# ((word8ToWord# x#) `shiftL#` i#)) - | otherwise = W8# (wordToWord8# ((word8ToWord# x#) `shiftRL#` negateInt# i#)) + | isTrue# (i# >=# 0#) = W8# (x# `shiftLWord8#` i#) + | otherwise = W8# (x# `shiftRLWord8#` negateInt# i#) (W8# x#) `shiftL` (I# i#) - | isTrue# (i# >=# 0#) = W8# (wordToWord8# ((word8ToWord# x#) `shiftL#` i#)) + | isTrue# (i# >=# 0#) = W8# (x# `shiftLWord8#` i#) | otherwise = overflowError (W8# x#) `unsafeShiftL` (I# i#) = - W8# (wordToWord8# ((word8ToWord# x#) `uncheckedShiftL#` i#)) + W8# (x# `uncheckedShiftLWord8#` i#) (W8# x#) `shiftR` (I# i#) - | isTrue# (i# >=# 0#) = W8# (wordToWord8# ((word8ToWord# x#) `shiftRL#` i#)) + | isTrue# (i# >=# 0#) = W8# (x# `shiftRLWord8#` i#) | otherwise = overflowError - (W8# x#) `unsafeShiftR` (I# i#) = W8# (wordToWord8# ((word8ToWord# x#) `uncheckedShiftRL#` i#)) + (W8# x#) `unsafeShiftR` (I# i#) = W8# (x# `uncheckedShiftRLWord8#` i#) (W8# x#) `rotate` (I# i#) | isTrue# (i'# ==# 0#) = W8# x# - | otherwise = W8# (wordToWord8# (((word8ToWord# x#) `uncheckedShiftL#` i'#) `or#` - ((word8ToWord# x#) `uncheckedShiftRL#` (8# -# i'#)))) + | otherwise = W8# ((x# `uncheckedShiftLWord8#` i'#) `orWord8#` + (x# `uncheckedShiftRLWord8#` (8# -# i'#))) where !i'# = word2Int# (int2Word# i# `and#` 7##) bitSizeMaybe i = Just (finiteBitSize i) @@ -271,8 +270,8 @@ instance Eq Word16 where (/=) = neWord16 eqWord16, neWord16 :: Word16 -> Word16 -> Bool -eqWord16 (W16# x) (W16# y) = isTrue# ((word16ToWord# x) `eqWord#` (word16ToWord# y)) -neWord16 (W16# x) (W16# y) = isTrue# ((word16ToWord# x) `neWord#` (word16ToWord# y)) +eqWord16 (W16# x) (W16# y) = isTrue# (x `eqWord16#` y) +neWord16 (W16# x) (W16# y) = isTrue# (x `neWord16#` y) {-# INLINE [1] eqWord16 #-} {-# INLINE [1] neWord16 #-} @@ -288,10 +287,10 @@ instance Ord Word16 where {-# INLINE [1] ltWord16 #-} {-# INLINE [1] leWord16 #-} gtWord16, geWord16, ltWord16, leWord16 :: Word16 -> Word16 -> Bool -(W16# x) `gtWord16` (W16# y) = isTrue# ((word16ToWord# x) `gtWord#` (word16ToWord# y)) -(W16# x) `geWord16` (W16# y) = isTrue# ((word16ToWord# x) `geWord#` (word16ToWord# y)) -(W16# x) `ltWord16` (W16# y) = isTrue# ((word16ToWord# x) `ltWord#` (word16ToWord# y)) -(W16# x) `leWord16` (W16# y) = isTrue# ((word16ToWord# x) `leWord#` (word16ToWord# y)) +(W16# x) `gtWord16` (W16# y) = isTrue# (x `gtWord16#` y) +(W16# x) `geWord16` (W16# y) = isTrue# (x `geWord16#` y) +(W16# x) `ltWord16` (W16# y) = isTrue# (x `ltWord16#` y) +(W16# x) `leWord16` (W16# y) = isTrue# (x `leWord16#` y) -- | @since 2.01 instance Show Word16 where @@ -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 @@ -331,25 +330,24 @@ instance Enum Word16 where -- | @since 2.01 instance Integral Word16 where quot (W16# x#) y@(W16# y#) - | y /= 0 = W16# (wordToWord16# ((word16ToWord# x#) `quotWord#` (word16ToWord# y#))) + | y /= 0 = W16# (x# `quotWord16#` y#) | otherwise = divZeroError rem (W16# x#) y@(W16# y#) - | y /= 0 = W16# (wordToWord16# ((word16ToWord# x#) `remWord#` (word16ToWord# y#))) + | y /= 0 = W16# (x# `remWord16#` y#) | otherwise = divZeroError div (W16# x#) y@(W16# y#) - | y /= 0 = W16# (wordToWord16# ((word16ToWord# x#) `quotWord#` (word16ToWord# y#))) + | y /= 0 = W16# (x# `quotWord16#` y#) | otherwise = divZeroError mod (W16# x#) y@(W16# y#) - | y /= 0 = W16# (wordToWord16# ((word16ToWord# x#) `remWord#` (word16ToWord# y#))) + | y /= 0 = W16# (x# `remWord16#` y#) | otherwise = divZeroError quotRem (W16# x#) y@(W16# y#) - | y /= 0 = case (word16ToWord# x#) `quotRemWord#` (word16ToWord# y#) of - (# q, r #) -> - (W16# (wordToWord16# q), W16# (wordToWord16# r)) + | y /= 0 = case x# `quotRemWord16#` y# of + (# q, r #) -> (W16# q, W16# r) | otherwise = divZeroError divMod (W16# x#) y@(W16# y#) - | y /= 0 = (W16# (wordToWord16# ((word16ToWord# x#) `quotWord#` (word16ToWord# y#))) - ,W16# (wordToWord16# ((word16ToWord# x#) `remWord#` (word16ToWord# y#)))) + | y /= 0 = (W16# (x# `quotWord16#` y#) + ,W16# (x# `remWord16#` y#)) | otherwise = divZeroError toInteger (W16# x#) = IS (word2Int# (word16ToWord# x#)) @@ -371,26 +369,26 @@ instance Bits Word16 where {-# INLINE testBit #-} {-# INLINE popCount #-} - (W16# x#) .&. (W16# y#) = W16# (wordToWord16# ((word16ToWord# x#) `and#` (word16ToWord# y#))) - (W16# x#) .|. (W16# y#) = W16# (wordToWord16# ((word16ToWord# x#) `or#` (word16ToWord# y#))) - (W16# x#) `xor` (W16# y#) = W16# (wordToWord16# ((word16ToWord# x#) `xor#` (word16ToWord# y#))) - complement (W16# x#) = W16# (wordToWord16# (not# (word16ToWord# x#))) + (W16# x#) .&. (W16# y#) = W16# (x# `andWord16#` y#) + (W16# x#) .|. (W16# y#) = W16# (x# `orWord16#` y#) + (W16# x#) `xor` (W16# y#) = W16# (x# `xorWord16#` y#) + complement (W16# x#) = W16# (notWord16# x#) (W16# x#) `shift` (I# i#) - | isTrue# (i# >=# 0#) = W16# (wordToWord16# ((word16ToWord# x#) `shiftL#` i#)) - | otherwise = W16# (wordToWord16# ((word16ToWord# x#) `shiftRL#` negateInt# i#)) + | isTrue# (i# >=# 0#) = W16# (x# `shiftLWord16#` i#) + | otherwise = W16# (x# `shiftRLWord16#` negateInt# i#) (W16# x#) `shiftL` (I# i#) - | isTrue# (i# >=# 0#) = W16# (wordToWord16# ((word16ToWord# x#) `shiftL#` i#)) + | isTrue# (i# >=# 0#) = W16# (x# `shiftLWord16#` i#) | otherwise = overflowError (W16# x#) `unsafeShiftL` (I# i#) = - W16# (wordToWord16# ((word16ToWord# x#) `uncheckedShiftL#` i#)) + W16# (x# `uncheckedShiftLWord16#` i#) (W16# x#) `shiftR` (I# i#) - | isTrue# (i# >=# 0#) = W16# (wordToWord16# ((word16ToWord# x#) `shiftRL#` i#)) + | isTrue# (i# >=# 0#) = W16# (x# `shiftRLWord16#` i#) | otherwise = overflowError - (W16# x#) `unsafeShiftR` (I# i#) = W16# (wordToWord16# ((word16ToWord# x#) `uncheckedShiftRL#` i#)) + (W16# x#) `unsafeShiftR` (I# i#) = W16# (x# `uncheckedShiftRLWord16#` i#) (W16# x#) `rotate` (I# i#) | isTrue# (i'# ==# 0#) = W16# x# - | otherwise = W16# (wordToWord16# (((word16ToWord# x#) `uncheckedShiftL#` i'#) `or#` - ((word16ToWord# x#) `uncheckedShiftRL#` (16# -# i'#)))) + | otherwise = W16# ((x# `uncheckedShiftLWord16#` i'#) `orWord16#` + (x# `uncheckedShiftRLWord16#` (16# -# i'#))) where !i'# = word2Int# (int2Word# i# `and#` 15##) bitSizeMaybe i = Just (finiteBitSize i) @@ -505,8 +503,8 @@ instance Eq Word32 where (/=) = neWord32 eqWord32, neWord32 :: Word32 -> Word32 -> Bool -eqWord32 (W32# x) (W32# y) = isTrue# ((word32ToWord# x) `eqWord#` (word32ToWord# y)) -neWord32 (W32# x) (W32# y) = isTrue# ((word32ToWord# x) `neWord#` (word32ToWord# y)) +eqWord32 (W32# x) (W32# y) = isTrue# (x `eqWord32#` y) +neWord32 (W32# x) (W32# y) = isTrue# (x `neWord32#` y) {-# INLINE [1] eqWord32 #-} {-# INLINE [1] neWord32 #-} @@ -522,17 +520,17 @@ instance Ord Word32 where {-# INLINE [1] ltWord32 #-} {-# INLINE [1] leWord32 #-} gtWord32, geWord32, ltWord32, leWord32 :: Word32 -> Word32 -> Bool -(W32# x) `gtWord32` (W32# y) = isTrue# ((word32ToWord# x) `gtWord#` (word32ToWord# y)) -(W32# x) `geWord32` (W32# y) = isTrue# ((word32ToWord# x) `geWord#` (word32ToWord# y)) -(W32# x) `ltWord32` (W32# y) = isTrue# ((word32ToWord# x) `ltWord#` (word32ToWord# y)) -(W32# x) `leWord32` (W32# y) = isTrue# ((word32ToWord# x) `leWord#` (word32ToWord# y)) +(W32# x) `gtWord32` (W32# y) = isTrue# (x `gtWord32#` y) +(W32# x) `geWord32` (W32# y) = isTrue# (x `geWord32#` y) +(W32# x) `ltWord32` (W32# y) = isTrue# (x `ltWord32#` y) +(W32# x) `leWord32` (W32# y) = isTrue# (x `leWord32#` y) -- | @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 +569,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 @@ -608,26 +605,26 @@ instance Bits Word32 where {-# INLINE testBit #-} {-# INLINE popCount #-} - (W32# x#) .&. (W32# y#) = W32# (wordToWord32# ((word32ToWord# x#) `and#` (word32ToWord# y#))) - (W32# x#) .|. (W32# y#) = W32# (wordToWord32# ((word32ToWord# x#) `or#` (word32ToWord# y#))) - (W32# x#) `xor` (W32# y#) = W32# (wordToWord32# ((word32ToWord# x#) `xor#` (word32ToWord# y#))) - complement (W32# x#) = W32# (wordToWord32# (not# (word32ToWord# x#))) + (W32# x#) .&. (W32# y#) = W32# (x# `andWord32#` y#) + (W32# x#) .|. (W32# y#) = W32# (x# `orWord32#` y#) + (W32# x#) `xor` (W32# y#) = W32# (x# `xorWord32#` y#) + complement (W32# x#) = W32# (notWord32# x#) (W32# x#) `shift` (I# i#) - | isTrue# (i# >=# 0#) = W32# (wordToWord32# ((word32ToWord# x#) `shiftL#` i#)) - | otherwise = W32# (wordToWord32# ((word32ToWord# x#) `shiftRL#` negateInt# i#)) + | isTrue# (i# >=# 0#) = W32# (x# `shiftLWord32#` i#) + | otherwise = W32# (x# `shiftRLWord32#` negateInt# i#) (W32# x#) `shiftL` (I# i#) - | isTrue# (i# >=# 0#) = W32# (wordToWord32# ((word32ToWord# x#) `shiftL#` i#)) + | isTrue# (i# >=# 0#) = W32# (x# `shiftLWord32#` i#) | otherwise = overflowError (W32# x#) `unsafeShiftL` (I# i#) = - W32# (wordToWord32# ((word32ToWord# x#) `uncheckedShiftL#` i#)) + W32# (x# `uncheckedShiftLWord32#` i#) (W32# x#) `shiftR` (I# i#) - | isTrue# (i# >=# 0#) = W32# (wordToWord32# ((word32ToWord# x#) `shiftRL#` i#)) + | isTrue# (i# >=# 0#) = W32# (x# `shiftRLWord32#` i#) | otherwise = overflowError - (W32# x#) `unsafeShiftR` (I# i#) = W32# (wordToWord32# ((word32ToWord# x#) `uncheckedShiftRL#` i#)) + (W32# x#) `unsafeShiftR` (I# i#) = W32# (x# `uncheckedShiftRLWord32#` i#) (W32# x#) `rotate` (I# i#) | isTrue# (i'# ==# 0#) = W32# x# - | otherwise = W32# (wordToWord32# (((word32ToWord# x#) `uncheckedShiftL#` i'#) `or#` - ((word32ToWord# x#) `uncheckedShiftRL#` (32# -# i'#)))) + | otherwise = W32# ((x# `uncheckedShiftLWord32#` i'#) `orWord32#` + (x# `uncheckedShiftRLWord32#` (32# -# i'#))) where !i'# = word2Int# (int2Word# i# `and#` 31##) bitSizeMaybe i = Just (finiteBitSize i) @@ -950,8 +947,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 83ba27a767..9bcb6a4908 100644 --- a/libraries/ghc-prim/GHC/Classes.hs +++ b/libraries/ghc-prim/GHC/Classes.hs @@ -50,7 +50,8 @@ module GHC.Classes( (&&), (||), not, -- * Integer arithmetic - divInt#, modInt# + divInt#, divInt8#, divInt16#, divInt32#, + modInt#, modInt8#, modInt16#, modInt32# ) where -- GHC.Magic is used in some derived instances @@ -541,7 +542,6 @@ not False = True -- These functions have built-in rules. {-# NOINLINE [0] divInt# #-} -{-# NOINLINE [0] modInt# #-} divInt# :: Int# -> Int# -> Int# x# `divInt#` y# -- Be careful NOT to overflow if we do any additional arithmetic @@ -553,6 +553,40 @@ x# `divInt#` y# else if isTrue# (x# <# 0#) && isTrue# (y# ># 0#) then ((x# +# 1#) `quotInt#` y#) -# 1# else x# `quotInt#` y# +{-# NOINLINE [0] divInt8# #-} +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# #-} +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# #-} +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#) + +{-# NOINLINE [0] modInt# #-} modInt# :: Int# -> Int# -> Int# x# `modInt#` y# = if isTrue# (x# ># 0#) && isTrue# (y# <# 0#) || @@ -562,6 +596,40 @@ x# `modInt#` y# where !r# = x# `remInt#` y# +{-# NOINLINE [0] modInt8# #-} +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# #-} +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# #-} +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# + + {- ************************************************************* * * |