diff options
author | Sylvain Henry <sylvain@haskus.fr> | 2020-12-03 18:54:54 +0100 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2021-03-03 08:12:29 -0500 |
commit | d8dc0f96237fe6fe7081c04727c7c2573477e5cb (patch) | |
tree | dbc4e8d25cf5a085e979df98bacad5999bf78aee /testsuite/tests | |
parent | eea96042f1e8682605ae68db10f2bcdd7dab923e (diff) | |
download | haskell-d8dc0f96237fe6fe7081c04727c7c2573477e5cb.tar.gz |
Fix array and cleanup conversion primops (#19026)
The first change makes the array ones use the proper fixed-size types,
which also means that just like before, they can be used without
explicit conversions with the boxed sized types. (Before, it was Int# /
Word# on both sides, now it is fixed sized on both sides).
For the second change, don't use "extend" or "narrow" in some of the
user-facing primops names for conversions.
- Names like `narrowInt32#` are misleading when `Int` is 32-bits.
- Names like `extendInt64#` are flat-out wrong when `Int is
32-bits.
- `narrow{Int,Word}<N>#` however map a type to itself, and so don't
suffer from this problem. They are left as-is.
These changes are batched together because Alex happend to use the array
ops. We can only use released versions of Alex at this time, sadly, and
I don't want to have to have a release thatwon't work for the final GHC
9.2. So by combining these we get all the changes for Alex done at once.
Bump hackage state in a few places, and also make that workflow slightly
easier for the future.
Bump minimum Alex version
Bump Cabal, array, bytestring, containers, text, and binary submodules
Diffstat (limited to 'testsuite/tests')
42 files changed, 267 insertions, 249 deletions
diff --git a/testsuite/tests/array/should_run/arr020.hs b/testsuite/tests/array/should_run/arr020.hs index db715b054e..0dacf78216 100644 --- a/testsuite/tests/array/should_run/arr020.hs +++ b/testsuite/tests/array/should_run/arr020.hs @@ -20,12 +20,12 @@ newByteArray (I# n#) writeByteArray :: MutableByteArray s -> Int -> Word32 -> ST s () writeByteArray (MutableByteArray mba#) (I# i#) (W32# w#) - = ST $ \s# -> case writeWord32Array# mba# i# (extendWord32# w#) s# of + = ST $ \s# -> case writeWord32Array# mba# i# w# s# of s'# -> (# s'#, () #) indexArray :: ByteArray Word32 -> Int -> Word32 indexArray (ByteArray arr#) (I# i#) - = W32# (narrowWord32# (indexWord32Array# arr# i#)) + = W32# (indexWord32Array# arr# i#) unsafeFreezeByteArray :: MutableByteArray s -> ST s (ByteArray e) unsafeFreezeByteArray (MutableByteArray mba#) diff --git a/testsuite/tests/cmm/opt/T18141.hs b/testsuite/tests/cmm/opt/T18141.hs index 9f2c2a79c7..f324f4f6f0 100644 --- a/testsuite/tests/cmm/opt/T18141.hs +++ b/testsuite/tests/cmm/opt/T18141.hs @@ -12,6 +12,6 @@ x# `divInt8#` y# ((x# `plusInt8#` one#) `quotInt8#` y#) `subInt8#` one# | otherwise = x# `quotInt8#` y# where - zero# = narrowInt8# 0# - one# = narrowInt8# 1# + zero# = intToInt8# 0# + one# = intToInt8# 1# diff --git a/testsuite/tests/codeGen/should_compile/T18614.hs b/testsuite/tests/codeGen/should_compile/T18614.hs index ae055e3cfd..f1d80d8409 100644 --- a/testsuite/tests/codeGen/should_compile/T18614.hs +++ b/testsuite/tests/codeGen/should_compile/T18614.hs @@ -8,4 +8,4 @@ import GHC.Exts main = pure () test :: Word8# -> Word8# -test x = x `plusWord8#` narrowWord8# 1## +test x = x `plusWord8#` wordToWord8# 1## diff --git a/testsuite/tests/codeGen/should_compile/cg006.hs b/testsuite/tests/codeGen/should_compile/cg006.hs index 494b37937b..4ae3f5a2e9 100644 --- a/testsuite/tests/codeGen/should_compile/cg006.hs +++ b/testsuite/tests/codeGen/should_compile/cg006.hs @@ -5,4 +5,4 @@ module ShouldCompile where import GHC.Base class Unboxable a where writeUnboxable :: MutableByteArray# RealWorld -> a -> State# RealWorld -> State# RealWorld - writeUnboxable arr a s = writeInt8Array# arr 0# (getTag 0) s + writeUnboxable arr a s = writeInt8Array# arr 0# (intToInt8# (getTag 0)) s diff --git a/testsuite/tests/codeGen/should_run/T2080.hs b/testsuite/tests/codeGen/should_run/T2080.hs index 924e77a30f..8645d510e3 100644 --- a/testsuite/tests/codeGen/should_run/T2080.hs +++ b/testsuite/tests/codeGen/should_run/T2080.hs @@ -10,7 +10,7 @@ utf8DecodeChar# :: Addr# -> Bool -> Bool {-# NOINLINE utf8DecodeChar# #-} utf8DecodeChar# a# fred = case () of - _ | isTrue# (word2Int# (indexWord8OffAddr# a# 0#) <=# 0x7F#) -> True + _ | isTrue# (word2Int# (word8ToWord# (indexWord8OffAddr# a# 0#)) <=# 0x7F#) -> True -- Omitting the next line gives an ASSERT error: -- ghc-6.9: panic! (the 'impossible' happened) diff --git a/testsuite/tests/codeGen/should_run/cgrun070.hs b/testsuite/tests/codeGen/should_run/cgrun070.hs index 53f640116f..d37032a707 100644 --- a/testsuite/tests/codeGen/should_run/cgrun070.hs +++ b/testsuite/tests/codeGen/should_run/cgrun070.hs @@ -196,11 +196,11 @@ touch a = unsafeIOToST $ IO $ \s# -> indexWord8Array :: ByteArray -> Int -> Word8 indexWord8Array arr (I# i#) = case indexWord8Array# (unBA arr) i# of - a -> W8# (narrowWord8# a) + a -> W8# a writeWord8Array :: MByteArray s -> Int -> Word8 -> ST s () writeWord8Array marr (I# i#) (W8# a) = ST $ \ s# -> - case writeWord8Array# (unMBA marr) i# (extendWord8# a) s# of + case writeWord8Array# (unMBA marr) i# a s# of s2# -> (# s2#, () #) unsafeFreezeByteArray :: MByteArray s -> ST s (ByteArray) diff --git a/testsuite/tests/codeGen/should_run/cgrun072.hs b/testsuite/tests/codeGen/should_run/cgrun072.hs index fb1b26252f..b97ce56d01 100644 --- a/testsuite/tests/codeGen/should_run/cgrun072.hs +++ b/testsuite/tests/codeGen/should_run/cgrun072.hs @@ -31,10 +31,10 @@ main = do putStrLn test_primop_bSwap16 putStrLn test'_base_bSwap64 bswap16 :: Word16 -> Word16 -bswap16 (W16# w#) = W16# (narrowWord16# (byteSwap16# (extendWord16# w#))) +bswap16 (W16# w#) = W16# (wordToWord16# (byteSwap16# (word16ToWord# w#))) bswap32 :: Word32 -> Word32 -bswap32 (W32# w#) = W32# (narrowWord32# (byteSwap32# (extendWord32# w#))) +bswap32 (W32# w#) = W32# (wordToWord32# (byteSwap32# (word32ToWord# w#))) bswap64 :: Word64 -> Word64 bswap64 (W64# w#) = W64# (byteSwap64# w#) diff --git a/testsuite/tests/codeGen/should_run/cgrun075.hs b/testsuite/tests/codeGen/should_run/cgrun075.hs index 89a4679e5f..5babde1254 100644 --- a/testsuite/tests/codeGen/should_run/cgrun075.hs +++ b/testsuite/tests/codeGen/should_run/cgrun075.hs @@ -27,13 +27,13 @@ instance Pdep Word where pdep (W# src#) (W# mask#) = W# (pdep# src# mask#) instance Pdep Word8 where - pdep (W8# src#) (W8# mask#) = W8# (narrowWord8# (pdep8# (extendWord8# src#) (extendWord8# mask#))) + pdep (W8# src#) (W8# mask#) = W8# (wordToWord8# (pdep8# (word8ToWord# src#) (word8ToWord# mask#))) instance Pdep Word16 where - pdep (W16# src#) (W16# mask#) = W16# (narrowWord16# (pdep16# (extendWord16# src#) (extendWord16# mask#))) + pdep (W16# src#) (W16# mask#) = W16# (wordToWord16# (pdep16# (word16ToWord# src#) (word16ToWord# mask#))) instance Pdep Word32 where - pdep (W32# src#) (W32# mask#) = W32# (narrowWord32# (pdep32# (extendWord32# src#) (extendWord32# mask#))) + pdep (W32# src#) (W32# mask#) = W32# (wordToWord32# (pdep32# (word32ToWord# src#) (word32ToWord# mask#))) instance Pdep Word64 where pdep (W64# src#) (W64# mask#) = W64# (pdep64# src# mask#) diff --git a/testsuite/tests/codeGen/should_run/cgrun076.hs b/testsuite/tests/codeGen/should_run/cgrun076.hs index a6ae331cf6..4779b5beb8 100644 --- a/testsuite/tests/codeGen/should_run/cgrun076.hs +++ b/testsuite/tests/codeGen/should_run/cgrun076.hs @@ -27,13 +27,13 @@ instance Pext Word where pext (W# src#) (W# mask#) = W# (pext# src# mask#) instance Pext Word8 where - pext (W8# src#) (W8# mask#) = W8# (narrowWord8# (pext8# (extendWord8# src#) (extendWord8# mask#))) + pext (W8# src#) (W8# mask#) = W8# (wordToWord8# (pext8# (word8ToWord# src#) (word8ToWord# mask#))) instance Pext Word16 where - pext (W16# src#) (W16# mask#) = W16# (narrowWord16# (pext16# (extendWord16# src#) (extendWord16# mask#))) + pext (W16# src#) (W16# mask#) = W16# (wordToWord16# (pext16# (word16ToWord# src#) (word16ToWord# mask#))) instance Pext Word32 where - pext (W32# src#) (W32# mask#) = W32# (narrowWord32# (pext32# (extendWord32# src#) (extendWord32# mask#))) + pext (W32# src#) (W32# mask#) = W32# (wordToWord32# (pext32# (word32ToWord# src#) (word32ToWord# mask#))) instance Pext Word64 where pext (W64# src#) (W64# mask#) = W64# (pext64# src# mask#) diff --git a/testsuite/tests/codeGen/should_run/compareByteArrays.hs b/testsuite/tests/codeGen/should_run/compareByteArrays.hs index e155bc45a5..5bd0e58588 100644 --- a/testsuite/tests/codeGen/should_run/compareByteArrays.hs +++ b/testsuite/tests/codeGen/should_run/compareByteArrays.hs @@ -39,7 +39,7 @@ copyByteArray (BA# src#) (I# srcOfs#) (MBA# dest#) (I# destOfs#) (I# n#) indexWord8Array :: BA -> Int -> Word8 indexWord8Array (BA# ba#) (I# i#) - = W8# (narrowWord8# (indexWord8Array# ba# i#)) + = W8# (indexWord8Array# ba# i#) sizeofByteArray :: BA -> Int sizeofByteArray (BA# ba#) = I# (sizeofByteArray# ba#) @@ -54,7 +54,7 @@ newByteArray (I# n#) writeWord8Array :: MBA s -> Int -> Word8 -> ST s () writeWord8Array (MBA# mba#) (I# i#) (W8# j#) - = ST $ \s -> case writeWord8Array# mba# i# (extendWord8# j#) s of + = ST $ \s -> case writeWord8Array# mba# i# j# s of s' -> (# s', () #) unsafeFreezeByteArray :: MBA s -> ST s BA diff --git a/testsuite/tests/ffi/should_run/PrimFFIInt16.hs b/testsuite/tests/ffi/should_run/PrimFFIInt16.hs index 6d4eae328f..7d7737e592 100644 --- a/testsuite/tests/ffi/should_run/PrimFFIInt16.hs +++ b/testsuite/tests/ffi/should_run/PrimFFIInt16.hs @@ -14,15 +14,15 @@ foreign import ccall "add_all_int16" main :: IO () main = do - let a = narrowInt16# 0# - b = narrowInt16# 1# - c = narrowInt16# 2# - d = narrowInt16# 3# - e = narrowInt16# 4# - f = narrowInt16# 5# - g = narrowInt16# 6# - h = narrowInt16# 7# - i = narrowInt16# 8# - j = narrowInt16# 9# - x = I# (extendInt16# (add_all_int16 a b c d e f g h i j)) + let a = intToInt16# 0# + b = intToInt16# 1# + c = intToInt16# 2# + d = intToInt16# 3# + e = intToInt16# 4# + f = intToInt16# 5# + g = intToInt16# 6# + h = intToInt16# 7# + i = intToInt16# 8# + j = intToInt16# 9# + x = I# (int16ToInt# (add_all_int16 a b c d e f g h i j)) print x diff --git a/testsuite/tests/ffi/should_run/PrimFFIInt32.hs b/testsuite/tests/ffi/should_run/PrimFFIInt32.hs index 511e3cec10..7ece989ea2 100644 --- a/testsuite/tests/ffi/should_run/PrimFFIInt32.hs +++ b/testsuite/tests/ffi/should_run/PrimFFIInt32.hs @@ -14,15 +14,15 @@ foreign import ccall "add_all_int32" main :: IO () main = do - let a = narrowInt32# 0# - b = narrowInt32# 1# - c = narrowInt32# 2# - d = narrowInt32# 3# - e = narrowInt32# 4# - f = narrowInt32# 5# - g = narrowInt32# 6# - h = narrowInt32# 7# - i = narrowInt32# 8# - j = narrowInt32# 9# - x = I# (extendInt32# (add_all_int32 a b c d e f g h i j)) + let a = intToInt32# 0# + b = intToInt32# 1# + c = intToInt32# 2# + d = intToInt32# 3# + e = intToInt32# 4# + f = intToInt32# 5# + g = intToInt32# 6# + h = intToInt32# 7# + i = intToInt32# 8# + j = intToInt32# 9# + x = I# (int32ToInt# (add_all_int32 a b c d e f g h i j)) print x diff --git a/testsuite/tests/ffi/should_run/PrimFFIInt8.hs b/testsuite/tests/ffi/should_run/PrimFFIInt8.hs index 4124e074aa..f0ce283388 100644 --- a/testsuite/tests/ffi/should_run/PrimFFIInt8.hs +++ b/testsuite/tests/ffi/should_run/PrimFFIInt8.hs @@ -14,15 +14,15 @@ foreign import ccall "add_all_int8" main :: IO () main = do - let a = narrowInt8# 0# - b = narrowInt8# 1# - c = narrowInt8# 2# - d = narrowInt8# 3# - e = narrowInt8# 4# - f = narrowInt8# 5# - g = narrowInt8# 6# - h = narrowInt8# 7# - i = narrowInt8# 8# - j = narrowInt8# 9# - x = I# (extendInt8# (add_all_int8 a b c d e f g h i j)) + let a = intToInt8# 0# + b = intToInt8# 1# + c = intToInt8# 2# + d = intToInt8# 3# + e = intToInt8# 4# + f = intToInt8# 5# + g = intToInt8# 6# + h = intToInt8# 7# + i = intToInt8# 8# + j = intToInt8# 9# + x = I# (int8ToInt# (add_all_int8 a b c d e f g h i j)) print x diff --git a/testsuite/tests/ffi/should_run/PrimFFIWord16.hs b/testsuite/tests/ffi/should_run/PrimFFIWord16.hs index 0d801433cf..30f4e2f8d8 100644 --- a/testsuite/tests/ffi/should_run/PrimFFIWord16.hs +++ b/testsuite/tests/ffi/should_run/PrimFFIWord16.hs @@ -14,15 +14,15 @@ foreign import ccall "add_all_word16" main :: IO () main = do - let a = narrowWord16# 0## - b = narrowWord16# 1## - c = narrowWord16# 2## - d = narrowWord16# 3## - e = narrowWord16# 4## - f = narrowWord16# 5## - g = narrowWord16# 6## - h = narrowWord16# 7## - i = narrowWord16# 8## - j = narrowWord16# 9## - x = W# (extendWord16# (add_all_word16 a b c d e f g h i j)) + let a = wordToWord16# 0## + b = wordToWord16# 1## + c = wordToWord16# 2## + d = wordToWord16# 3## + e = wordToWord16# 4## + f = wordToWord16# 5## + g = wordToWord16# 6## + h = wordToWord16# 7## + i = wordToWord16# 8## + j = wordToWord16# 9## + x = W# (word16ToWord# (add_all_word16 a b c d e f g h i j)) print x diff --git a/testsuite/tests/ffi/should_run/PrimFFIWord32.hs b/testsuite/tests/ffi/should_run/PrimFFIWord32.hs index 996bae1b61..b20702cd2b 100644 --- a/testsuite/tests/ffi/should_run/PrimFFIWord32.hs +++ b/testsuite/tests/ffi/should_run/PrimFFIWord32.hs @@ -14,15 +14,15 @@ foreign import ccall "add_all_word32" main :: IO () main = do - let a = narrowWord32# 0## - b = narrowWord32# 1## - c = narrowWord32# 2## - d = narrowWord32# 3## - e = narrowWord32# 4## - f = narrowWord32# 5## - g = narrowWord32# 6## - h = narrowWord32# 7## - i = narrowWord32# 8## - j = narrowWord32# 9## - x = W# (extendWord32# (add_all_word32 a b c d e f g h i j)) + let a = wordToWord32# 0## + b = wordToWord32# 1## + c = wordToWord32# 2## + d = wordToWord32# 3## + e = wordToWord32# 4## + f = wordToWord32# 5## + g = wordToWord32# 6## + h = wordToWord32# 7## + i = wordToWord32# 8## + j = wordToWord32# 9## + x = W# (word32ToWord# (add_all_word32 a b c d e f g h i j)) print x diff --git a/testsuite/tests/ffi/should_run/PrimFFIWord8.hs b/testsuite/tests/ffi/should_run/PrimFFIWord8.hs index 87e46636d1..bf8717ec7f 100644 --- a/testsuite/tests/ffi/should_run/PrimFFIWord8.hs +++ b/testsuite/tests/ffi/should_run/PrimFFIWord8.hs @@ -14,15 +14,15 @@ foreign import ccall "add_all_word8" main :: IO () main = do - let a = narrowWord8# 0## - b = narrowWord8# 1## - c = narrowWord8# 2## - d = narrowWord8# 3## - e = narrowWord8# 4## - f = narrowWord8# 5## - g = narrowWord8# 6## - h = narrowWord8# 7## - i = narrowWord8# 8## - j = narrowWord8# 9## - x = W# (extendWord8# (add_all_word8 a b c d e f g h i j)) + let a = wordToWord8# 0## + b = wordToWord8# 1## + c = wordToWord8# 2## + d = wordToWord8# 3## + e = wordToWord8# 4## + f = wordToWord8# 5## + g = wordToWord8# 6## + h = wordToWord8# 7## + i = wordToWord8# 8## + j = wordToWord8# 9## + x = W# (word8ToWord# (add_all_word8 a b c d e f g h i j)) print x diff --git a/testsuite/tests/ffi/should_run/T16650a.hs b/testsuite/tests/ffi/should_run/T16650a.hs index 6a43a55118..3424a2c4f2 100644 --- a/testsuite/tests/ffi/should_run/T16650a.hs +++ b/testsuite/tests/ffi/should_run/T16650a.hs @@ -38,10 +38,11 @@ box (MutableByteArray x) = Box (unsafeCoerce# x) luckySingleton :: IO MutableByteArray luckySingleton = IO $ \s0 -> case newByteArray# 1# s0 of - (# s1, marr# #) -> case writeWord8Array# marr# 0# 42## s1 of + (# s1, marr# #) -> case writeWord8Array# marr# 0# fortyTwo s1 of s2 -> (# s2, MutableByteArray marr# #) + where W8# fortyTwo = 42 readByteArray :: MutableByteArray -> Int -> IO Word8 readByteArray (MutableByteArray b#) (I# i#) = IO $ \s0 -> case readWord8Array# b# i# s0 of - (# s1, w #) -> (# s1, W8# (narrowWord8# w) #) + (# s1, w #) -> (# s1, W8# w #) diff --git a/testsuite/tests/ffi/should_run/T16650b.hs b/testsuite/tests/ffi/should_run/T16650b.hs index ba0d4a72a0..06ffcb1d5e 100644 --- a/testsuite/tests/ffi/should_run/T16650b.hs +++ b/testsuite/tests/ffi/should_run/T16650b.hs @@ -47,13 +47,14 @@ box (MutableByteArrays x) = Box (unsafeCoerce# x) luckySingleton :: IO MutableByteArray luckySingleton = IO $ \s0 -> case newByteArray# 1# s0 of - (# s1, marr# #) -> case writeWord8Array# marr# 0# 42## s1 of + (# s1, marr# #) -> case writeWord8Array# marr# 0# fortyTwo s1 of s2 -> (# s2, MutableByteArray marr# #) + where W8# fortyTwo = 42 readByteArray :: MutableByteArray -> Int -> IO Word8 readByteArray (MutableByteArray b#) (I# i#) = IO $ \s0 -> case readWord8Array# b# i# s0 of - (# s1, w #) -> (# s1, W8# (narrowWord8# w) #) + (# s1, w #) -> (# s1, W8# w #) -- Write a mutable byte array to the array of mutable byte arrays -- at the given index. diff --git a/testsuite/tests/ffi/should_run/UnliftedNewtypesByteArrayOffset.hs b/testsuite/tests/ffi/should_run/UnliftedNewtypesByteArrayOffset.hs index 8953e9b02d..02a2c55c91 100644 --- a/testsuite/tests/ffi/should_run/UnliftedNewtypesByteArrayOffset.hs +++ b/testsuite/tests/ffi/should_run/UnliftedNewtypesByteArrayOffset.hs @@ -35,11 +35,12 @@ main = do readByteArray :: MutableByteArray -> Int -> IO Word8 readByteArray (MutableByteArray b#) (I# i#) = IO $ \s0 -> case readWord8Array# b# i# s0 of - (# s1, w #) -> (# s1, W8# (narrowWord8# w) #) + (# s1, w #) -> (# s1, W8# w #) -- Create a new mutable byte array of length 1 with the sole byte -- set to the 105. luckySingleton :: IO MutableByteArray luckySingleton = IO $ \s0 -> case newByteArray# 1# s0 of - (# s1, marr# #) -> case writeWord8Array# marr# 0# 105## s1 of + (# s1, marr# #) -> case writeWord8Array# marr# 0# lit105 s1 of s2 -> (# s2, MutableByteArray marr# #) + where W8# lit105 = 105 diff --git a/testsuite/tests/lib/integer/integerImportExport.hs b/testsuite/tests/lib/integer/integerImportExport.hs index ab044214ed..bef208afd0 100644 --- a/testsuite/tests/lib/integer/integerImportExport.hs +++ b/testsuite/tests/lib/integer/integerImportExport.hs @@ -33,13 +33,13 @@ newByteArray :: Word# -> IO MBA newByteArray sz = IO $ \s -> case newPinnedByteArray# (word2Int# sz) s of (# s, arr #) -> (# s, MBA arr #) indexByteArray :: ByteArray# -> Word# -> Word8 -indexByteArray a# n# = W8# (narrowWord8# (indexWord8Array# a# (word2Int# n#))) +indexByteArray a# n# = W8# (indexWord8Array# a# (word2Int# n#)) -- indexMutableByteArray :: MutableByteArray# RealWorld -> Word# -> IO Word8 -- indexMutableByteArray a# n# = IO $ \s -> case readWord8Array# a# (word2Int# n#) s of (# s', v #) -> (# s', W# v #) writeByteArray :: MutableByteArray# RealWorld -> Int# -> Word8 -> IO () -writeByteArray arr i (W8# w) = IO $ \s -> case writeWord8Array# arr i (extendWord8# w) s of s -> (# s, () #) +writeByteArray arr i (W8# w) = IO $ \s -> case writeWord8Array# arr i w s of s -> (# s, () #) lengthByteArray :: ByteArray# -> Word lengthByteArray ba = W# (int2Word# (sizeofByteArray# ba)) diff --git a/testsuite/tests/numeric/should_compile/T16402.stderr-ws-32 b/testsuite/tests/numeric/should_compile/T16402.stderr-ws-32 index 726bcc374e..4f6746b670 100644 --- a/testsuite/tests/numeric/should_compile/T16402.stderr-ws-32 +++ b/testsuite/tests/numeric/should_compile/T16402.stderr-ws-32 @@ -73,7 +73,7 @@ smallInt_bar { (# ds1, ds2 #) -> case {__pkg_ccall ghc-prim Int# -> State# RealWorld -> (# State# RealWorld, Int64# #)} - (extendInt16# (narrowInt16# ds2)) realWorld# + (int16ToInt# (intToInt16# ds2)) realWorld# of { (# ds4, ds5 #) -> I64# ds5 @@ -111,7 +111,7 @@ $wsmallInt_foo { (# ds1, ds11 #) -> case {__pkg_ccall ghc-prim Int# -> State# RealWorld -> (# State# RealWorld, Int64# #)} - (extendInt16# (narrowInt16# ds11)) realWorld# + (int16ToInt# (intToInt16# ds11)) realWorld# of { (# ds12, ds13 #) -> ds13 diff --git a/testsuite/tests/numeric/should_compile/T16402.stderr-ws-64 b/testsuite/tests/numeric/should_compile/T16402.stderr-ws-64 index d81adaaa7b..6828811655 100644 --- a/testsuite/tests/numeric/should_compile/T16402.stderr-ws-64 +++ b/testsuite/tests/numeric/should_compile/T16402.stderr-ws-64 @@ -28,7 +28,7 @@ smallWord_foo = smallWord_bar -- RHS size: {terms: 8, types: 3, coercions: 0, joins: 0/0} smallInt_bar = \ x -> - case x of { I64# x# -> I64# (extendInt16# (narrowInt16# x#)) } + case x of { I64# x# -> I64# (int16ToInt# (intToInt16# x#)) } -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} smallInt_foo = smallInt_bar diff --git a/testsuite/tests/parser/should_run/BinaryLiterals2.hs b/testsuite/tests/parser/should_run/BinaryLiterals2.hs index 305a12cab3..e3e2a73d33 100644 --- a/testsuite/tests/parser/should_run/BinaryLiterals2.hs +++ b/testsuite/tests/parser/should_run/BinaryLiterals2.hs @@ -27,4 +27,4 @@ main = do , -0B11111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111 ] - print [ I8# (narrowInt8# -0B10000000#), I8# (narrowInt8# 0B1111111#) ] + print [ I8# (intToInt8# -0B10000000#), I8# (intToInt8# 0B1111111#) ] diff --git a/testsuite/tests/primops/should_run/ArithInt16.hs b/testsuite/tests/primops/should_run/ArithInt16.hs index 0f09e0b4fb..373a61ccd8 100644 --- a/testsuite/tests/primops/should_run/ArithInt16.hs +++ b/testsuite/tests/primops/should_run/ArithInt16.hs @@ -146,32 +146,32 @@ addMany (I# a) (I# b) (I# c) (I# d) (I# e) (I# f) (I# g) (I# h) (I# i) (I# j) (I# k) (I# l) (I# m) (I# n) (I# o) (I# p) - = I# (extendInt16# int16) + = I# (int16ToInt# int16) where !int16 = addMany# - (narrowInt16# a) (narrowInt16# b) (narrowInt16# c) (narrowInt16# d) - (narrowInt16# e) (narrowInt16# f) (narrowInt16# g) (narrowInt16# h) - (narrowInt16# i) (narrowInt16# j) (narrowInt16# k) (narrowInt16# l) - (narrowInt16# m) (narrowInt16# n) (narrowInt16# o) (narrowInt16# p) + (intToInt16# a) (intToInt16# b) (intToInt16# c) (intToInt16# d) + (intToInt16# e) (intToInt16# f) (intToInt16# g) (intToInt16# h) + (intToInt16# i) (intToInt16# j) (intToInt16# k) (intToInt16# l) + (intToInt16# m) (intToInt16# n) (intToInt16# o) (intToInt16# p) {-# NOINLINE addMany #-} -- Convenient and also tests higher order functions on Int16# apply1 :: (Int16# -> Int16#) -> Int -> Int -apply1 opToTest (I# a) = I# (extendInt16# (opToTest (narrowInt16# a))) +apply1 opToTest (I# a) = I# (int16ToInt# (opToTest (intToInt16# a))) {-# NOINLINE apply1 #-} apply2 :: (Int16# -> Int16# -> Int16#) -> Int -> Int -> Int apply2 opToTest (I# a) (I# b) = - let (# sa, sb #) = (# narrowInt16# a, narrowInt16# b #) + let (# sa, sb #) = (# intToInt16# a, intToInt16# b #) r = opToTest sa sb - in I# (extendInt16# r) + in I# (int16ToInt# r) {-# NOINLINE apply2 #-} apply3 :: (Int16# -> Int16# -> (# Int16#, Int16# #)) -> Int -> Int -> (Int, Int) apply3 opToTest (I# a) (I# b) = - let (# sa, sb #) = (# narrowInt16# a, narrowInt16# b #) + let (# sa, sb #) = (# intToInt16# a, intToInt16# b #) (# ra, rb #) = opToTest sa sb - in (I# (extendInt16# ra), I# (extendInt16# rb)) + in (I# (int16ToInt# ra), I# (int16ToInt# rb)) {-# NOINLINE apply3 #-} instance diff --git a/testsuite/tests/primops/should_run/ArithInt32.hs b/testsuite/tests/primops/should_run/ArithInt32.hs index 13b3bb026e..8d1c6a4ad0 100644 --- a/testsuite/tests/primops/should_run/ArithInt32.hs +++ b/testsuite/tests/primops/should_run/ArithInt32.hs @@ -146,32 +146,32 @@ addMany (I# a) (I# b) (I# c) (I# d) (I# e) (I# f) (I# g) (I# h) (I# i) (I# j) (I# k) (I# l) (I# m) (I# n) (I# o) (I# p) - = I# (extendInt32# int32) + = I# (int32ToInt# int32) where !int32 = addMany# - (narrowInt32# a) (narrowInt32# b) (narrowInt32# c) (narrowInt32# d) - (narrowInt32# e) (narrowInt32# f) (narrowInt32# g) (narrowInt32# h) - (narrowInt32# i) (narrowInt32# j) (narrowInt32# k) (narrowInt32# l) - (narrowInt32# m) (narrowInt32# n) (narrowInt32# o) (narrowInt32# p) + (intToInt32# a) (intToInt32# b) (intToInt32# c) (intToInt32# d) + (intToInt32# e) (intToInt32# f) (intToInt32# g) (intToInt32# h) + (intToInt32# i) (intToInt32# j) (intToInt32# k) (intToInt32# l) + (intToInt32# m) (intToInt32# n) (intToInt32# o) (intToInt32# p) {-# NOINLINE addMany #-} -- Convenient and also tests higher order functions on Int32# apply1 :: (Int32# -> Int32#) -> Int -> Int -apply1 opToTest (I# a) = I# (extendInt32# (opToTest (narrowInt32# a))) +apply1 opToTest (I# a) = I# (int32ToInt# (opToTest (intToInt32# a))) {-# NOINLINE apply1 #-} apply2 :: (Int32# -> Int32# -> Int32#) -> Int -> Int -> Int apply2 opToTest (I# a) (I# b) = - let (# sa, sb #) = (# narrowInt32# a, narrowInt32# b #) + let (# sa, sb #) = (# intToInt32# a, intToInt32# b #) r = opToTest sa sb - in I# (extendInt32# r) + in I# (int32ToInt# r) {-# NOINLINE apply2 #-} apply3 :: (Int32# -> Int32# -> (# Int32#, Int32# #)) -> Int -> Int -> (Int, Int) apply3 opToTest (I# a) (I# b) = - let (# sa, sb #) = (# narrowInt32# a, narrowInt32# b #) + let (# sa, sb #) = (# intToInt32# a, intToInt32# b #) (# ra, rb #) = opToTest sa sb - in (I# (extendInt32# ra), I# (extendInt32# rb)) + in (I# (int32ToInt# ra), I# (int32ToInt# rb)) {-# NOINLINE apply3 #-} instance diff --git a/testsuite/tests/primops/should_run/ArithInt8.hs b/testsuite/tests/primops/should_run/ArithInt8.hs index 18a472d073..4629772a7d 100644 --- a/testsuite/tests/primops/should_run/ArithInt8.hs +++ b/testsuite/tests/primops/should_run/ArithInt8.hs @@ -150,32 +150,32 @@ addMany (I# a) (I# b) (I# c) (I# d) (I# e) (I# f) (I# g) (I# h) (I# i) (I# j) (I# k) (I# l) (I# m) (I# n) (I# o) (I# p) - = I# (extendInt8# int8) + = I# (int8ToInt# int8) where !int8 = addMany# - (narrowInt8# a) (narrowInt8# b) (narrowInt8# c) (narrowInt8# d) - (narrowInt8# e) (narrowInt8# f) (narrowInt8# g) (narrowInt8# h) - (narrowInt8# i) (narrowInt8# j) (narrowInt8# k) (narrowInt8# l) - (narrowInt8# m) (narrowInt8# n) (narrowInt8# o) (narrowInt8# p) + (intToInt8# a) (intToInt8# b) (intToInt8# c) (intToInt8# d) + (intToInt8# e) (intToInt8# f) (intToInt8# g) (intToInt8# h) + (intToInt8# i) (intToInt8# j) (intToInt8# k) (intToInt8# l) + (intToInt8# m) (intToInt8# n) (intToInt8# o) (intToInt8# p) {-# NOINLINE addMany #-} -- Convenient and also tests higher order functions on Int8# apply1 :: (Int8# -> Int8#) -> Int -> Int -apply1 opToTest (I# a) = I# (extendInt8# (opToTest (narrowInt8# a))) +apply1 opToTest (I# a) = I# (int8ToInt# (opToTest (intToInt8# a))) {-# NOINLINE apply1 #-} apply2 :: (Int8# -> Int8# -> Int8#) -> Int -> Int -> Int apply2 opToTest (I# a) (I# b) = - let (# sa, sb #) = (# narrowInt8# a, narrowInt8# b #) + let (# sa, sb #) = (# intToInt8# a, intToInt8# b #) r = opToTest sa sb - in I# (extendInt8# r) + in I# (int8ToInt# r) {-# NOINLINE apply2 #-} apply3 :: (Int8# -> Int8# -> (# Int8#, Int8# #)) -> Int -> Int -> (Int, Int) apply3 opToTest (I# a) (I# b) = - let (# sa, sb #) = (# narrowInt8# a, narrowInt8# b #) + let (# sa, sb #) = (# intToInt8# a, intToInt8# b #) (# ra, rb #) = opToTest sa sb - in (I# (extendInt8# ra), I# (extendInt8# rb)) + in (I# (int8ToInt# ra), I# (int8ToInt# rb)) {-# NOINLINE apply3 #-} instance diff --git a/testsuite/tests/primops/should_run/ArithWord16.hs b/testsuite/tests/primops/should_run/ArithWord16.hs index 5870fd4751..cd64614873 100644 --- a/testsuite/tests/primops/should_run/ArithWord16.hs +++ b/testsuite/tests/primops/should_run/ArithWord16.hs @@ -141,34 +141,34 @@ addMany (W# a) (W# b) (W# c) (W# d) (W# e) (W# f) (W# g) (W# h) (W# i) (W# j) (W# k) (W# l) (W# m) (W# n) (W# o) (W# p) - = W# (extendWord16# word16) + = W# (word16ToWord# word16) where !word16 = addMany# - (narrowWord16# a) (narrowWord16# b) (narrowWord16# c) (narrowWord16# d) - (narrowWord16# e) (narrowWord16# f) (narrowWord16# g) (narrowWord16# h) - (narrowWord16# i) (narrowWord16# j) (narrowWord16# k) (narrowWord16# l) - (narrowWord16# m) (narrowWord16# n) (narrowWord16# o) (narrowWord16# p) + (wordToWord16# a) (wordToWord16# b) (wordToWord16# c) (wordToWord16# d) + (wordToWord16# e) (wordToWord16# f) (wordToWord16# g) (wordToWord16# h) + (wordToWord16# i) (wordToWord16# j) (wordToWord16# k) (wordToWord16# l) + (wordToWord16# m) (wordToWord16# n) (wordToWord16# o) (wordToWord16# p) {-# NOINLINE addMany #-} -- Convenient and also tests higher order functions on Word16# apply1 :: (Word16# -> Word16#) -> Word -> Word -apply1 opToTest (W# a) = W# (extendWord16# (opToTest (narrowWord16# a))) +apply1 opToTest (W# a) = W# (word16ToWord# (opToTest (wordToWord16# a))) {-# NOINLINE apply1 #-} apply2 :: (Word16# -> Word16# -> Word16#) -> Word -> Word -> Word apply2 opToTest (W# a) (W# b) = - let (# sa, sb #) = (# narrowWord16# a, narrowWord16# b #) + let (# sa, sb #) = (# wordToWord16# a, wordToWord16# b #) r = opToTest sa sb - in W# (extendWord16# r) + in W# (word16ToWord# r) {-# NOINLINE apply2 #-} apply3 :: (Word16# -> Word16# -> (# Word16#, Word16# #)) -> Word -> Word -> (Word, Word) apply3 opToTest (W# a) (W# b) = - let (# sa, sb #) = (# narrowWord16# a, narrowWord16# b #) + let (# sa, sb #) = (# wordToWord16# a, wordToWord16# b #) (# ra, rb #) = opToTest sa sb - in (W# (extendWord16# ra), W# (extendWord16# rb)) + in (W# (word16ToWord# ra), W# (word16ToWord# rb)) {-# NOINLINE apply3 #-} instance diff --git a/testsuite/tests/primops/should_run/ArithWord32.hs b/testsuite/tests/primops/should_run/ArithWord32.hs index 5756732ce0..ad0352435e 100644 --- a/testsuite/tests/primops/should_run/ArithWord32.hs +++ b/testsuite/tests/primops/should_run/ArithWord32.hs @@ -141,34 +141,34 @@ addMany (W# a) (W# b) (W# c) (W# d) (W# e) (W# f) (W# g) (W# h) (W# i) (W# j) (W# k) (W# l) (W# m) (W# n) (W# o) (W# p) - = W# (extendWord32# word32) + = W# (word32ToWord# word32) where !word32 = addMany# - (narrowWord32# a) (narrowWord32# b) (narrowWord32# c) (narrowWord32# d) - (narrowWord32# e) (narrowWord32# f) (narrowWord32# g) (narrowWord32# h) - (narrowWord32# i) (narrowWord32# j) (narrowWord32# k) (narrowWord32# l) - (narrowWord32# m) (narrowWord32# n) (narrowWord32# o) (narrowWord32# p) + (wordToWord32# a) (wordToWord32# b) (wordToWord32# c) (wordToWord32# d) + (wordToWord32# e) (wordToWord32# f) (wordToWord32# g) (wordToWord32# h) + (wordToWord32# i) (wordToWord32# j) (wordToWord32# k) (wordToWord32# l) + (wordToWord32# m) (wordToWord32# n) (wordToWord32# o) (wordToWord32# p) {-# NOINLINE addMany #-} -- Convenient and also tests higher order functions on Word32# apply1 :: (Word32# -> Word32#) -> Word -> Word -apply1 opToTest (W# a) = W# (extendWord32# (opToTest (narrowWord32# a))) +apply1 opToTest (W# a) = W# (word32ToWord# (opToTest (wordToWord32# a))) {-# NOINLINE apply1 #-} apply2 :: (Word32# -> Word32# -> Word32#) -> Word -> Word -> Word apply2 opToTest (W# a) (W# b) = - let (# sa, sb #) = (# narrowWord32# a, narrowWord32# b #) + let (# sa, sb #) = (# wordToWord32# a, wordToWord32# b #) r = opToTest sa sb - in W# (extendWord32# r) + in W# (word32ToWord# r) {-# NOINLINE apply2 #-} apply3 :: (Word32# -> Word32# -> (# Word32#, Word32# #)) -> Word -> Word -> (Word, Word) apply3 opToTest (W# a) (W# b) = - let (# sa, sb #) = (# narrowWord32# a, narrowWord32# b #) + let (# sa, sb #) = (# wordToWord32# a, wordToWord32# b #) (# ra, rb #) = opToTest sa sb - in (W# (extendWord32# ra), W# (extendWord32# rb)) + in (W# (word32ToWord# ra), W# (word32ToWord# rb)) {-# NOINLINE apply3 #-} instance diff --git a/testsuite/tests/primops/should_run/ArithWord8.hs b/testsuite/tests/primops/should_run/ArithWord8.hs index b25d2b0e6f..6fea314bb2 100644 --- a/testsuite/tests/primops/should_run/ArithWord8.hs +++ b/testsuite/tests/primops/should_run/ArithWord8.hs @@ -145,34 +145,34 @@ addMany (W# a) (W# b) (W# c) (W# d) (W# e) (W# f) (W# g) (W# h) (W# i) (W# j) (W# k) (W# l) (W# m) (W# n) (W# o) (W# p) - = W# (extendWord8# word8) + = W# (word8ToWord# word8) where !word8 = addMany# - (narrowWord8# a) (narrowWord8# b) (narrowWord8# c) (narrowWord8# d) - (narrowWord8# e) (narrowWord8# f) (narrowWord8# g) (narrowWord8# h) - (narrowWord8# i) (narrowWord8# j) (narrowWord8# k) (narrowWord8# l) - (narrowWord8# m) (narrowWord8# n) (narrowWord8# o) (narrowWord8# p) + (wordToWord8# a) (wordToWord8# b) (wordToWord8# c) (wordToWord8# d) + (wordToWord8# e) (wordToWord8# f) (wordToWord8# g) (wordToWord8# h) + (wordToWord8# i) (wordToWord8# j) (wordToWord8# k) (wordToWord8# l) + (wordToWord8# m) (wordToWord8# n) (wordToWord8# o) (wordToWord8# p) {-# NOINLINE addMany #-} -- Convenient and also tests higher order functions on Word8# apply1 :: (Word8# -> Word8#) -> Word -> Word -apply1 opToTest (W# a) = W# (extendWord8# (opToTest (narrowWord8# a))) +apply1 opToTest (W# a) = W# (word8ToWord# (opToTest (wordToWord8# a))) {-# NOINLINE apply1 #-} apply2 :: (Word8# -> Word8# -> Word8#) -> Word -> Word -> Word apply2 opToTest (W# a) (W# b) = - let (# sa, sb #) = (# narrowWord8# a, narrowWord8# b #) + let (# sa, sb #) = (# wordToWord8# a, wordToWord8# b #) r = opToTest sa sb - in W# (extendWord8# r) + in W# (word8ToWord# r) {-# NOINLINE apply2 #-} apply3 :: (Word8# -> Word8# -> (# Word8#, Word8# #)) -> Word -> Word -> (Word, Word) apply3 opToTest (W# a) (W# b) = - let (# sa, sb #) = (# narrowWord8# a, narrowWord8# b #) + let (# sa, sb #) = (# wordToWord8# a, wordToWord8# b #) (# ra, rb #) = opToTest sa sb - in (W# (extendWord8# ra), W# (extendWord8# rb)) + in (W# (word8ToWord# ra), W# (word8ToWord# rb)) {-# NOINLINE apply3 #-} instance diff --git a/testsuite/tests/primops/should_run/CStringLength.hs b/testsuite/tests/primops/should_run/CStringLength.hs index b580e61934..ee7aac4f9b 100644 --- a/testsuite/tests/primops/should_run/CStringLength.hs +++ b/testsuite/tests/primops/should_run/CStringLength.hs @@ -3,6 +3,7 @@ {-# LANGUAGE UnboxedTuples #-} import GHC.Exts +import GHC.Word (Word8(..)) main :: IO () main = do @@ -28,6 +29,11 @@ main = do naiveStrlen "araña\NULb"# 0 naiveStrlen :: Addr# -> Int -> Int -naiveStrlen addr !n = case indexWord8OffAddr# addr 0# of - 0## -> n - _ -> naiveStrlen (plusAddr# addr 1#) (n + 1) +naiveStrlen addr !n = + -- TODO change back to pattern matching once we have negative literals. + if isTrue# (res `eqWord8#` zero) + then n + else naiveStrlen (plusAddr# addr 1#) (n + 1) + where + res = indexWord8OffAddr# addr 0# + W8# zero = 0 diff --git a/testsuite/tests/primops/should_run/CmpInt16.hs b/testsuite/tests/primops/should_run/CmpInt16.hs index 3fa89b5b31..0fdec359d7 100644 --- a/testsuite/tests/primops/should_run/CmpInt16.hs +++ b/testsuite/tests/primops/should_run/CmpInt16.hs @@ -16,7 +16,7 @@ data TestInt16 = T16 Int16# deriving (Eq, Ord) mkT16 :: Int -> TestInt16 -mkT16 (I# a) = T16 (narrowInt16# a) +mkT16 (I# a) = T16 (intToInt16# a) main :: IO () main = do diff --git a/testsuite/tests/primops/should_run/CmpInt32.hs b/testsuite/tests/primops/should_run/CmpInt32.hs index 6f52ccecb1..a9b560664b 100644 --- a/testsuite/tests/primops/should_run/CmpInt32.hs +++ b/testsuite/tests/primops/should_run/CmpInt32.hs @@ -16,7 +16,7 @@ data TestInt32 = T32 Int32# deriving (Eq, Ord) mkT32 :: Int -> TestInt32 -mkT32 (I# a) = T32 (narrowInt32# a) +mkT32 (I# a) = T32 (intToInt32# a) main :: IO () main = do diff --git a/testsuite/tests/primops/should_run/CmpInt8.hs b/testsuite/tests/primops/should_run/CmpInt8.hs index 7f0bcda973..2bed2000da 100644 --- a/testsuite/tests/primops/should_run/CmpInt8.hs +++ b/testsuite/tests/primops/should_run/CmpInt8.hs @@ -16,7 +16,7 @@ data TestInt8 = T8 Int8# deriving (Eq, Ord) mkT8 :: Int -> TestInt8 -mkT8 (I# a) = T8 (narrowInt8# a) +mkT8 (I# a) = T8 (intToInt8# a) main :: IO () main = do diff --git a/testsuite/tests/primops/should_run/CmpWord16.hs b/testsuite/tests/primops/should_run/CmpWord16.hs index 1a69a10f4b..a5d527afd0 100644 --- a/testsuite/tests/primops/should_run/CmpWord16.hs +++ b/testsuite/tests/primops/should_run/CmpWord16.hs @@ -16,7 +16,7 @@ data TestWord16 = T16 Word16# deriving (Eq, Ord) mkT16 :: Word -> TestWord16 -mkT16 (W# a) = T16 (narrowWord16# a) +mkT16 (W# a) = T16 (wordToWord16# a) main :: IO () main = do diff --git a/testsuite/tests/primops/should_run/CmpWord32.hs b/testsuite/tests/primops/should_run/CmpWord32.hs index 5e422aecab..aeb7ec28e4 100644 --- a/testsuite/tests/primops/should_run/CmpWord32.hs +++ b/testsuite/tests/primops/should_run/CmpWord32.hs @@ -16,7 +16,7 @@ data TestWord32 = T32 Word32# deriving (Eq, Ord) mkT32 :: Word -> TestWord32 -mkT32 (W# a) = T32 (narrowWord32# a) +mkT32 (W# a) = T32 (wordToWord32# a) main :: IO () main = do diff --git a/testsuite/tests/primops/should_run/CmpWord8.hs b/testsuite/tests/primops/should_run/CmpWord8.hs index 07f683108e..813ae7c270 100644 --- a/testsuite/tests/primops/should_run/CmpWord8.hs +++ b/testsuite/tests/primops/should_run/CmpWord8.hs @@ -16,7 +16,7 @@ data TestWord8 = T8 Word8# deriving (Eq, Ord) mkT8 :: Word -> TestWord8 -mkT8 (W# a) = T8 (narrowWord8# a) +mkT8 (W# a) = T8 (wordToWord8# a) main :: IO () main = do diff --git a/testsuite/tests/primops/should_run/ShowPrim.hs b/testsuite/tests/primops/should_run/ShowPrim.hs index ddeb661ec4..6213ef496c 100644 --- a/testsuite/tests/primops/should_run/ShowPrim.hs +++ b/testsuite/tests/primops/should_run/ShowPrim.hs @@ -14,13 +14,13 @@ data Test3 = Test3 Int32# Word32# deriving (Show) test1 :: Test1 -test1 = Test1 (narrowInt8# 1#) (narrowWord8# 2##) +test1 = Test1 (intToInt8# 1#) (wordToWord8# 2##) test2 :: Test2 -test2 = Test2 (narrowInt16# 1#) (narrowWord16# 2##) +test2 = Test2 (intToInt16# 1#) (wordToWord16# 2##) test3 :: Test3 -test3 = Test3 (narrowInt32# 1#) (narrowWord32# 2##) +test3 = Test3 (intToInt32# 1#) (wordToWord32# 2##) main :: IO () main = do diff --git a/testsuite/tests/primops/should_run/ShowPrim.stdout b/testsuite/tests/primops/should_run/ShowPrim.stdout index a5dc75f39d..d4167bf32c 100644 --- a/testsuite/tests/primops/should_run/ShowPrim.stdout +++ b/testsuite/tests/primops/should_run/ShowPrim.stdout @@ -1,3 +1,3 @@ -Test1 (narrowInt8# 1#) (narrowWord8# 2##) -Test2 (narrowInt16# 1#) (narrowWord16# 2##) -Test3 (narrowInt32# 1#) (narrowWord32# 2##) +Test1 (intToInt8# 1#) (wordToWord8# 2##) +Test2 (intToInt16# 1#) (wordToWord16# 2##) +Test3 (intToInt32# 1#) (wordToWord32# 2##) diff --git a/testsuite/tests/primops/should_run/T4442.hs b/testsuite/tests/primops/should_run/T4442.hs index d9e65006bc..dfdf93cc4f 100644 --- a/testsuite/tests/primops/should_run/T4442.hs +++ b/testsuite/tests/primops/should_run/T4442.hs @@ -1,4 +1,6 @@ -{-# LANGUAGE MagicHash, UnboxedTuples, CPP #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE UnboxedTuples #-} module Main where #include "MachDeps.h" @@ -8,32 +10,30 @@ import GHC.Stable( StablePtr(..), castStablePtrToPtr, castPtrToStablePtr, newStablePtr) import GHC.Exts import Data.Char(ord) -#if WORD_SIZE_IN_BITS < 64 -import GHC.Int (Int64(..)) -import GHC.Word (Word64(..)) -#endif +import GHC.Int +import GHC.Word -assertEqual :: (Show a, Eq a) => a -> a -> IO () -assertEqual a b - | a /= b = putStrLn (show a ++ " /= " ++ show b) +assertEqual :: (Show a, Eq a) => String -> a -> a -> IO () +assertEqual msg a b + | a /= b = putStrLn (msg ++ " " ++ show a ++ " /= " ++ show b) | otherwise = return () -readBytes :: MutableByteArray# s -> State# s -> Int# -> (# State# s, [Int] #) +readBytes :: MutableByteArray# s -> State# s -> Int# -> (# State# s, [Word8] #) readBytes marr s0 len = go s0 len [] where go s 0# bs = (# s, bs #) go s i bs = case readWord8Array# marr (i -# 1#) s of - (# s', b #) -> go s' (i -# 1#) (I# (word2Int# b):bs) + (# s', b #) -> go s' (i -# 1#) (W8# b : bs) -indexBytes :: ByteArray# -> Int# -> [Int] +indexBytes :: ByteArray# -> Int# -> [Word8] indexBytes arr len = - [I# (word2Int# (indexWord8Array# arr i)) | I# i <- [0..I# len - 1]] + [W8# (indexWord8Array# arr i) | I# i <- [0..I# len - 1]] -fillByteArray :: MutableByteArray# s -> Int# -> Int -> State# s -> State# s -fillByteArray arr len (I# a) = go len +fillByteArray :: MutableByteArray# s -> Int# -> Word8 -> State# s -> State# s +fillByteArray arr len (W8# a) = go len where go 0# s = s - go i s = go (i -# 1#) (writeInt8Array# arr (i -# 1#) a s) + go i s = go (i -# 1#) (writeWord8Array# arr (i -# 1#) a s) test :: (Eq a, Show a) => String @@ -43,7 +43,7 @@ test :: (Eq a, Show a) -> (MutableByteArray# RealWorld -> Int# -> a -> State# RealWorld -> State# RealWorld) -> a - -> [Int] + -> [Word8] -> Int -> IO () test name index read write val valBytes len = do @@ -53,14 +53,14 @@ test name index read write val valBytes len = do arrLen :: Int# arrLen = 24# - fillerByte :: Int + fillerByte :: Word8 fillerByte = 0x34 - expectedArrayBytes :: Int -> [Int] + expectedArrayBytes :: Int -> [Word8] expectedArrayBytes offset = replicate offset fillerByte ++ valBytes - ++ replicate (I# arrLen - len - offset) fillerByte + ++ replicate (fromIntegral $ I# arrLen - len - offset) fillerByte testAtOffset :: Int -> IO () testAtOffset offset@(I# offset#) = runRW# (\s0 -> let @@ -73,18 +73,18 @@ test name index read write val valBytes len = do actual1 = index arr offset# actualBytes1 = indexBytes arr arrLen in do - assertEqual actual0 val - assertEqual actual1 val - assertEqual actualBytes0 (expectedArrayBytes offset) - assertEqual actualBytes1 (expectedArrayBytes offset) + assertEqual "actual val 0" actual0 val + assertEqual "actual val 1" actual1 val + assertEqual "actualBytes0 indexed" actualBytes0 (expectedArrayBytes offset) + assertEqual "actualButes1 indexed" actualBytes1 (expectedArrayBytes offset) ) -intToBytes :: Int -> Int -> [Int] -intToBytes (I# val0) (I# len0) = let +intToBytes :: Word -> Int -> [Word8] +intToBytes (W# val0) (I# len0) = let result = go val0 len0 go v 0# = [] go v len = - I# (v `andI#` 0xff#) : go (v `uncheckedIShiftRL#` 8#) (len -# 1#) + W8# (wordToWord8# v) : go (v `uncheckedShiftRL#` 8#) (len -# 1#) in #if defined(WORDS_BIGENDIAN) reverse result @@ -92,28 +92,22 @@ intToBytes (I# val0) (I# len0) = let result #endif -testIntArray :: - String - -> (ByteArray# -> Int# -> Int#) +testIntArray :: (Eq a, Show a, Integral a, Num a) + => String + -> (ByteArray# -> Int# -> a) -> (MutableByteArray# RealWorld -> Int# -> State# RealWorld - -> (# State# RealWorld, Int# #)) - -> (MutableByteArray# RealWorld -> Int# -> Int# -> State# RealWorld - -> State# RealWorld) - -> Int + -> (# State# RealWorld, a #)) + -> (MutableByteArray# RealWorld -> Int# -> a -> State# RealWorld + -> State# RealWorld) + -> a -> Int -> IO () testIntArray name0 index read write val0 len = do doOne (name0 ++ " positive") val0 doOne (name0 ++ " negative") (negate val0) where - doOne name val = test - name - (\arr i -> I# (index arr i)) - (\arr i s -> case read arr i s of (# s', a #) -> (# s', I# a #)) - (\arr i (I# a) s -> write arr i a s) - val - (intToBytes val len) - len + doOne name val = test name index read write + val (intToBytes (fromIntegral val) len) len #if WORD_SIZE_IN_BITS == 64 testInt64Array = testIntArray @@ -143,24 +137,19 @@ testInt64Array name0 index read write val0 len = do len #endif -testWordArray :: - String - -> (ByteArray# -> Int# -> Word#) +testWordArray :: (Eq a, Show a, Integral a) + => String + -> (ByteArray# -> Int# -> a) -> (MutableByteArray# RealWorld -> Int# -> State# RealWorld - -> (# State# RealWorld, Word# #)) - -> (MutableByteArray# RealWorld -> Int# -> Word# -> State# RealWorld + -> (# State# RealWorld, a #)) + -> (MutableByteArray# RealWorld -> Int# -> a -> State# RealWorld -> State# RealWorld) - -> Word + -> a -> Int -> IO () -testWordArray name index read write val len = test - name - (\arr i -> W# (index arr i)) - (\arr i s -> case read arr i s of (# s', a #) -> (# s', W# a #)) - (\arr i (W# a) s -> write arr i a s) - val - (intToBytes (fromIntegral val) len) - len +testWordArray name index read write val len = + test name index read write + val (intToBytes (fromIntegral val) len) len #if WORD_SIZE_IN_BITS == 64 testWord64Array = testWordArray @@ -203,7 +192,7 @@ float = 123.456789 -- >>> import struct -- >>> import binascii -- >>> binascii.hexlify(struct.pack('>f', 123.456789)) -floatBytes :: Int +floatBytes :: Word floatBytes = 0x42f6e9e0 double :: Double @@ -213,41 +202,61 @@ double = 123.45678901234 -- >>> import struct -- >>> import binascii -- >>> binascii.hexlify(struct.pack('>d', 123.45678901234)) -doubleBytes :: Int +doubleBytes :: Word doubleBytes = 0x405edd3c07fb4b09 main :: IO () main = do testIntArray "Int8#" - indexInt8Array# readInt8Array# writeInt8Array# + (\arr i -> I8# (indexInt8Array# arr i)) + (\arr i s -> case readInt8Array# arr i s of (# s', a #) -> (# s', I8# a #)) + (\arr i (I8# a) s -> writeInt8Array# arr i a s) 123 1 testIntArray "Int16#" - indexWord8ArrayAsInt16# readWord8ArrayAsInt16# writeWord8ArrayAsInt16# + (\arr i -> I16# (indexWord8ArrayAsInt16# arr i)) + (\arr i s -> case readWord8ArrayAsInt16# arr i s of (# s', a #) -> (# s', I16# a #)) + (\arr i (I16# a) s -> writeWord8ArrayAsInt16# arr i a s) 12345 2 testIntArray "Int32#" - indexWord8ArrayAsInt32# readWord8ArrayAsInt32# writeWord8ArrayAsInt32# + (\arr i -> I32# (indexWord8ArrayAsInt32# arr i)) + (\arr i s -> case readWord8ArrayAsInt32# arr i s of (# s', a #) -> (# s', I32# a #)) + (\arr i (I32# a) s -> writeWord8ArrayAsInt32# arr i a s) 12345678 4 testInt64Array "Int64#" - indexWord8ArrayAsInt64# readWord8ArrayAsInt64# writeWord8ArrayAsInt64# + (\arr i -> I64# (indexWord8ArrayAsInt64# arr i)) + (\arr i s -> case readWord8ArrayAsInt64# arr i s of (# s', a #) -> (# s', I64# a #)) + (\arr i (I64# a) s -> writeWord8ArrayAsInt64# arr i a s) 1234567890123 8 testIntArray "Int#" - indexWord8ArrayAsInt# readWord8ArrayAsInt# writeWord8ArrayAsInt# + (\arr i -> I# (indexWord8ArrayAsInt# arr i)) + (\arr i s -> case readWord8ArrayAsInt# arr i s of (# s', a #) -> (# s', I# a #)) + (\arr i (I# a) s -> writeWord8ArrayAsInt# arr i a s) int wordSizeInBytes testWordArray "Word8#" - indexWord8Array# readWord8Array# writeWord8Array# + (\arr i -> W8# (indexWord8Array# arr i)) + (\arr i s -> case readWord8Array# arr i s of (# s', a #) -> (# s', W8# a #)) + (\arr i (W8# a) s -> writeWord8Array# arr i a s) 123 1 testWordArray "Word16#" - indexWord8ArrayAsWord16# readWord8ArrayAsWord16# writeWord8ArrayAsWord16# + (\arr i -> W16# (indexWord8ArrayAsWord16# arr i)) + (\arr i s -> case readWord8ArrayAsWord16# arr i s of (# s', a #) -> (# s', W16# a #)) + (\arr i (W16# a) s -> writeWord8ArrayAsWord16# arr i a s) 12345 2 testWordArray "Word32#" - indexWord8ArrayAsWord32# readWord8ArrayAsWord32# writeWord8ArrayAsWord32# + (\arr i -> W32# (indexWord8ArrayAsWord32# arr i)) + (\arr i s -> case readWord8ArrayAsWord32# arr i s of (# s', a #) -> (# s', W32# a #)) + (\arr i (W32# a) s -> writeWord8ArrayAsWord32# arr i a s) 12345678 4 testWord64Array "Word64#" - indexWord8ArrayAsWord64# readWord8ArrayAsWord64# writeWord8ArrayAsWord64# + (\arr i -> W64# (indexWord8ArrayAsWord64# arr i)) + (\arr i s -> case readWord8ArrayAsWord64# arr i s of (# s', a #) -> (# s', W64# a #)) + (\arr i (W64# a) s -> writeWord8ArrayAsWord64# arr i a s) 1234567890123 8 testWordArray "Word#" - indexWord8ArrayAsWord# readWord8ArrayAsWord# writeWord8ArrayAsWord# + (\arr i -> W# (indexWord8ArrayAsWord# arr i)) + (\arr i s -> case readWord8ArrayAsWord# arr i s of (# s', a #) -> (# s', W# a #)) + (\arr i (W# a) s -> writeWord8ArrayAsWord# arr i a s) word wordSizeInBytes test @@ -257,7 +266,7 @@ main = do case readWord8ArrayAsChar# arr i s of (# s', a #) -> (# s', C# a #)) (\arr i (C# a) s -> writeWord8ArrayAsChar# arr i a s) 'z' - [ord 'z'] + [fromIntegral $ ord 'z'] 1 test "WideChar#" @@ -266,7 +275,7 @@ main = do case readWord8ArrayAsWideChar# arr i s of (# s', a #) -> (# s', C# a #)) (\arr i (C# a) s -> writeWord8ArrayAsWideChar# arr i a s) '𠜎' -- See http://www.i18nguy.com/unicode/supplementary-test.html - (intToBytes (ord '𠜎') 4) + (intToBytes (fromIntegral $ ord '𠜎') 4) 4 test "Addr#" @@ -275,7 +284,7 @@ main = do case readWord8ArrayAsAddr# arr i s of (# s', a #) -> (# s', Ptr a #)) (\arr i (Ptr a) s -> writeWord8ArrayAsAddr# arr i a s) (nullPtr `plusPtr` int) - (intToBytes int wordSizeInBytes) + (intToBytes word wordSizeInBytes) wordSizeInBytes stablePtr <- newStablePtr () @@ -288,7 +297,7 @@ main = do (\arr i p s -> case castPtrToStablePtr p of (StablePtr a) -> writeWord8ArrayAsStablePtr# arr i a s) (castStablePtrToPtr stablePtr) - (intToBytes (castStablePtrToPtr stablePtr `minusPtr` nullPtr) + (intToBytes (fromIntegral $ castStablePtrToPtr stablePtr `minusPtr` nullPtr) wordSizeInBytes) wordSizeInBytes diff --git a/testsuite/tests/profiling/should_run/T3001-2.hs b/testsuite/tests/profiling/should_run/T3001-2.hs index 186fd2f2f9..c7340dfd19 100644 --- a/testsuite/tests/profiling/should_run/T3001-2.hs +++ b/testsuite/tests/profiling/should_run/T3001-2.hs @@ -153,7 +153,7 @@ readN :: Int -> (S.ByteString -> a) -> Get a readN n f = fmap f $ getBytes n shiftl_w32 :: Word32 -> Int -> Word32 -shiftl_w32 (W32# w) (I# i) = W32# (narrowWord32# ((extendWord32# w) `uncheckedShiftL#` i)) +shiftl_w32 (W32# w) (I# i) = W32# (wordToWord32# ((word32ToWord# w) `uncheckedShiftL#` i)) getPtr :: Storable a => Int -> Get a getPtr n = do @@ -274,7 +274,7 @@ putWord32beB w = writeN 4 $ \p -> do poke (p `plusPtr` 3) (fromIntegral (w) :: Word8) shiftr_w32 :: Word32 -> Int -> Word32 -shiftr_w32 (W32# w) (I# i) = W32# (narrowWord32# ((extendWord32# w) `uncheckedShiftRL#` i)) +shiftr_w32 (W32# w) (I# i) = W32# (wordToWord32# ((word32ToWord# w) `uncheckedShiftRL#` i)) flush :: Builder flush = Builder $ \ k buf@(Buffer p o u l) -> diff --git a/testsuite/tests/rts/T17088.hs b/testsuite/tests/rts/T17088.hs index f607ed38e3..6ca24d88d4 100644 --- a/testsuite/tests/rts/T17088.hs +++ b/testsuite/tests/rts/T17088.hs @@ -46,7 +46,7 @@ bytesEq (Bytes m1) (Bytes m2) (# s', e1 #) -> case readWord8Array# m2 i s' of (# s'', e2 #) -> - if isTrue# (eqWord# e1 e2) + if isTrue# (eqWord8# e1 e2) then loop (i +# 1#) s'' else (# s'', False #) @@ -56,7 +56,7 @@ bytesUnpackChars (Bytes mba) | I# (sizeofMutableByteArray# mba) == 0 = [] | otherwise = unsafePerformIO $ do c <- IO $ \s -> case readWord8Array# mba 0# s of - (# s'', w #) -> (# s'', C# (chr# (word2Int# w)) #) + (# s'', w #) -> (# s'', C# (chr# (word2Int# (word8ToWord# w))) #) return [c] ---------------------------------------------------------------- diff --git a/testsuite/tests/simplCore/should_compile/T5359a.hs b/testsuite/tests/simplCore/should_compile/T5359a.hs index 8c4a0beaf7..594bd9ed18 100644 --- a/testsuite/tests/simplCore/should_compile/T5359a.hs +++ b/testsuite/tests/simplCore/should_compile/T5359a.hs @@ -61,7 +61,7 @@ textP arr off len | len == 0 = emptyT {-# INLINE textP #-} unsafeChrT :: Word16 -> Char -unsafeChrT (W16# w#) = C# (chr# (word2Int# (extendWord16# w#))) +unsafeChrT (W16# w#) = C# (chr# (word2Int# (word16ToWord# w#))) {-# INLINE unsafeChrT #-} data Array = Array ByteArray# @@ -82,7 +82,7 @@ unsafeFreeze (MArray maBA) = ST $ \s# -> (# s#, Array (unsafeCoerce# maBA) #) unsafeIndex :: Array -> Int -> Word16 unsafeIndex (Array aBA) (I# i#) = - case indexWord16Array# aBA i# of r# -> (W16# (narrowWord16# r#)) + case indexWord16Array# aBA i# of r# -> (W16# r#) {-# INLINE unsafeIndex #-} empty :: Array |