diff options
Diffstat (limited to 'libraries')
| -rw-r--r-- | libraries/base/GHC/Conc/Sync.hs | 6 | ||||
| -rw-r--r-- | libraries/base/GHC/Float.hs | 8 | ||||
| -rw-r--r-- | libraries/base/GHC/Int.hs | 195 | ||||
| -rw-r--r-- | libraries/base/GHC/StaticPtr.hs | 9 | ||||
| -rw-r--r-- | libraries/base/GHC/Storable.hs | 17 | ||||
| -rw-r--r-- | libraries/base/GHC/Word.hs | 192 | ||||
| -rw-r--r-- | libraries/ghc-bignum/src/GHC/Num/Integer.hs | 4 | ||||
| -rw-r--r-- | libraries/ghc-prim/GHC/Classes.hs | 17 | ||||
| -rw-r--r-- | libraries/ghc-prim/GHC/Prim/Ext.hs | 41 | ||||
| -rw-r--r-- | libraries/ghc-prim/GHC/Types.hs | 10 |
10 files changed, 43 insertions, 456 deletions
diff --git a/libraries/base/GHC/Conc/Sync.hs b/libraries/base/GHC/Conc/Sync.hs index 38ce56ccbf..d5fb4868df 100644 --- a/libraries/base/GHC/Conc/Sync.hs +++ b/libraries/base/GHC/Conc/Sync.hs @@ -92,8 +92,6 @@ module GHC.Conc.Sync , sharedCAF ) where -#include "MachDeps.h" - import Foreign import Foreign.C @@ -194,11 +192,7 @@ instance Ord ThreadId where -- @since 4.8.0.0 setAllocationCounter :: Int64 -> IO () setAllocationCounter (I64# i) = IO $ \s -> -#if WORD_SIZE_IN_BITS < 64 case setThreadAllocationCounter# i s of s' -> (# s', () #) -#else - case setThreadAllocationCounter# (intToInt64# i) s of s' -> (# s', () #) -#endif -- | Return the current value of the allocation counter for the -- current thread. diff --git a/libraries/base/GHC/Float.hs b/libraries/base/GHC/Float.hs index 2fb30c5712..6ec4e84ceb 100644 --- a/libraries/base/GHC/Float.hs +++ b/libraries/base/GHC/Float.hs @@ -1565,11 +1565,7 @@ castWord64ToDouble :: Word64 -> Double castWord64ToDouble (W64# w) = D# (stgWord64ToDouble w) foreign import prim "stg_word64ToDoublezh" -#if WORD_SIZE_IN_BITS == 64 - stgWord64ToDouble :: Word# -> Double# -#else stgWord64ToDouble :: Word64# -> Double# -#endif -- | @'castFloatToWord64' f@ does a bit-for-bit copy from a floating-point value @@ -1582,11 +1578,7 @@ castDoubleToWord64 :: Double -> Word64 castDoubleToWord64 (D# d#) = W64# (stgDoubleToWord64 d#) foreign import prim "stg_doubleToWord64zh" -#if WORD_SIZE_IN_BITS == 64 - stgDoubleToWord64 :: Double# -> Word# -#else stgDoubleToWord64 :: Double# -> Word64# -#endif diff --git a/libraries/base/GHC/Int.hs b/libraries/base/GHC/Int.hs index 45bb3f70ca..d0ab7d055e 100644 --- a/libraries/base/GHC/Int.hs +++ b/libraries/base/GHC/Int.hs @@ -42,12 +42,8 @@ module GHC.Int ( import Data.Bits import Data.Maybe -#if WORD_SIZE_IN_BITS < 64 import GHC.Prim import GHC.Base -#else -import GHC.Base hiding (uncheckedIShiftL64#, uncheckedIShiftRA64#) -#endif import GHC.Enum import GHC.Num @@ -695,8 +691,6 @@ instance Ix Int32 where -- type Int64 ------------------------------------------------------------------------ -#if WORD_SIZE_IN_BITS < 64 - data {-# CTYPE "HsInt64" #-} Int64 = I64# Int64# -- ^ 64-bit signed integer type @@ -802,14 +796,24 @@ instance Integral Int64 where | y == 0 = divZeroError -- Note [Order of tests] | y == (-1) && x == minBound = (overflowError, 0) - | otherwise = (I64# (x# `quotInt64#` y#), - I64# (x# `remInt64#` y#)) +#if WORD_SIZE_IN_BITS < 64 + -- we don't have quotRemInt64# primop yet + | otherwise = (I64# (x# `quotInt64#` y#), I64# (x# `remInt64#` y#)) +#else + | otherwise = case quotRemInt# (int64ToInt# x#) (int64ToInt# y#) of + (# q, r #) -> (I64# (intToInt64# q), I64# (intToInt64# r)) +#endif divMod x@(I64# x#) y@(I64# y#) | y == 0 = divZeroError -- Note [Order of tests] | y == (-1) && x == minBound = (overflowError, 0) - | otherwise = (I64# (x# `divInt64#` y#), - I64# (x# `modInt64#` y#)) +#if WORD_SIZE_IN_BITS < 64 + -- we don't have divModInt64# primop yet + | otherwise = (I64# (x# `divInt64#` y#), I64# (x# `modInt64#` y#)) +#else + | otherwise = case divModInt# (int64ToInt# x#) (int64ToInt# y#) of + (# q, r #) -> (I64# (intToInt64# q), I64# (intToInt64# r)) +#endif toInteger (I64# x) = integerFromInt64# x @@ -896,166 +900,8 @@ a `iShiftRA64#` b | isTrue# (b >=# 64#) = if isTrue# (a `ltInt64#` (intToInt64# -- No RULES for RealFrac methods if Int is smaller than Int64, we can't -- go through Int and whether going through Integer is faster is uncertain. -#else - --- Int64 is represented in the same way as Int. --- Operations may assume and must ensure that it holds only values --- from its logical range. - -data {-# CTYPE "HsInt64" #-} Int64 = I64# Int# --- ^ 64-bit signed integer type - --- See GHC.Classes#matching_overloaded_methods_in_rules --- | @since 2.01 -instance Eq Int64 where - (==) = eqInt64 - (/=) = neInt64 - -eqInt64, neInt64 :: Int64 -> Int64 -> Bool -eqInt64 (I64# x) (I64# y) = isTrue# (x ==# y) -neInt64 (I64# x) (I64# y) = isTrue# (x /=# y) -{-# INLINE [1] eqInt64 #-} -{-# INLINE [1] neInt64 #-} - --- | @since 2.01 -instance Ord Int64 where - (<) = ltInt64 - (<=) = leInt64 - (>=) = geInt64 - (>) = gtInt64 - -{-# INLINE [1] gtInt64 #-} -{-# INLINE [1] geInt64 #-} -{-# INLINE [1] ltInt64 #-} -{-# INLINE [1] leInt64 #-} -gtInt64, geInt64, ltInt64, leInt64 :: Int64 -> Int64 -> Bool -(I64# x) `gtInt64` (I64# y) = isTrue# (x ># y) -(I64# x) `geInt64` (I64# y) = isTrue# (x >=# y) -(I64# x) `ltInt64` (I64# y) = isTrue# (x <# y) -(I64# x) `leInt64` (I64# y) = isTrue# (x <=# y) - --- | @since 2.01 -instance Show Int64 where - showsPrec p x = showsPrec p (fromIntegral x :: Int) - --- | @since 2.01 -instance Num Int64 where - (I64# x#) + (I64# y#) = I64# (x# +# y#) - (I64# x#) - (I64# y#) = I64# (x# -# y#) - (I64# x#) * (I64# y#) = I64# (x# *# y#) - negate (I64# x#) = I64# (negateInt# x#) - abs x | x >= 0 = x - | otherwise = negate x - signum x | x > 0 = 1 - signum 0 = 0 - signum _ = -1 - fromInteger i = I64# (integerToInt# i) - --- | @since 2.01 -instance Enum Int64 where - succ x - | x /= maxBound = x + 1 - | otherwise = succError "Int64" - pred x - | x /= minBound = x - 1 - | otherwise = predError "Int64" - toEnum (I# i#) = I64# i# - fromEnum (I64# x#) = I# x# - -- See Note [Stable Unfolding for list producers] in GHC.Enum - {-# INLINE enumFrom #-} - enumFrom = boundedEnumFrom - -- See Note [Stable Unfolding for list producers] in GHC.Enum - {-# INLINE enumFromThen #-} - enumFromThen = boundedEnumFromThen - --- | @since 2.01 -instance Integral Int64 where - quot x@(I64# x#) y@(I64# y#) - | y == 0 = divZeroError - | y == (-1) && x == minBound = overflowError -- Note [Order of tests] - | otherwise = I64# (x# `quotInt#` y#) - rem (I64# x#) y@(I64# y#) - | y == 0 = divZeroError - -- The quotRem CPU instruction might fail for 'minBound - -- `quotRem` -1' if it is an instruction for exactly this - -- width of signed integer. But, 'minBound `rem` -1' is - -- well-defined (0). We therefore special-case it. - | y == (-1) = 0 - | otherwise = I64# (x# `remInt#` y#) - div x@(I64# x#) y@(I64# y#) - | y == 0 = divZeroError - | y == (-1) && x == minBound = overflowError -- Note [Order of tests] - | otherwise = I64# (x# `divInt#` y#) - mod (I64# x#) y@(I64# y#) - | y == 0 = divZeroError - -- The divMod CPU instruction might fail for 'minBound - -- `divMod` -1' if it is an instruction for exactly this - -- width of signed integer. But, 'minBound `mod` -1' is - -- well-defined (0). We therefore special-case it. - | y == (-1) = 0 - | otherwise = I64# (x# `modInt#` y#) - quotRem x@(I64# x#) y@(I64# y#) - | y == 0 = divZeroError - -- Note [Order of tests] - | y == (-1) && x == minBound = (overflowError, 0) - | otherwise = case x# `quotRemInt#` y# of - (# q, r #) -> - (I64# q, I64# r) - divMod x@(I64# x#) y@(I64# y#) - | y == 0 = divZeroError - -- Note [Order of tests] - | y == (-1) && x == minBound = (overflowError, 0) - | otherwise = case x# `divModInt#` y# of - (# d, m #) -> - (I64# d, I64# m) - toInteger (I64# x#) = IS x# - --- | @since 2.01 -instance Read Int64 where - readsPrec p s = [(fromIntegral (x::Int), r) | (x, r) <- readsPrec p s] - --- | @since 2.01 -instance Bits Int64 where - {-# INLINE shift #-} - {-# INLINE bit #-} - {-# INLINE testBit #-} - {-# INLINE popCount #-} - - (I64# x#) .&. (I64# y#) = I64# (x# `andI#` y#) - (I64# x#) .|. (I64# y#) = I64# (x# `orI#` y#) - (I64# x#) `xor` (I64# y#) = I64# (x# `xorI#` y#) - complement (I64# x#) = I64# (notI# x#) - (I64# x#) `shift` (I# i#) - | isTrue# (i# >=# 0#) = I64# (x# `iShiftL#` i#) - | otherwise = I64# (x# `iShiftRA#` negateInt# i#) - (I64# x#) `shiftL` (I# i#) - | isTrue# (i# >=# 0#) = I64# (x# `iShiftL#` i#) - | otherwise = overflowError - (I64# x#) `unsafeShiftL` (I# i#) = I64# (x# `uncheckedIShiftL#` i#) - (I64# x#) `shiftR` (I# i#) - | isTrue# (i# >=# 0#) = I64# (x# `iShiftRA#` i#) - | otherwise = overflowError - (I64# x#) `unsafeShiftR` (I# i#) = I64# (x# `uncheckedIShiftRA#` i#) - (I64# x#) `rotate` (I# i#) - | isTrue# (i'# ==# 0#) - = I64# x# - | otherwise - = I64# (word2Int# ((x'# `uncheckedShiftL#` i'#) `or#` - (x'# `uncheckedShiftRL#` (64# -# i'#)))) - where - !x'# = int2Word# x# - !i'# = word2Int# (int2Word# i# `and#` 63##) - bitSizeMaybe i = Just (finiteBitSize i) - bitSize i = finiteBitSize i - isSigned _ = True -#if WORD_SIZE_IN_BITS < 64 - popCount (I64# x#) = I# (word2Int# (popCnt64# (int64ToWord64# x#))) -#else - popCount (I64# x#) = I# (word2Int# (popCnt# (int2Word# x#))) -#endif - bit = bitDefault - testBit = testBitDefault +#if WORD_SIZE_IN_BITS == 64 {-# RULES "properFraction/Float->(Int64,Float)" properFraction = \x -> @@ -1085,12 +931,6 @@ instance Bits Int64 where "round/Double->Int64" round = (fromIntegral :: Int -> Int64) . (round :: Double -> Int) #-} - -uncheckedIShiftL64# :: Int# -> Int# -> Int# -uncheckedIShiftL64# = uncheckedIShiftL# - -uncheckedIShiftRA64# :: Int# -> Int# -> Int# -uncheckedIShiftRA64# = uncheckedIShiftRA# #endif -- | @since 4.6.0.0 @@ -1098,13 +938,8 @@ instance FiniteBits Int64 where {-# INLINE countLeadingZeros #-} {-# INLINE countTrailingZeros #-} finiteBitSize _ = 64 -#if WORD_SIZE_IN_BITS < 64 countLeadingZeros (I64# x#) = I# (word2Int# (clz64# (int64ToWord64# x#))) countTrailingZeros (I64# x#) = I# (word2Int# (ctz64# (int64ToWord64# x#))) -#else - countLeadingZeros (I64# x#) = I# (word2Int# (clz# (int2Word# x#))) - countTrailingZeros (I64# x#) = I# (word2Int# (ctz# (int2Word# x#))) -#endif -- | @since 2.01 instance Real Int64 where diff --git a/libraries/base/GHC/StaticPtr.hs b/libraries/base/GHC/StaticPtr.hs index 9a1e1232bb..5ec74c63eb 100644 --- a/libraries/base/GHC/StaticPtr.hs +++ b/libraries/base/GHC/StaticPtr.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE CPP #-} {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE UnboxedTuples #-} @@ -57,17 +56,11 @@ import GHC.Prim import GHC.Word (Word64(..)) -#include "MachDeps.h" - -- | A reference to a value of type @a@. -#if WORD_SIZE_IN_BITS < 64 data StaticPtr a = StaticPtr Word64# Word64# -- The flattened Fingerprint is -- convenient in the compiler. StaticPtrInfo a -#else -data StaticPtr a = StaticPtr Word# Word# - StaticPtrInfo a -#endif + -- | Dereferences a static pointer. deRefStaticPtr :: StaticPtr a -> a deRefStaticPtr (StaticPtr _ _ _ v) = v diff --git a/libraries/base/GHC/Storable.hs b/libraries/base/GHC/Storable.hs index 548430eb59..d9b9382211 100644 --- a/libraries/base/GHC/Storable.hs +++ b/libraries/base/GHC/Storable.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE CPP #-} {-# LANGUAGE Trustworthy #-} {-# LANGUAGE NoImplicitPrelude, MagicHash, UnboxedTuples #-} {-# OPTIONS_HADDOCK not-home #-} @@ -52,8 +51,6 @@ module GHC.Storable , writeWord64OffPtr ) where -#include "MachDeps.h" - import GHC.Stable ( StablePtr(..) ) import GHC.Int import GHC.Word @@ -105,17 +102,10 @@ readInt32OffPtr (Ptr a) (I# i) = IO $ \s -> case readInt32OffAddr# a i s of (# s2, x #) -> (# s2, I32# x #) readWord32OffPtr (Ptr a) (I# i) = IO $ \s -> case readWord32OffAddr# a i s of (# s2, x #) -> (# s2, W32# x #) -#if WORD_SIZE_IN_BITS < 64 readInt64OffPtr (Ptr a) (I# i) = IO $ \s -> case readInt64OffAddr# a i s of (# s2, x #) -> (# s2, I64# x #) readWord64OffPtr (Ptr a) (I# i) = IO $ \s -> case readWord64OffAddr# a i s of (# s2, x #) -> (# s2, W64# x #) -#else -readInt64OffPtr (Ptr a) (I# i) - = IO $ \s -> case readInt64OffAddr# a i s of (# s2, x #) -> (# s2, I64# (int64ToInt# x) #) -readWord64OffPtr (Ptr a) (I# i) - = IO $ \s -> case readWord64OffAddr# a i s of (# s2, x #) -> (# s2, W64# (word64ToWord# x) #) -#endif writeWideCharOffPtr :: Ptr Char -> Int -> Char -> IO () writeIntOffPtr :: Ptr Int -> Int -> Int -> IO () @@ -162,14 +152,7 @@ writeInt32OffPtr (Ptr a) (I# i) (I32# x) = IO $ \s -> case writeInt32OffAddr# a i x s of s2 -> (# s2, () #) writeWord32OffPtr (Ptr a) (I# i) (W32# x) = IO $ \s -> case writeWord32OffAddr# a i x s of s2 -> (# s2, () #) -#if WORD_SIZE_IN_BITS < 64 writeInt64OffPtr (Ptr a) (I# i) (I64# x) = IO $ \s -> case writeInt64OffAddr# a i x s of s2 -> (# s2, () #) writeWord64OffPtr (Ptr a) (I# i) (W64# x) = IO $ \s -> case writeWord64OffAddr# a i x s of s2 -> (# s2, () #) -#else -writeInt64OffPtr (Ptr a) (I# i) (I64# x) - = IO $ \s -> case writeInt64OffAddr# a i (intToInt64# x) s of s2 -> (# s2, () #) -writeWord64OffPtr (Ptr a) (I# i) (W64# x) - = IO $ \s -> case writeWord64OffAddr# a i (wordToWord64# x) s of s2 -> (# s2, () #) -#endif diff --git a/libraries/base/GHC/Word.hs b/libraries/base/GHC/Word.hs index 43b6e4b311..be1921df05 100644 --- a/libraries/base/GHC/Word.hs +++ b/libraries/base/GHC/Word.hs @@ -48,12 +48,8 @@ module GHC.Word ( import Data.Maybe -#if WORD_SIZE_IN_BITS < 64 import GHC.Prim import GHC.Base -#else -import GHC.Base hiding (uncheckedShiftL64#, uncheckedShiftRL64#) -#endif import GHC.Bits import GHC.Enum @@ -676,8 +672,6 @@ byteSwap32 (W32# w#) = W32# (wordToWord32# (byteSwap32# (word32ToWord# w#))) -- type Word64 ------------------------------------------------------------------------ -#if WORD_SIZE_IN_BITS < 64 - data {-# CTYPE "HsWord64" #-} Word64 = W64# Word64# -- ^ 64-bit unsigned integer type @@ -766,7 +760,13 @@ instance Integral Word64 where | y /= 0 = W64# (x# `remWord64#` y#) | otherwise = divZeroError quotRem (W64# x#) y@(W64# y#) +#if WORD_SIZE_IN_BITS < 64 | y /= 0 = (W64# (x# `quotWord64#` y#), W64# (x# `remWord64#` y#)) +#else + -- we don't have a `quotRemWord64#` primitive yet. + | y /= 0 = case quotRemWord# (word64ToWord# x#) (word64ToWord# y#) of + (# q, r #) -> (W64# (wordToWord64# q), W64# (wordToWord64# r)) +#endif | otherwise = divZeroError div x y = quot x y @@ -823,184 +823,14 @@ a `shiftL64#` b | isTrue# (b >=# 64#) = wordToWord64# 0## a `shiftRL64#` b | isTrue# (b >=# 64#) = wordToWord64# 0## | otherwise = a `uncheckedShiftRL64#` b -#else - --- Word64 is represented in the same way as Word. --- Operations may assume and must ensure that it holds only values --- from its logical range. - -data {-# CTYPE "HsWord64" #-} Word64 = W64# Word# --- ^ 64-bit unsigned integer type - --- See GHC.Classes#matching_overloaded_methods_in_rules --- | @since 2.01 -instance Eq Word64 where - (==) = eqWord64 - (/=) = neWord64 - -eqWord64, neWord64 :: Word64 -> Word64 -> Bool -eqWord64 (W64# x) (W64# y) = isTrue# (x `eqWord#` y) -neWord64 (W64# x) (W64# y) = isTrue# (x `neWord#` y) -{-# INLINE [1] eqWord64 #-} -{-# INLINE [1] neWord64 #-} - --- | @since 2.01 -instance Ord Word64 where - (<) = ltWord64 - (<=) = leWord64 - (>=) = geWord64 - (>) = gtWord64 - -{-# INLINE [1] gtWord64 #-} -{-# INLINE [1] geWord64 #-} -{-# INLINE [1] ltWord64 #-} -{-# INLINE [1] leWord64 #-} -gtWord64, geWord64, ltWord64, leWord64 :: Word64 -> Word64 -> Bool -(W64# x) `gtWord64` (W64# y) = isTrue# (x `gtWord#` y) -(W64# x) `geWord64` (W64# y) = isTrue# (x `geWord#` y) -(W64# x) `ltWord64` (W64# y) = isTrue# (x `ltWord#` y) -(W64# x) `leWord64` (W64# y) = isTrue# (x `leWord#` y) - --- | @since 2.01 -instance Num Word64 where - (W64# x#) + (W64# y#) = W64# (x# `plusWord#` y#) - (W64# x#) - (W64# y#) = W64# (x# `minusWord#` y#) - (W64# x#) * (W64# y#) = W64# (x# `timesWord#` y#) - negate (W64# x#) = W64# (int2Word# (negateInt# (word2Int# x#))) - abs x = x - signum 0 = 0 - signum _ = 1 - fromInteger i = W64# (integerToWord# i) - --- | @since 2.01 -instance Enum Word64 where - succ x - | x /= maxBound = x + 1 - | otherwise = succError "Word64" - pred x - | x /= minBound = x - 1 - | otherwise = predError "Word64" - toEnum i@(I# i#) - | i >= 0 = W64# (int2Word# i#) - | otherwise = toEnumError "Word64" i (minBound::Word64, maxBound::Word64) - fromEnum x@(W64# x#) - | x <= fromIntegral (maxBound::Int) - = I# (word2Int# x#) - | otherwise = fromEnumError "Word64" x - - -- See Note [Stable Unfolding for list producers] in GHC.Enum - {-# INLINABLE enumFrom #-} - enumFrom w - = map wordToWord64 - $ enumFrom (word64ToWord w) - - -- See Note [Stable Unfolding for list producers] in GHC.Enum - {-# INLINABLE enumFromThen #-} - enumFromThen w s - = map wordToWord64 - $ enumFromThen (word64ToWord w) (word64ToWord s) - - -- See Note [Stable Unfolding for list producers] in GHC.Enum - {-# INLINABLE enumFromTo #-} - enumFromTo w1 w2 - = map wordToWord64 - $ enumFromTo (word64ToWord w1) (word64ToWord w2) - - -- See Note [Stable Unfolding for list producers] in GHC.Enum - {-# INLINABLE enumFromThenTo #-} - enumFromThenTo w1 s w2 - = map wordToWord64 - $ enumFromThenTo (word64ToWord w1) (word64ToWord s) (word64ToWord w2) - -word64ToWord :: Word64 -> Word -word64ToWord (W64# w#) = (W# w#) - -wordToWord64 :: Word -> Word64 -wordToWord64 (W# w#) = (W64# w#) - - --- | @since 2.01 -instance Integral Word64 where - -- see Note [INLINE division wrappers] in GHC.Base - {-# INLINE quot #-} - {-# INLINE rem #-} - {-# INLINE quotRem #-} - {-# INLINE div #-} - {-# INLINE mod #-} - {-# INLINE divMod #-} - - quot (W64# x#) y@(W64# y#) - | y /= 0 = W64# (x# `quotWord#` y#) - | otherwise = divZeroError - rem (W64# x#) y@(W64# y#) - | y /= 0 = W64# (x# `remWord#` y#) - | otherwise = divZeroError - quotRem (W64# x#) y@(W64# y#) - | y /= 0 = case x# `quotRemWord#` y# of - (# q, r #) -> (W64# q, W64# r) - | otherwise = divZeroError - - div x y = quot x y - mod x y = rem x y - divMod x y = quotRem x y - - toInteger (W64# x#) = integerFromWord# x# - --- | @since 2.01 -instance Bits Word64 where - {-# INLINE shift #-} - {-# INLINE bit #-} - {-# INLINE testBit #-} - {-# INLINE popCount #-} - - (W64# x#) .&. (W64# y#) = W64# (x# `and#` y#) - (W64# x#) .|. (W64# y#) = W64# (x# `or#` y#) - (W64# x#) `xor` (W64# y#) = W64# (x# `xor#` y#) - complement (W64# x#) = W64# (not# x#) - (W64# x#) `shift` (I# i#) - | isTrue# (i# >=# 0#) = W64# (x# `shiftL#` i#) - | otherwise = W64# (x# `shiftRL#` negateInt# i#) - (W64# x#) `shiftL` (I# i#) - | isTrue# (i# >=# 0#) = W64# (x# `shiftL#` i#) - | otherwise = overflowError - (W64# x#) `unsafeShiftL` (I# i#) = W64# (x# `uncheckedShiftL#` i#) - (W64# x#) `shiftR` (I# i#) - | isTrue# (i# >=# 0#) = W64# (x# `shiftRL#` i#) - | otherwise = overflowError - (W64# x#) `unsafeShiftR` (I# i#) = W64# (x# `uncheckedShiftRL#` i#) - (W64# x#) `rotate` (I# i#) - | isTrue# (i'# ==# 0#) = W64# x# - | otherwise = W64# ((x# `uncheckedShiftL#` i'#) `or#` - (x# `uncheckedShiftRL#` (64# -# i'#))) - where - !i'# = word2Int# (int2Word# i# `and#` 63##) - bitSizeMaybe i = Just (finiteBitSize i) - bitSize i = finiteBitSize i - isSigned _ = False - popCount (W64# x#) = I# (word2Int# (popCnt# x#)) - bit = bitDefault - testBit = testBitDefault - -uncheckedShiftL64# :: Word# -> Int# -> Word# -uncheckedShiftL64# = uncheckedShiftL# - -uncheckedShiftRL64# :: Word# -> Int# -> Word# -uncheckedShiftRL64# = uncheckedShiftRL# - -#endif -- | @since 4.6.0.0 instance FiniteBits Word64 where {-# INLINE countLeadingZeros #-} {-# INLINE countTrailingZeros #-} finiteBitSize _ = 64 -#if WORD_SIZE_IN_BITS < 64 countLeadingZeros (W64# x#) = I# (word2Int# (clz64# x#)) countTrailingZeros (W64# x#) = I# (word2Int# (ctz64# x#)) -#else - countLeadingZeros (W64# x#) = I# (word2Int# (clz# x#)) - countTrailingZeros (W64# x#) = I# (word2Int# (ctz# x#)) -#endif -- | @since 2.01 instance Show Word64 where @@ -1024,13 +854,8 @@ instance Ix Word64 where -- | Reverse order of bytes in 'Word64'. -- -- @since 4.7.0.0 -#if WORD_SIZE_IN_BITS < 64 byteSwap64 :: Word64 -> Word64 byteSwap64 (W64# w#) = W64# (byteSwap64# w#) -#else -byteSwap64 :: Word64 -> Word64 -byteSwap64 (W64# w#) = W64# (byteSwap# w#) -#endif -- | Reverse the order of the bits in a 'Word8'. -- @@ -1053,13 +878,8 @@ bitReverse32 (W32# w#) = W32# (wordToWord32# (bitReverse32# (word32ToWord# w#))) -- | Reverse the order of the bits in a 'Word64'. -- -- @since 4.12.0.0 -#if WORD_SIZE_IN_BITS < 64 bitReverse64 :: Word64 -> Word64 bitReverse64 (W64# w#) = W64# (bitReverse64# w#) -#else -bitReverse64 :: Word64 -> Word64 -bitReverse64 (W64# w#) = W64# (bitReverse# w#) -#endif ------------------------------------------------------------------------------- diff --git a/libraries/ghc-bignum/src/GHC/Num/Integer.hs b/libraries/ghc-bignum/src/GHC/Num/Integer.hs index d85148fc05..810ce7f050 100644 --- a/libraries/ghc-bignum/src/GHC/Num/Integer.hs +++ b/libraries/ghc-bignum/src/GHC/Num/Integer.hs @@ -1001,7 +1001,7 @@ integerIsPowerOf2# (IP w) = bigNatIsPowerOf2# w -- | Convert an Int64# into an Integer integerFromInt64# :: Int64# -> Integer {-# NOINLINE integerFromInt64# #-} -integerFromInt64# !i +integerFromInt64# i | isTrue# ((i `leInt64#` intToInt64# INT_MAXBOUND#) &&# (i `geInt64#` intToInt64# INT_MINBOUND#)) = IS (int64ToInt# i) @@ -1476,7 +1476,6 @@ to only rely on rewrite rules for bignum functions. #-} -#if WORD_SIZE_IN_BITS == 32 {-# RULES "Int64# -> Integer -> Int64#" @@ -1516,4 +1515,3 @@ to only rely on rewrite rules for bignum functions. forall x. integerToInt# (integerFromWord64# x) = word2Int# (word64ToWord# x) #-} -#endif diff --git a/libraries/ghc-prim/GHC/Classes.hs b/libraries/ghc-prim/GHC/Classes.hs index 2c874fb241..13e9556864 100644 --- a/libraries/ghc-prim/GHC/Classes.hs +++ b/libraries/ghc-prim/GHC/Classes.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE CPP, Trustworthy #-} +{-# LANGUAGE Trustworthy #-} {-# LANGUAGE NoImplicitPrelude, MagicHash, StandaloneDeriving, BangPatterns, KindSignatures, DataKinds, ConstraintKinds, MultiParamTypeClasses, FunctionalDependencies #-} @@ -63,8 +63,6 @@ import GHC.Tuple import GHC.CString (unpackCString#) import GHC.Types -#include "MachDeps.h" - infix 4 ==, /=, <, <=, >=, > infixr 3 && infixr 2 || @@ -277,7 +275,6 @@ eqInt, neInt :: Int -> Int -> Bool (I# x) `eqInt` (I# y) = isTrue# (x ==# y) (I# x) `neInt` (I# y) = isTrue# (x /=# y) -#if WORD_SIZE_IN_BITS < 64 instance Eq TyCon where (==) (TyCon hi1 lo1 _ _ _ _) (TyCon hi2 lo2 _ _ _ _) = isTrue# (hi1 `eqWord64#` hi2) && isTrue# (lo1 `eqWord64#` lo2) @@ -288,18 +285,6 @@ instance Ord TyCon where | isTrue# (lo1 `gtWord64#` lo2) = GT | isTrue# (lo1 `ltWord64#` lo2) = LT | True = EQ -#else -instance Eq TyCon where - (==) (TyCon hi1 lo1 _ _ _ _) (TyCon hi2 lo2 _ _ _ _) - = isTrue# (hi1 `eqWord#` hi2) && isTrue# (lo1 `eqWord#` lo2) -instance Ord TyCon where - compare (TyCon hi1 lo1 _ _ _ _) (TyCon hi2 lo2 _ _ _ _) - | isTrue# (hi1 `gtWord#` hi2) = GT - | isTrue# (hi1 `ltWord#` hi2) = LT - | isTrue# (lo1 `gtWord#` lo2) = GT - | isTrue# (lo1 `ltWord#` lo2) = LT - | True = EQ -#endif -- | The 'Ord' class is used for totally ordered datatypes. diff --git a/libraries/ghc-prim/GHC/Prim/Ext.hs b/libraries/ghc-prim/GHC/Prim/Ext.hs index e581e66dd7..d911133947 100644 --- a/libraries/ghc-prim/GHC/Prim/Ext.hs +++ b/libraries/ghc-prim/GHC/Prim/Ext.hs @@ -28,17 +28,14 @@ -- are described over there. module GHC.Prim.Ext ( - -- 64-bit bit aliases - INT64 - , WORD64 + -- * Misc + getThreadAllocationCounter# -- * Delay\/wait operations #if defined(mingw32_HOST_OS) , asyncRead# , asyncWrite# , asyncDoProc# #endif - -- * Misc - , getThreadAllocationCounter# ) where import GHC.Prim @@ -47,24 +44,6 @@ import GHC.Types () -- Make implicit dependency known to build system default () -- Double and Integer aren't available yet ------------------------------------------------------------------------ --- 64-bit bit aliases ------------------------------------------------------------------------- - -type INT64 = -#if WORD_SIZE_IN_BITS < 64 - Int64# -#else - Int# -#endif - -type WORD64 = -#if WORD_SIZE_IN_BITS < 64 - Word64# -#else - Word# -#endif - ------------------------------------------------------------------------- -- Delay/wait operations ------------------------------------------------------------------------ @@ -104,7 +83,7 @@ foreign import prim "stg_asyncDoProczh" asyncDoProc# -- | Retrieves the allocation counter for the current thread. foreign import prim "stg_getThreadAllocationCounterzh" getThreadAllocationCounter# :: State# RealWorld - -> (# State# RealWorld, INT64 #) + -> (# State# RealWorld, Int64# #) ------------------------------------------------------------------------ -- Rules for primops that don't need to be built-in @@ -249,3 +228,17 @@ foreign import prim "stg_getThreadAllocationCounterzh" getThreadAllocationCounte forall x . intToInt64# (word2Int# (word64ToWord# x)) = word64ToInt64# x #-} #endif + + +-- Push downcast into bitwise operations +{-# RULES +"word64ToWord#/and64#" + forall x y . word64ToWord# (and64# x y) = and# (word64ToWord# x) (word64ToWord# y) + +"word64ToWord#/or64#" + forall x y . word64ToWord# (or64# x y) = or# (word64ToWord# x) (word64ToWord# y) + +"word64ToWord#/xor64#" + forall x y . word64ToWord# (xor64# x y) = xor# (word64ToWord# x) (word64ToWord# y) + +#-} diff --git a/libraries/ghc-prim/GHC/Types.hs b/libraries/ghc-prim/GHC/Types.hs index aa4bcce603..45f14e7691 100644 --- a/libraries/ghc-prim/GHC/Types.hs +++ b/libraries/ghc-prim/GHC/Types.hs @@ -522,12 +522,6 @@ data TrName -- | A de Bruijn index for a binder within a 'KindRep'. type KindBndr = Int -#if WORD_SIZE_IN_BITS < 64 -#define WORD64_TY Word64# -#else -#define WORD64_TY Word# -#endif - -- | The representation produced by GHC for conjuring up the kind of a -- 'Data.Typeable.TypeRep'. @@ -545,8 +539,8 @@ data TypeLitSort = TypeLitSymbol | TypeLitChar -- Show instance for TyCon found in GHC.Show -data TyCon = TyCon WORD64_TY -- ^ Fingerprint (high) - WORD64_TY -- ^ Fingerprint (low) +data TyCon = TyCon Word64# -- ^ Fingerprint (high) + Word64# -- ^ Fingerprint (low) Module -- ^ Module in which this is defined TrName -- ^ Type constructor name Int# -- ^ How many kind variables do we accept? |