summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorMoritz Angermann <moritz.angermann@gmail.com>2020-10-22 12:08:34 +0800
committerMarge Bot <ben+marge-bot@smart-cactus.org>2020-11-26 16:00:32 -0500
commitbe5d74caab64abf9d986fc7290f62731db7e73e7 (patch)
tree7b1f374333ff0fb0449e9c6834c2a8210cfba7c5
parent2ed3e6c0f179c06828712832d1176519cdfa82a6 (diff)
downloadhaskell-be5d74caab64abf9d986fc7290f62731db7e73e7.tar.gz
[Sized Cmm] properly retain sizes.
This replaces all Word<N> = W<N># Word# and Int<N> = I<N># Int# with Word<N> = W<N># Word<N># and Int<N> = I<N># Int<N>#, thus providing us with properly sized primitives in the codegenerator instead of pretending they are all full machine words. This came up when implementing darwinpcs for arm64. The darwinpcs reqires us to pack function argugments in excess of registers on the stack. While most procedure call standards (pcs) assume arguments are just passed in 8 byte slots; and thus the caller does not know the exact signature to make the call, darwinpcs requires us to adhere to the prototype, and thus have the correct sizes. If we specify CInt in the FFI call, it should correspond to the C int, and not just be Word sized, when it's only half the size. This does change the expected output of T16402 but the new result is no less correct as it eliminates the narrowing (instead of the `and` as was previously done). Bumps the array, bytestring, text, and binary submodules. Co-Authored-By: Ben Gamari <ben@well-typed.com> Metric Increase: T13701 T14697
-rw-r--r--compiler/GHC/Builtin/Names.hs5
-rw-r--r--compiler/GHC/Builtin/Types.hs8
-rw-r--r--compiler/GHC/Builtin/primops.txt.pp36
-rw-r--r--compiler/GHC/ByteCode/Asm.hs9
-rw-r--r--compiler/GHC/Cmm.hs6
-rw-r--r--compiler/GHC/Cmm/Expr.hs11
-rw-r--r--compiler/GHC/CmmToAsm/Ppr.hs14
-rw-r--r--compiler/GHC/CmmToC.hs193
-rw-r--r--compiler/GHC/Core.hs4
-rw-r--r--compiler/GHC/Core/Opt/ConstantFold.hs59
-rw-r--r--compiler/GHC/CoreToByteCode.hs57
-rw-r--r--compiler/GHC/HsToCore/Foreign/Call.hs32
-rw-r--r--compiler/GHC/HsToCore/Foreign/Decl.hs6
-rw-r--r--compiler/GHC/HsToCore/Quote.hs5
-rw-r--r--compiler/GHC/Runtime/Heap/Inspect.hs4
-rw-r--r--compiler/GHC/StgToCmm/DataCon.hs17
-rw-r--r--compiler/GHC/StgToCmm/Prim.hs26
-rw-r--r--compiler/GHC/StgToCmm/Utils.hs6
-rw-r--r--compiler/GHC/Types/Literal.hs211
-rw-r--r--compiler/GHC/Utils/Outputable.hs30
-rw-r--r--ghc/ghc-bin.cabal.in2
m---------libraries/array0
-rw-r--r--libraries/base/GHC/Float.hs4
-rw-r--r--libraries/base/GHC/IO/Encoding/CodePage.hs2
-rw-r--r--libraries/base/GHC/IO/Encoding/UTF16.hs5
-rw-r--r--libraries/base/GHC/IO/Encoding/UTF32.hs9
-rw-r--r--libraries/base/GHC/IO/Encoding/UTF8.hs35
-rw-r--r--libraries/base/GHC/Int.hs266
-rw-r--r--libraries/base/GHC/Storable.hs24
-rw-r--r--libraries/base/GHC/Word.hs268
-rw-r--r--libraries/base/base.cabal2
m---------libraries/binary0
m---------libraries/bytestring0
-rw-r--r--libraries/ghc-bignum/ghc-bignum.cabal2
-rw-r--r--libraries/ghc-compact/ghc-compact.cabal2
-rw-r--r--libraries/ghc-heap/ghc-heap.cabal.in2
-rw-r--r--libraries/ghc-prim/ghc-prim.cabal2
-rw-r--r--libraries/ghci/GHCi/BreakArray.hs18
-rw-r--r--libraries/ghci/ghci.cabal.in1
m---------libraries/text0
-rw-r--r--rts/Libdw.c5
-rw-r--r--testsuite/driver/testlib.py2
-rw-r--r--testsuite/tests/array/should_run/arr020.hs10
-rw-r--r--testsuite/tests/backpack/should_compile/bkp16.stderr2
-rw-r--r--testsuite/tests/codeGen/should_run/cgrun070.hs4
-rw-r--r--testsuite/tests/codeGen/should_run/cgrun072.hs4
-rw-r--r--testsuite/tests/codeGen/should_run/cgrun075.hs6
-rw-r--r--testsuite/tests/codeGen/should_run/cgrun076.hs6
-rw-r--r--testsuite/tests/codeGen/should_run/compareByteArrays.hs4
-rw-r--r--testsuite/tests/dependent/should_compile/T14729.stderr2
-rw-r--r--testsuite/tests/dependent/should_compile/T15743.stderr2
-rw-r--r--testsuite/tests/dependent/should_compile/T15743e.stderr2
-rw-r--r--testsuite/tests/ffi/should_run/T16650a.hs2
-rw-r--r--testsuite/tests/ffi/should_run/T16650b.hs2
-rw-r--r--testsuite/tests/ffi/should_run/UnliftedNewtypesByteArrayOffset.hs4
-rw-r--r--testsuite/tests/indexed-types/should_compile/T15711.stderr2
-rw-r--r--testsuite/tests/indexed-types/should_compile/T15852.stderr2
-rw-r--r--testsuite/tests/lib/integer/integerImportExport.hs4
-rw-r--r--testsuite/tests/numeric/should_compile/T16402.stderr-ws-32133
-rw-r--r--testsuite/tests/numeric/should_compile/T16402.stderr-ws-64 (renamed from testsuite/tests/numeric/should_compile/T16402.stderr)11
-rw-r--r--testsuite/tests/parser/should_run/BinaryLiterals2.hs3
-rw-r--r--testsuite/tests/polykinds/T15592.stderr2
-rw-r--r--testsuite/tests/polykinds/T15592b.stderr2
-rw-r--r--testsuite/tests/printer/T18052a.stderr5
-rw-r--r--testsuite/tests/profiling/should_run/T3001-2.hs5
-rw-r--r--testsuite/tests/simplCore/should_compile/T5359a.hs4
-rw-r--r--testsuite/tests/simplCore/should_compile/T8832.stdout11
-rw-r--r--testsuite/tests/simplCore/should_compile/T8832.stdout-ws-3212
-rw-r--r--testsuite/tests/simplCore/should_compile/T8832.stdout-ws-6411
-rw-r--r--testsuite/tests/typecheck/should_compile/T12763.stderr2
m---------utils/haddock0
71 files changed, 1067 insertions, 582 deletions
diff --git a/compiler/GHC/Builtin/Names.hs b/compiler/GHC/Builtin/Names.hs
index 881753f6f2..cf0f72c50f 100644
--- a/compiler/GHC/Builtin/Names.hs
+++ b/compiler/GHC/Builtin/Names.hs
@@ -336,7 +336,7 @@ basicKnownKeyNames
-- FFI primitive types that are not wired-in.
stablePtrTyConName, ptrTyConName, funPtrTyConName,
int8TyConName, int16TyConName, int32TyConName, int64TyConName,
- word16TyConName, word32TyConName, word64TyConName,
+ word8TyConName, word16TyConName, word32TyConName, word64TyConName,
-- Others
otherwiseIdName, inlineIdName,
@@ -1463,7 +1463,8 @@ int32TyConName = tcQual gHC_INT (fsLit "Int32") int32TyConKey
int64TyConName = tcQual gHC_INT (fsLit "Int64") int64TyConKey
-- Word module
-word16TyConName, word32TyConName, word64TyConName :: Name
+word8TyConName, word16TyConName, word32TyConName, word64TyConName :: Name
+word8TyConName = tcQual gHC_WORD (fsLit "Word8") word8TyConKey
word16TyConName = tcQual gHC_WORD (fsLit "Word16") word16TyConKey
word32TyConName = tcQual gHC_WORD (fsLit "Word32") word32TyConKey
word64TyConName = tcQual gHC_WORD (fsLit "Word64") word64TyConKey
diff --git a/compiler/GHC/Builtin/Types.hs b/compiler/GHC/Builtin/Types.hs
index 52febf72d2..d06bc4a12b 100644
--- a/compiler/GHC/Builtin/Types.hs
+++ b/compiler/GHC/Builtin/Types.hs
@@ -55,7 +55,7 @@ module GHC.Builtin.Types (
wordTyCon, wordDataCon, wordTyConName, wordTy,
-- * Word8
- word8TyCon, word8DataCon, word8TyConName, word8Ty,
+ word8TyCon, word8DataCon, word8Ty,
-- * List
listTyCon, listTyCon_RDR, listTyConName, listTyConKey,
@@ -251,7 +251,6 @@ wiredInTyCons = [ -- Units are not treated like other tuples, because they
, floatTyCon
, intTyCon
, wordTyCon
- , word8TyCon
, listTyCon
, orderingTyCon
, maybeTyCon
@@ -354,10 +353,9 @@ nothingDataConName = mkWiredInDataConName UserSyntax gHC_MAYBE (fsLit "Nothing")
justDataConName = mkWiredInDataConName UserSyntax gHC_MAYBE (fsLit "Just")
justDataConKey justDataCon
-wordTyConName, wordDataConName, word8TyConName, word8DataConName :: Name
+wordTyConName, wordDataConName, word8DataConName :: Name
wordTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "Word") wordTyConKey wordTyCon
wordDataConName = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "W#") wordDataConKey wordDataCon
-word8TyConName = mkWiredInTyConName UserSyntax gHC_WORD (fsLit "Word8") word8TyConKey word8TyCon
word8DataConName = mkWiredInDataConName UserSyntax gHC_WORD (fsLit "W8#") word8DataConKey word8DataCon
floatTyConName, floatDataConName, doubleTyConName, doubleDataConName :: Name
@@ -1641,7 +1639,7 @@ word8TyCon = pcTyCon word8TyConName
(NoSourceText, fsLit "HsWord8"))) []
[word8DataCon]
word8DataCon :: DataCon
-word8DataCon = pcDataCon word8DataConName [] [wordPrimTy] word8TyCon
+word8DataCon = pcDataCon word8DataConName [] [word8PrimTy] word8TyCon
floatTy :: Type
floatTy = mkTyConTy floatTyCon
diff --git a/compiler/GHC/Builtin/primops.txt.pp b/compiler/GHC/Builtin/primops.txt.pp
index ecc71baa69..364f4f0300 100644
--- a/compiler/GHC/Builtin/primops.txt.pp
+++ b/compiler/GHC/Builtin/primops.txt.pp
@@ -291,8 +291,8 @@ section "Int8#"
primtype Int8#
-primop Int8Extend "extendInt8#" GenPrimOp Int8# -> Int#
-primop Int8Narrow "narrowInt8#" GenPrimOp Int# -> Int8#
+primop Int8ExtendOp "extendInt8#" GenPrimOp Int8# -> Int#
+primop Int8NarrowOp "narrowInt8#" GenPrimOp Int# -> Int8#
primop Int8NegOp "negateInt8#" GenPrimOp Int8# -> Int8#
@@ -332,8 +332,8 @@ section "Word8#"
primtype Word8#
-primop Word8Extend "extendWord8#" GenPrimOp Word8# -> Word#
-primop Word8Narrow "narrowWord8#" GenPrimOp Word# -> Word8#
+primop Word8ExtendOp "extendWord8#" GenPrimOp Word8# -> Word#
+primop Word8NarrowOp "narrowWord8#" GenPrimOp Word# -> Word8#
primop Word8NotOp "notWord8#" GenPrimOp Word8# -> Word8#
@@ -373,8 +373,8 @@ section "Int16#"
primtype Int16#
-primop Int16Extend "extendInt16#" GenPrimOp Int16# -> Int#
-primop Int16Narrow "narrowInt16#" GenPrimOp Int# -> Int16#
+primop Int16ExtendOp "extendInt16#" GenPrimOp Int16# -> Int#
+primop Int16NarrowOp "narrowInt16#" GenPrimOp Int# -> Int16#
primop Int16NegOp "negateInt16#" GenPrimOp Int16# -> Int16#
@@ -414,8 +414,8 @@ section "Word16#"
primtype Word16#
-primop Word16Extend "extendWord16#" GenPrimOp Word16# -> Word#
-primop Word16Narrow "narrowWord16#" GenPrimOp Word# -> Word16#
+primop Word16ExtendOp "extendWord16#" GenPrimOp Word16# -> Word#
+primop Word16NarrowOp "narrowWord16#" GenPrimOp Word# -> Word16#
primop Word16NotOp "notWord16#" GenPrimOp Word16# -> Word16#
@@ -448,6 +448,26 @@ primop Word16LeOp "leWord16#" Compare Word16# -> Word16# -> Int#
primop Word16LtOp "ltWord16#" Compare Word16# -> Word16# -> Int#
primop Word16NeOp "neWord16#" Compare Word16# -> Word16# -> Int#
+------------------------------------------------------------------------
+section "Int32#"
+ {Operations on 32-bit integers.}
+------------------------------------------------------------------------
+
+primtype Int32#
+
+primop Int32ExtendOp "extendInt32#" GenPrimOp Int32# -> Int#
+primop Int32NarrowOp "narrowInt32#" GenPrimOp Int# -> Int32#
+
+------------------------------------------------------------------------
+section "Word32#"
+ {Operations on 32-bit unsigned integers.}
+------------------------------------------------------------------------
+
+primtype Word32#
+
+primop Word32ExtendOp "extendWord32#" GenPrimOp Word32# -> Word#
+primop Word32NarrowOp "narrowWord32#" GenPrimOp Word# -> Word32#
+
#if WORD_SIZE_IN_BITS < 64
------------------------------------------------------------------------
section "Int64#"
diff --git a/compiler/GHC/ByteCode/Asm.hs b/compiler/GHC/ByteCode/Asm.hs
index 92255f9ea0..ff8bacd6cc 100644
--- a/compiler/GHC/ByteCode/Asm.hs
+++ b/compiler/GHC/ByteCode/Asm.hs
@@ -464,6 +464,12 @@ assembleI platform i = case i of
literal (LitNumber nt i) = case nt of
LitNumInt -> int (fromIntegral i)
LitNumWord -> int (fromIntegral i)
+ LitNumInt8 -> int8 (fromIntegral i)
+ LitNumWord8 -> int8 (fromIntegral i)
+ LitNumInt16 -> int16 (fromIntegral i)
+ LitNumWord16 -> int16 (fromIntegral i)
+ LitNumInt32 -> int32 (fromIntegral i)
+ LitNumWord32 -> int32 (fromIntegral i)
LitNumInt64 -> int64 (fromIntegral i)
LitNumWord64 -> int64 (fromIntegral i)
LitNumInteger -> panic "GHC.ByteCode.Asm.literal: LitNumInteger"
@@ -478,6 +484,9 @@ assembleI platform i = case i of
float = words . mkLitF
double = words . mkLitD platform
int = words . mkLitI
+ int8 = words . mkLitI64 platform
+ int16 = words . mkLitI64 platform
+ int32 = words . mkLitI64 platform
int64 = words . mkLitI64 platform
words ws = lit (map BCONPtrWord ws)
word w = words [w]
diff --git a/compiler/GHC/Cmm.hs b/compiler/GHC/Cmm.hs
index 5c4c619b69..3a461fa03c 100644
--- a/compiler/GHC/Cmm.hs
+++ b/compiler/GHC/Cmm.hs
@@ -228,6 +228,12 @@ data CmmStatic
| CmmFileEmbed FilePath
-- ^ an embedded binary file
+instance Outputable CmmStatic where
+ ppr (CmmStaticLit lit) = text "CmmStaticLit" <+> ppr lit
+ ppr (CmmUninitialised n) = text "CmmUninitialised" <+> ppr n
+ ppr (CmmString _) = text "CmmString"
+ ppr (CmmFileEmbed fp) = text "CmmFileEmbed" <+> text fp
+
-- Static data before SRT generation
data GenCmmStatics (rawOnly :: Bool) where
CmmStatics
diff --git a/compiler/GHC/Cmm/Expr.hs b/compiler/GHC/Cmm/Expr.hs
index 08ab27c410..e1251c6c27 100644
--- a/compiler/GHC/Cmm/Expr.hs
+++ b/compiler/GHC/Cmm/Expr.hs
@@ -39,6 +39,7 @@ import GHC.Cmm.CLabel
import GHC.Cmm.MachOp
import GHC.Cmm.Type
import GHC.Utils.Panic (panic)
+import GHC.Utils.Outputable
import GHC.Types.Unique
import Data.Set (Set)
@@ -210,6 +211,16 @@ data CmmLit
-- of bytes used
deriving Eq
+instance Outputable CmmLit where
+ ppr (CmmInt n w) = text "CmmInt" <+> ppr n <+> ppr w
+ ppr (CmmFloat n w) = text "CmmFloat" <+> text (show n) <+> ppr w
+ ppr (CmmVec xs) = text "CmmVec" <+> ppr xs
+ ppr (CmmLabel _) = text "CmmLabel"
+ ppr (CmmLabelOff _ _) = text "CmmLabelOff"
+ ppr (CmmLabelDiffOff _ _ _ _) = text "CmmLabelDiffOff"
+ ppr (CmmBlock blk) = text "CmmBlock" <+> ppr blk
+ ppr CmmHighStackMark = text "CmmHighStackMark"
+
cmmExprType :: Platform -> CmmExpr -> CmmType
cmmExprType platform = \case
(CmmLit lit) -> cmmLitType platform lit
diff --git a/compiler/GHC/CmmToAsm/Ppr.hs b/compiler/GHC/CmmToAsm/Ppr.hs
index da99a0db07..a3606219da 100644
--- a/compiler/GHC/CmmToAsm/Ppr.hs
+++ b/compiler/GHC/CmmToAsm/Ppr.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE CPP, MagicHash #-}
-----------------------------------------------------------------------------
--
@@ -38,9 +38,17 @@ import Data.Word
import Data.Bits
import Data.ByteString (ByteString)
import qualified Data.ByteString as BS
-import GHC.Exts
+import GHC.Exts hiding (extendWord8#)
import GHC.Word
+#if MIN_VERSION_base(4,16,0)
+import GHC.Base (extendWord8#)
+#else
+extendWord8# :: Word# -> Word#
+extendWord8# w = w
+{-# INLINE extendWord8# #-}
+#endif
+
-- -----------------------------------------------------------------------------
-- Converting floating-point literals to integrals for printing
@@ -103,7 +111,7 @@ pprASCII str
-- we know that the Chars we create are in the ASCII range
-- so we bypass the check in "chr"
chr' :: Word8 -> Char
- chr' (W8# w#) = C# (chr# (word2Int# w#))
+ chr' (W8# w#) = C# (chr# (word2Int# (extendWord8# w#)))
octal :: Word8 -> String
octal w = [ chr' (ord0 + (w `unsafeShiftR` 6) .&. 0x07)
diff --git a/compiler/GHC/CmmToC.hs b/compiler/GHC/CmmToC.hs
index d1f722febd..0733369679 100644
--- a/compiler/GHC/CmmToC.hs
+++ b/compiler/GHC/CmmToC.hs
@@ -159,8 +159,14 @@ pprWordArray platform is_ro lbl ds
-- See Note [StgWord alignment]
, pprAlignment (wordWidth platform)
, text "= {" ]
- $$ nest 8 (commafy (pprStatics platform ds))
+ $$ nest 8 (commafy (staticLitsToWords platform $ toLits ds))
$$ text "};"
+ where
+ toLits :: [CmmStatic] -> [CmmLit]
+ toLits = map f
+ where
+ f (CmmStaticLit lit) = lit
+ f static = pprPanic "pprWordArray: Unexpected literal" (pprStatic platform static)
pprAlignment :: Width -> SDoc
pprAlignment words =
@@ -501,59 +507,69 @@ pprLit1 platform lit = case lit of
-- ---------------------------------------------------------------------------
-- Static data
-pprStatics :: Platform -> [CmmStatic] -> [SDoc]
-pprStatics platform = pprStatics'
+-- | Produce a list of word sized literals encoding the given list of 'CmmLit's.
+staticLitsToWords :: Platform -> [CmmLit] -> [SDoc]
+staticLitsToWords platform = go . foldMap decomposeMultiWord
where
- pprStatics' = \case
- [] -> []
- (CmmStaticLit (CmmFloat f W32) : rest)
- -- odd numbers of floats are padded to a word by mkVirtHeapOffsetsWithPadding
- | wordWidth platform == W64, CmmStaticLit (CmmInt 0 W32) : rest' <- rest
- -> pprLit1 platform (floatToWord platform f) : pprStatics' rest'
- -- adjacent floats aren't padded but combined into a single word
- | wordWidth platform == W64, CmmStaticLit (CmmFloat g W32) : rest' <- rest
- -> pprLit1 platform (floatPairToWord platform f g) : pprStatics' rest'
- | wordWidth platform == W32
- -> pprLit1 platform (floatToWord platform f) : pprStatics' rest
- | otherwise
- -> pprPanic "pprStatics: float" (vcat (map ppr' rest))
- where ppr' (CmmStaticLit l) = ppr (cmmLitType platform l)
- ppr' _other = text "bad static!"
-
- (CmmStaticLit (CmmFloat f W64) : rest)
- -> map (pprLit1 platform) (doubleToWords platform f) ++ pprStatics' rest
-
- (CmmStaticLit (CmmInt i W64) : rest)
- | wordWidth platform == W32
- -> case platformByteOrder platform of
- BigEndian -> pprStatics' (CmmStaticLit (CmmInt q W32) :
- CmmStaticLit (CmmInt r W32) : rest)
- LittleEndian -> pprStatics' (CmmStaticLit (CmmInt r W32) :
- CmmStaticLit (CmmInt q W32) : rest)
- where r = i .&. 0xffffffff
- q = i `shiftR` 32
-
- (CmmStaticLit (CmmInt a W32) : CmmStaticLit (CmmInt b W32) : rest)
- | wordWidth platform == W64
- -> case platformByteOrder platform of
- BigEndian -> pprStatics' (CmmStaticLit (CmmInt ((shiftL a 32) .|. b) W64) : rest)
- LittleEndian -> pprStatics' (CmmStaticLit (CmmInt ((shiftL b 32) .|. a) W64) : rest)
-
- (CmmStaticLit (CmmInt a W16) : CmmStaticLit (CmmInt b W16) : rest)
- | wordWidth platform == W32
- -> case platformByteOrder platform of
- BigEndian -> pprStatics' (CmmStaticLit (CmmInt ((shiftL a 16) .|. b) W32) : rest)
- LittleEndian -> pprStatics' (CmmStaticLit (CmmInt ((shiftL b 16) .|. a) W32) : rest)
-
- (CmmStaticLit (CmmInt _ w) : _)
- | w /= wordWidth platform
- -> pprPanic "pprStatics: cannot emit a non-word-sized static literal" (ppr w)
-
- (CmmStaticLit lit : rest)
- -> pprLit1 platform lit : pprStatics' rest
-
- (other : _)
- -> pprPanic "pprStatics: other" (pprStatic platform other)
+ -- rem_bytes is how many bytes remain in the word we are currently filling.
+ -- accum is the word we are filling.
+ go :: [CmmLit] -> [SDoc]
+ go [] = []
+ go lits@(lit : _)
+ | Just _ <- isSubWordLit lit
+ = goSubWord wordWidthBytes 0 lits
+ go (lit : rest)
+ = pprLit1 platform lit : go rest
+
+ goSubWord :: Int -> Integer -> [CmmLit] -> [SDoc]
+ goSubWord rem_bytes accum (lit : rest)
+ | Just (bytes, w) <- isSubWordLit lit
+ , rem_bytes >= widthInBytes w
+ = let accum' =
+ case platformByteOrder platform of
+ BigEndian -> (accum `shiftL` widthInBits w) .|. bytes
+ LittleEndian -> (accum `shiftL` widthInBits w) .|. byteSwap w bytes
+ in goSubWord (rem_bytes - widthInBytes w) accum' rest
+ goSubWord rem_bytes accum rest
+ = pprWord (byteSwap (wordWidth platform) $ accum `shiftL` (8*rem_bytes)) : go rest
+
+ -- Decompose multi-word or floating-point literals into multiple
+ -- single-word (or smaller) literals.
+ decomposeMultiWord :: CmmLit -> [CmmLit]
+ decomposeMultiWord (CmmFloat n W64)
+ -- This will produce a W64 integer, which will then be broken up further
+ -- on the next iteration on 32-bit platforms.
+ = [doubleToWord64 n]
+ decomposeMultiWord (CmmFloat n W32)
+ = [floatToWord32 n]
+ decomposeMultiWord (CmmInt n W64)
+ | W32 <- wordWidth platform
+ = [CmmInt hi W32, CmmInt lo W32]
+ where
+ hi = n `shiftR` 32
+ lo = n .&. 0xffffffff
+ decomposeMultiWord lit = [lit]
+
+ -- Decompose a sub-word-sized literal into the integer value and its
+ -- (sub-word-sized) width.
+ isSubWordLit :: CmmLit -> Maybe (Integer, Width)
+ isSubWordLit lit =
+ case lit of
+ CmmInt n w
+ | w < wordWidth platform -> Just (n, w)
+ _ -> Nothing
+
+ wordWidthBytes = widthInBytes $ wordWidth platform
+
+ pprWord :: Integer -> SDoc
+ pprWord n = pprHexVal platform n (wordWidth platform)
+
+byteSwap :: Width -> Integer -> Integer
+byteSwap width n = foldl' f 0 bytes
+ where
+ f acc m = (acc `shiftL` 8) .|. m
+ bytes = [ byte i | i <- [0..widthInBytes width - 1] ]
+ byte i = (n `shiftR` (i*8)) .&. 0xff
pprStatic :: Platform -> CmmStatic -> SDoc
pprStatic platform s = case s of
@@ -1252,69 +1268,30 @@ pprStringInCStyle s = doubleQuotes (text (concatMap charToC (BS.unpack s)))
-- This is a hack to turn the floating point numbers into ints that we
-- can safely initialise to static locations.
-castFloatToWord32Array :: STUArray s Int Float -> ST s (STUArray s Int Word32)
-castFloatToWord32Array = U.castSTUArray
-
-castDoubleToWord64Array :: STUArray s Int Double -> ST s (STUArray s Int Word64)
-castDoubleToWord64Array = U.castSTUArray
-
-floatToWord :: Platform -> Rational -> CmmLit
-floatToWord platform r
- = runST (do
+floatToWord32 :: Rational -> CmmLit
+floatToWord32 r
+ = runST $ do
arr <- newArray_ ((0::Int),0)
writeArray arr 0 (fromRational r)
arr' <- castFloatToWord32Array arr
w32 <- readArray arr' 0
- return (CmmInt (toInteger w32 `shiftL` wo) (wordWidth platform))
- )
- where wo | wordWidth platform == W64
- , BigEndian <- platformByteOrder platform
- = 32
- | otherwise
- = 0
-
-floatPairToWord :: Platform -> Rational -> Rational -> CmmLit
-floatPairToWord platform r1 r2
- = runST (do
- arr <- newArray_ ((0::Int),1)
- writeArray arr 0 (fromRational r1)
- writeArray arr 1 (fromRational r2)
- arr' <- castFloatToWord32Array arr
- w32_1 <- readArray arr' 0
- w32_2 <- readArray arr' 1
- return (pprWord32Pair w32_1 w32_2)
- )
- where pprWord32Pair w32_1 w32_2
- | BigEndian <- platformByteOrder platform =
- CmmInt ((shiftL i1 32) .|. i2) W64
- | otherwise =
- CmmInt ((shiftL i2 32) .|. i1) W64
- where i1 = toInteger w32_1
- i2 = toInteger w32_2
-
-doubleToWords :: Platform -> Rational -> [CmmLit]
-doubleToWords platform r
- = runST (do
+ return (CmmInt (toInteger w32) W32)
+ where
+ castFloatToWord32Array :: STUArray s Int Float -> ST s (STUArray s Int Word32)
+ castFloatToWord32Array = U.castSTUArray
+
+doubleToWord64 :: Rational -> CmmLit
+doubleToWord64 r
+ = runST $ do
arr <- newArray_ ((0::Int),1)
writeArray arr 0 (fromRational r)
arr' <- castDoubleToWord64Array arr
w64 <- readArray arr' 0
- return (pprWord64 w64)
- )
- where targetWidth = wordWidth platform
- pprWord64 w64
- | targetWidth == W64 =
- [ CmmInt (toInteger w64) targetWidth ]
- | targetWidth == W32 =
- [ CmmInt (toInteger targetW1) targetWidth
- , CmmInt (toInteger targetW2) targetWidth
- ]
- | otherwise = panic "doubleToWords.pprWord64"
- where (targetW1, targetW2) = case platformByteOrder platform of
- BigEndian -> (wHi, wLo)
- LittleEndian -> (wLo, wHi)
- wHi = w64 `shiftR` 32
- wLo = w64 .&. 0xFFFFffff
+ return $ CmmInt (toInteger w64) W64
+ where
+ castDoubleToWord64Array :: STUArray s Int Double -> ST s (STUArray s Int Word64)
+ castDoubleToWord64Array = U.castSTUArray
+
-- ---------------------------------------------------------------------------
-- Utils
diff --git a/compiler/GHC/Core.hs b/compiler/GHC/Core.hs
index 57976e836a..523c8e3d79 100644
--- a/compiler/GHC/Core.hs
+++ b/compiler/GHC/Core.hs
@@ -29,6 +29,7 @@ module GHC.Core (
mkIntLit, mkIntLitWrap,
mkWordLit, mkWordLitWrap,
+ mkWord8Lit,
mkWord64LitWord64, mkInt64LitInt64,
mkCharLit, mkStringLit,
mkFloatLit, mkFloatLitFloat,
@@ -1997,6 +1998,9 @@ mkWordLit platform w = Lit (mkLitWord platform w)
mkWordLitWrap :: Platform -> Integer -> Expr b
mkWordLitWrap platform w = Lit (mkLitWordWrap platform w)
+mkWord8Lit :: Integer -> Expr b
+mkWord8Lit w = Lit (mkLitWord8 w)
+
mkWord64LitWord64 :: Word64 -> Expr b
mkWord64LitWord64 w = Lit (mkLitWord64 (toInteger w))
diff --git a/compiler/GHC/Core/Opt/ConstantFold.hs b/compiler/GHC/Core/Opt/ConstantFold.hs
index e02a470d7e..8eb920cdc9 100644
--- a/compiler/GHC/Core/Opt/ConstantFold.hs
+++ b/compiler/GHC/Core/Opt/ConstantFold.hs
@@ -198,6 +198,46 @@ primOpRules nm = \case
SrlOp -> mkPrimOpRule nm 2 [ shiftRule LitNumWord shiftRightLogical ]
-- coercions
+
+ Int8ExtendOp -> mkPrimOpRule nm 1 [ liftLitPlatform extendIntLit ]
+ Int16ExtendOp -> mkPrimOpRule nm 1 [ liftLitPlatform extendIntLit ]
+ Int32ExtendOp -> mkPrimOpRule nm 1 [ liftLitPlatform extendIntLit ]
+ Int8NarrowOp -> mkPrimOpRule nm 1 [ liftLit narrowInt8Lit
+ , subsumedByPrimOp Int8NarrowOp
+ , narrowSubsumesAnd AndIOp Int8NarrowOp 8 ]
+ Int16NarrowOp -> mkPrimOpRule nm 1 [ liftLit narrowInt16Lit
+ , subsumedByPrimOp Int8NarrowOp
+ , subsumedByPrimOp Int16NarrowOp
+ , narrowSubsumesAnd AndIOp Int16NarrowOp 16 ]
+ Int32NarrowOp -> mkPrimOpRule nm 1 [ liftLit narrowInt32Lit
+ , subsumedByPrimOp Int8NarrowOp
+ , subsumedByPrimOp Int16NarrowOp
+ , subsumedByPrimOp Int32NarrowOp
+ , narrowSubsumesAnd AndIOp Int32NarrowOp 32 ]
+
+ Word8ExtendOp -> mkPrimOpRule nm 1 [ liftLitPlatform extendWordLit
+ , extendNarrowPassthrough Word8NarrowOp 0xFF
+ ]
+ Word16ExtendOp -> mkPrimOpRule nm 1 [ liftLitPlatform extendWordLit
+ , extendNarrowPassthrough Word16NarrowOp 0xFFFF
+ ]
+ Word32ExtendOp -> mkPrimOpRule nm 1 [ liftLitPlatform extendWordLit
+ , extendNarrowPassthrough Word32NarrowOp 0xFFFFFFFF
+ ]
+ Word8NarrowOp -> mkPrimOpRule nm 1 [ liftLit narrowWord8Lit
+ , subsumedByPrimOp Word8NarrowOp
+ , narrowSubsumesAnd AndOp Word8NarrowOp 8 ]
+ Word16NarrowOp -> mkPrimOpRule nm 1 [ liftLit narrowWord16Lit
+ , subsumedByPrimOp Word8NarrowOp
+ , subsumedByPrimOp Word16NarrowOp
+ , narrowSubsumesAnd AndOp Word16NarrowOp 16 ]
+ Word32NarrowOp -> mkPrimOpRule nm 1 [ liftLit narrowWord32Lit
+ , subsumedByPrimOp Word8NarrowOp
+ , subsumedByPrimOp Word16NarrowOp
+ , subsumedByPrimOp Word32NarrowOp
+ , narrowSubsumesAnd AndOp Word32NarrowOp 32 ]
+
+
WordToIntOp -> mkPrimOpRule nm 1 [ liftLitPlatform wordToIntLit
, inversePrimOp IntToWordOp ]
IntToWordOp -> mkPrimOpRule nm 1 [ liftLitPlatform intToWordLit
@@ -625,8 +665,14 @@ isMinBound :: Platform -> Literal -> Bool
isMinBound _ (LitChar c) = c == minBound
isMinBound platform (LitNumber nt i) = case nt of
LitNumInt -> i == platformMinInt platform
+ LitNumInt8 -> i == toInteger (minBound :: Int8)
+ LitNumInt16 -> i == toInteger (minBound :: Int16)
+ LitNumInt32 -> i == toInteger (minBound :: Int32)
LitNumInt64 -> i == toInteger (minBound :: Int64)
LitNumWord -> i == 0
+ LitNumWord8 -> i == 0
+ LitNumWord16 -> i == 0
+ LitNumWord32 -> i == 0
LitNumWord64 -> i == 0
LitNumNatural -> i == 0
LitNumInteger -> False
@@ -636,8 +682,14 @@ isMaxBound :: Platform -> Literal -> Bool
isMaxBound _ (LitChar c) = c == maxBound
isMaxBound platform (LitNumber nt i) = case nt of
LitNumInt -> i == platformMaxInt platform
+ LitNumInt8 -> i == toInteger (maxBound :: Int8)
+ LitNumInt16 -> i == toInteger (maxBound :: Int16)
+ LitNumInt32 -> i == toInteger (maxBound :: Int32)
LitNumInt64 -> i == toInteger (maxBound :: Int64)
LitNumWord -> i == platformMaxWord platform
+ LitNumWord8 -> i == toInteger (maxBound :: Word8)
+ LitNumWord16 -> i == toInteger (maxBound :: Word16)
+ LitNumWord32 -> i == toInteger (maxBound :: Word32)
LitNumWord64 -> i == toInteger (maxBound :: Word64)
LitNumNatural -> False
LitNumInteger -> False
@@ -697,6 +749,13 @@ subsumedByPrimOp primop = do
matchPrimOpId primop primop_id
return e
+-- | Transform `extendWordN (narrowWordN x)` into `x .&. 0xFF..FF`
+extendNarrowPassthrough :: PrimOp -> Integer -> RuleM CoreExpr
+extendNarrowPassthrough narrow_primop n = do
+ [Var primop_id `App` x] <- getArgs
+ matchPrimOpId narrow_primop primop_id
+ return (Var (mkPrimOpId AndOp) `App` x `App` Lit (LitNumber LitNumWord n))
+
-- | narrow subsumes bitwise `and` with full mask (cf #16402):
--
-- narrowN (x .&. m)
diff --git a/compiler/GHC/CoreToByteCode.hs b/compiler/GHC/CoreToByteCode.hs
index f8cb9737d9..96c7ea9dec 100644
--- a/compiler/GHC/CoreToByteCode.hs
+++ b/compiler/GHC/CoreToByteCode.hs
@@ -1387,6 +1387,12 @@ primRepToFFIType platform r
VoidRep -> FFIVoid
IntRep -> signed_word
WordRep -> unsigned_word
+ Int8Rep -> FFISInt8
+ Word8Rep -> FFIUInt8
+ Int16Rep -> FFISInt16
+ Word16Rep -> FFIUInt16
+ Int32Rep -> FFISInt32
+ Word32Rep -> FFIUInt32
Int64Rep -> FFISInt64
Word64Rep -> FFIUInt64
AddrRep -> FFIPointer
@@ -1405,6 +1411,12 @@ mkDummyLiteral platform pr
= case pr of
IntRep -> mkLitInt platform 0
WordRep -> mkLitWord platform 0
+ Int8Rep -> mkLitInt8 0
+ Word8Rep -> mkLitWord8 0
+ Int16Rep -> mkLitInt16 0
+ Word16Rep -> mkLitWord16 0
+ Int32Rep -> mkLitInt32 0
+ Word32Rep -> mkLitWord32 0
Int64Rep -> mkLitInt64 0
Word64Rep -> mkLitWord64 0
AddrRep -> LitNullAddr
@@ -1621,24 +1633,39 @@ pushAtom d p (AnnVar var)
pushAtom _ _ (AnnLit lit) = do
platform <- targetPlatform <$> getDynFlags
- let code rep
- = let size_words = WordOff (argRepSizeW platform rep)
- in return (unitOL (PUSH_UBX lit (trunc16W size_words)),
- wordsToBytes platform size_words)
+ let code :: PrimRep -> BcM (BCInstrList, ByteOff)
+ code rep =
+ return (unitOL instr, size_bytes)
+ where
+ size_bytes = ByteOff $ primRepSizeB platform rep
+ -- Here we handle the non-word-width cases specifically since we
+ -- must emit different bytecode for them.
+ instr =
+ case size_bytes of
+ 1 -> PUSH_UBX8 lit
+ 2 -> PUSH_UBX16 lit
+ 4 -> PUSH_UBX32 lit
+ _ -> PUSH_UBX lit (trunc16W $ bytesToWords platform size_bytes)
case lit of
- LitLabel _ _ _ -> code N
- LitFloat _ -> code F
- LitDouble _ -> code D
- LitChar _ -> code N
- LitNullAddr -> code N
- LitString _ -> code N
- LitRubbish -> code N
+ LitLabel _ _ _ -> code AddrRep
+ LitFloat _ -> code FloatRep
+ LitDouble _ -> code DoubleRep
+ LitChar _ -> code WordRep
+ LitNullAddr -> code AddrRep
+ LitString _ -> code AddrRep
+ LitRubbish -> code WordRep
LitNumber nt _ -> case nt of
- LitNumInt -> code N
- LitNumWord -> code N
- LitNumInt64 -> code L
- LitNumWord64 -> code L
+ LitNumInt -> code IntRep
+ LitNumWord -> code WordRep
+ LitNumInt8 -> code Int8Rep
+ LitNumWord8 -> code Word8Rep
+ LitNumInt16 -> code Int16Rep
+ LitNumWord16 -> code Word16Rep
+ LitNumInt32 -> code Int32Rep
+ LitNumWord32 -> code Word32Rep
+ LitNumInt64 -> code Int64Rep
+ LitNumWord64 -> code Word64Rep
-- No LitInteger's or LitNatural's should be left by the time this is
-- called. CorePrep should have converted them all to a real core
-- representation.
diff --git a/compiler/GHC/HsToCore/Foreign/Call.hs b/compiler/GHC/HsToCore/Foreign/Call.hs
index e580057b77..f28d476c05 100644
--- a/compiler/GHC/HsToCore/Foreign/Call.hs
+++ b/compiler/GHC/HsToCore/Foreign/Call.hs
@@ -21,9 +21,7 @@ where
#include "HsVersions.h"
-
import GHC.Prelude
-import GHC.Platform
import GHC.Core
@@ -41,7 +39,6 @@ import GHC.Core.Type
import GHC.Core.Multiplicity
import GHC.Types.Id ( Id )
import GHC.Core.Coercion
-import GHC.Builtin.PrimOps
import GHC.Builtin.Types.Prim
import GHC.Core.TyCon
import GHC.Builtin.Types
@@ -355,36 +352,13 @@ resultWrapper result_ty
| Just (tycon, tycon_arg_tys) <- maybe_tc_app
, Just data_con <- isDataProductTyCon_maybe tycon -- One constructor, no existentials
, [Scaled _ unwrapped_res_ty] <- dataConInstOrigArgTys data_con tycon_arg_tys -- One argument
- = do { dflags <- getDynFlags
- ; let platform = targetPlatform dflags
- ; (maybe_ty, wrapper) <- resultWrapper unwrapped_res_ty
- ; let narrow_wrapper = maybeNarrow platform tycon
- marshal_con e = Var (dataConWrapId data_con)
+ = do { (maybe_ty, wrapper) <- resultWrapper unwrapped_res_ty
+ ; let marshal_con e = Var (dataConWrapId data_con)
`mkTyApps` tycon_arg_tys
- `App` wrapper (narrow_wrapper e)
+ `App` wrapper e
; return (maybe_ty, marshal_con) }
| otherwise
= pprPanic "resultWrapper" (ppr result_ty)
where
maybe_tc_app = splitTyConApp_maybe result_ty
-
--- When the result of a foreign call is smaller than the word size, we
--- need to sign- or zero-extend the result up to the word size. The C
--- standard appears to say that this is the responsibility of the
--- caller, not the callee.
-
-maybeNarrow :: Platform -> TyCon -> (CoreExpr -> CoreExpr)
-maybeNarrow platform tycon
- | tycon `hasKey` int8TyConKey = \e -> App (Var (mkPrimOpId Narrow8IntOp)) e
- | tycon `hasKey` int16TyConKey = \e -> App (Var (mkPrimOpId Narrow16IntOp)) e
- | tycon `hasKey` int32TyConKey
- , platformWordSizeInBytes platform > 4
- = \e -> App (Var (mkPrimOpId Narrow32IntOp)) e
-
- | tycon `hasKey` word8TyConKey = \e -> App (Var (mkPrimOpId Narrow8WordOp)) e
- | tycon `hasKey` word16TyConKey = \e -> App (Var (mkPrimOpId Narrow16WordOp)) e
- | tycon `hasKey` word32TyConKey
- , platformWordSizeInBytes platform > 4
- = \e -> App (Var (mkPrimOpId Narrow32WordOp)) e
- | otherwise = id
diff --git a/compiler/GHC/HsToCore/Foreign/Decl.hs b/compiler/GHC/HsToCore/Foreign/Decl.hs
index cae1d3f115..1dea63982f 100644
--- a/compiler/GHC/HsToCore/Foreign/Decl.hs
+++ b/compiler/GHC/HsToCore/Foreign/Decl.hs
@@ -849,6 +849,12 @@ primTyDescChar platform ty
= case typePrimRep1 (getPrimTyOf ty) of
IntRep -> signed_word
WordRep -> unsigned_word
+ Int8Rep -> 'B'
+ Word8Rep -> 'b'
+ Int16Rep -> 'S'
+ Word16Rep -> 's'
+ Int32Rep -> 'W'
+ Word32Rep -> 'w'
Int64Rep -> 'L'
Word64Rep -> 'l'
AddrRep -> 'p'
diff --git a/compiler/GHC/HsToCore/Quote.hs b/compiler/GHC/HsToCore/Quote.hs
index 16d17fd82e..7f2d0b5d85 100644
--- a/compiler/GHC/HsToCore/Quote.hs
+++ b/compiler/GHC/HsToCore/Quote.hs
@@ -2784,11 +2784,10 @@ repTyVarSig (MkC bndr) = rep2 tyVarSigName [bndr]
repLiteral :: HsLit GhcRn -> MetaM (Core TH.Lit)
repLiteral (HsStringPrim _ bs)
- = do platform <- getPlatform
- word8_ty <- lookupType word8TyConName
+ = do word8_ty <- lookupType word8TyConName
let w8s = unpack bs
w8s_expr = map (\w8 -> mkCoreConApps word8DataCon
- [mkWordLit platform (toInteger w8)]) w8s
+ [mkWord8Lit (toInteger w8)]) w8s
rep2_nw stringPrimLName [mkListExpr word8_ty w8s_expr]
repLiteral lit
= do lit' <- case lit of
diff --git a/compiler/GHC/Runtime/Heap/Inspect.hs b/compiler/GHC/Runtime/Heap/Inspect.hs
index 1b912339e5..d5758cdfbd 100644
--- a/compiler/GHC/Runtime/Heap/Inspect.hs
+++ b/compiler/GHC/Runtime/Heap/Inspect.hs
@@ -467,6 +467,10 @@ repPrim t = rep where
| t == wordPrimTyCon = text $ show (build x :: Word)
| t == floatPrimTyCon = text $ show (build x :: Float)
| t == doublePrimTyCon = text $ show (build x :: Double)
+ | t == int8PrimTyCon = text $ show (build x :: Int8)
+ | t == word8PrimTyCon = text $ show (build x :: Word8)
+ | t == int16PrimTyCon = text $ show (build x :: Int16)
+ | t == word16PrimTyCon = text $ show (build x :: Word16)
| t == int32PrimTyCon = text $ show (build x :: Int32)
| t == word32PrimTyCon = text $ show (build x :: Word32)
| t == int64PrimTyCon = text $ show (build x :: Int64)
diff --git a/compiler/GHC/StgToCmm/DataCon.hs b/compiler/GHC/StgToCmm/DataCon.hs
index 681f1461f1..18a8775cdd 100644
--- a/compiler/GHC/StgToCmm/DataCon.hs
+++ b/compiler/GHC/StgToCmm/DataCon.hs
@@ -102,6 +102,21 @@ cgTopRhsCon dflags id con args
nv_args_w_offsets) =
mkVirtHeapOffsetsWithPadding profile StdHeader (addArgReps args)
+ ; let
+ -- Decompose padding into units of length 8, 4, 2, or 1 bytes to
+ -- allow the implementation of mk_payload to use widthFromBytes,
+ -- which only handles these cases.
+ fix_padding (x@(Padding n off) : rest)
+ | n == 0 = fix_padding rest
+ | n `elem` [1,2,4,8] = x : fix_padding rest
+ | n > 8 = add_pad 8
+ | n > 4 = add_pad 4
+ | n > 2 = add_pad 2
+ | otherwise = add_pad 1
+ where add_pad m = Padding m off : fix_padding (Padding (n-m) (off+m) : rest)
+ fix_padding (x : rest) = x : fix_padding rest
+ fix_padding [] = []
+
mk_payload (Padding len _) = return (CmmInt 0 (widthFromBytes len))
mk_payload (FieldOff arg _) = do
amode <- getArgAmode arg
@@ -117,7 +132,7 @@ cgTopRhsCon dflags id con args
info_tbl = mkDataConInfoTable profile con True ptr_wds nonptr_wds
- ; payload <- mapM mk_payload nv_args_w_offsets
+ ; payload <- mapM mk_payload (fix_padding nv_args_w_offsets)
-- NB1: nv_args_w_offsets is sorted into ptrs then non-ptrs
-- NB2: all the amodes should be Lits!
-- TODO (osa): Why?
diff --git a/compiler/GHC/StgToCmm/Prim.hs b/compiler/GHC/StgToCmm/Prim.hs
index 625e76f085..4d13d3960c 100644
--- a/compiler/GHC/StgToCmm/Prim.hs
+++ b/compiler/GHC/StgToCmm/Prim.hs
@@ -1195,8 +1195,8 @@ emitPrimOp dflags primop = case primop of
-- Int8# signed ops
- Int8Extend -> \args -> opTranslate args (MO_SS_Conv W8 (wordWidth platform))
- Int8Narrow -> \args -> opTranslate args (MO_SS_Conv (wordWidth platform) W8)
+ Int8ExtendOp -> \args -> opTranslate args (MO_SS_Conv W8 (wordWidth platform))
+ Int8NarrowOp -> \args -> opTranslate args (MO_SS_Conv (wordWidth platform) W8)
Int8NegOp -> \args -> opTranslate args (MO_S_Neg W8)
Int8AddOp -> \args -> opTranslate args (MO_Add W8)
Int8SubOp -> \args -> opTranslate args (MO_Sub W8)
@@ -1213,8 +1213,8 @@ emitPrimOp dflags primop = case primop of
-- Word8# unsigned ops
- Word8Extend -> \args -> opTranslate args (MO_UU_Conv W8 (wordWidth platform))
- Word8Narrow -> \args -> opTranslate args (MO_UU_Conv (wordWidth platform) W8)
+ Word8ExtendOp -> \args -> opTranslate args (MO_UU_Conv W8 (wordWidth platform))
+ Word8NarrowOp -> \args -> opTranslate args (MO_UU_Conv (wordWidth platform) W8)
Word8NotOp -> \args -> opTranslate args (MO_Not W8)
Word8AddOp -> \args -> opTranslate args (MO_Add W8)
Word8SubOp -> \args -> opTranslate args (MO_Sub W8)
@@ -1231,8 +1231,8 @@ emitPrimOp dflags primop = case primop of
-- Int16# signed ops
- Int16Extend -> \args -> opTranslate args (MO_SS_Conv W16 (wordWidth platform))
- Int16Narrow -> \args -> opTranslate args (MO_SS_Conv (wordWidth platform) W16)
+ Int16ExtendOp -> \args -> opTranslate args (MO_SS_Conv W16 (wordWidth platform))
+ Int16NarrowOp -> \args -> opTranslate args (MO_SS_Conv (wordWidth platform) W16)
Int16NegOp -> \args -> opTranslate args (MO_S_Neg W16)
Int16AddOp -> \args -> opTranslate args (MO_Add W16)
Int16SubOp -> \args -> opTranslate args (MO_Sub W16)
@@ -1249,8 +1249,8 @@ emitPrimOp dflags primop = case primop of
-- Word16# unsigned ops
- Word16Extend -> \args -> opTranslate args (MO_UU_Conv W16 (wordWidth platform))
- Word16Narrow -> \args -> opTranslate args (MO_UU_Conv (wordWidth platform) W16)
+ Word16ExtendOp -> \args -> opTranslate args (MO_UU_Conv W16 (wordWidth platform))
+ Word16NarrowOp -> \args -> opTranslate args (MO_UU_Conv (wordWidth platform) W16)
Word16NotOp -> \args -> opTranslate args (MO_Not W16)
Word16AddOp -> \args -> opTranslate args (MO_Add W16)
Word16SubOp -> \args -> opTranslate args (MO_Sub W16)
@@ -1265,6 +1265,16 @@ emitPrimOp dflags primop = case primop of
Word16LtOp -> \args -> opTranslate args (MO_U_Lt W16)
Word16NeOp -> \args -> opTranslate args (MO_Ne W16)
+-- Int32# signed ops
+
+ Int32ExtendOp -> \args -> opTranslate args (MO_SS_Conv W32 (wordWidth platform))
+ Int32NarrowOp -> \args -> opTranslate args (MO_SS_Conv (wordWidth platform) W32)
+
+-- Word32# unsigned ops
+
+ Word32ExtendOp -> \args -> opTranslate args (MO_UU_Conv W32 (wordWidth platform))
+ Word32NarrowOp -> \args -> opTranslate args (MO_UU_Conv (wordWidth platform) W32)
+
-- Char# ops
CharEqOp -> \args -> opTranslate args (MO_Eq (wordWidth platform))
diff --git a/compiler/GHC/StgToCmm/Utils.hs b/compiler/GHC/StgToCmm/Utils.hs
index dbb4481d72..8cca28cc5a 100644
--- a/compiler/GHC/StgToCmm/Utils.hs
+++ b/compiler/GHC/StgToCmm/Utils.hs
@@ -106,8 +106,14 @@ mkSimpleLit platform = \case
(wordWidth platform)
LitNullAddr -> zeroCLit platform
(LitNumber LitNumInt i) -> CmmInt i (wordWidth platform)
+ (LitNumber LitNumInt8 i) -> CmmInt i W8
+ (LitNumber LitNumInt16 i) -> CmmInt i W16
+ (LitNumber LitNumInt32 i) -> CmmInt i W32
(LitNumber LitNumInt64 i) -> CmmInt i W64
(LitNumber LitNumWord i) -> CmmInt i (wordWidth platform)
+ (LitNumber LitNumWord8 i) -> CmmInt i W8
+ (LitNumber LitNumWord16 i) -> CmmInt i W16
+ (LitNumber LitNumWord32 i) -> CmmInt i W32
(LitNumber LitNumWord64 i) -> CmmInt i W64
(LitFloat r) -> CmmFloat r W32
(LitDouble r) -> CmmFloat r W64
diff --git a/compiler/GHC/Types/Literal.hs b/compiler/GHC/Types/Literal.hs
index 461f4ac70a..a5c855a4fa 100644
--- a/compiler/GHC/Types/Literal.hs
+++ b/compiler/GHC/Types/Literal.hs
@@ -17,6 +17,12 @@ module GHC.Types.Literal
-- ** Creating Literals
, mkLitInt, mkLitIntWrap, mkLitIntWrapC, mkLitIntUnchecked
, mkLitWord, mkLitWordWrap, mkLitWordWrapC
+ , mkLitInt8, mkLitInt8Wrap
+ , mkLitWord8, mkLitWord8Wrap
+ , mkLitInt16, mkLitInt16Wrap
+ , mkLitWord16, mkLitWord16Wrap
+ , mkLitInt32, mkLitInt32Wrap
+ , mkLitWord32, mkLitWord32Wrap
, mkLitInt64, mkLitInt64Wrap
, mkLitWord64, mkLitWord64Wrap
, mkLitFloat, mkLitDouble
@@ -40,9 +46,13 @@ module GHC.Types.Literal
-- ** Coercions
, wordToIntLit, intToWordLit
- , narrowLit
, narrow8IntLit, narrow16IntLit, narrow32IntLit
, narrow8WordLit, narrow16WordLit, narrow32WordLit
+ , narrowInt8Lit, narrowInt16Lit, narrowInt32Lit
+ , narrowWord8Lit, narrowWord16Lit, narrowWord32Lit
+ , extendIntLit, extendWordLit
+ , int8Lit, int16Lit, int32Lit
+ , word8Lit, word16Lit, word32Lit
, charToIntLit, intToCharLit
, floatToIntLit, intToFloatLit, doubleToIntLit, intToDoubleLit
, nullAddrLit, rubbishLit, floatToDoubleLit, doubleToFloatLit
@@ -152,8 +162,14 @@ data LitNumType
= LitNumInteger -- ^ @Integer@ (see Note [BigNum literals])
| LitNumNatural -- ^ @Natural@ (see Note [BigNum literals])
| LitNumInt -- ^ @Int#@ - according to target machine
+ | LitNumInt8 -- ^ @Int8#@ - exactly 8 bits
+ | LitNumInt16 -- ^ @Int16#@ - exactly 16 bits
+ | LitNumInt32 -- ^ @Int32#@ - exactly 32 bits
| LitNumInt64 -- ^ @Int64#@ - exactly 64 bits
| LitNumWord -- ^ @Word#@ - according to target machine
+ | LitNumWord8 -- ^ @Word8#@ - exactly 8 bits
+ | LitNumWord16 -- ^ @Word16#@ - exactly 16 bits
+ | LitNumWord32 -- ^ @Word32#@ - exactly 32 bits
| LitNumWord64 -- ^ @Word64#@ - exactly 64 bits
deriving (Data,Enum,Eq,Ord)
@@ -163,8 +179,14 @@ litNumIsSigned nt = case nt of
LitNumInteger -> True
LitNumNatural -> False
LitNumInt -> True
+ LitNumInt8 -> True
+ LitNumInt16 -> True
+ LitNumInt32 -> True
LitNumInt64 -> True
LitNumWord -> False
+ LitNumWord8 -> False
+ LitNumWord16 -> False
+ LitNumWord32 -> False
LitNumWord64 -> False
{-
@@ -290,6 +312,12 @@ wrapLitNumber platform v@(LitNumber nt i) = case nt of
LitNumWord -> case platformWordSize platform of
PW4 -> LitNumber nt (toInteger (fromIntegral i :: Word32))
PW8 -> LitNumber nt (toInteger (fromIntegral i :: Word64))
+ LitNumInt8 -> LitNumber nt (toInteger (fromIntegral i :: Int8))
+ LitNumWord8 -> LitNumber nt (toInteger (fromIntegral i :: Word8))
+ LitNumInt16 -> LitNumber nt (toInteger (fromIntegral i :: Int16))
+ LitNumWord16 -> LitNumber nt (toInteger (fromIntegral i :: Word16))
+ LitNumInt32 -> LitNumber nt (toInteger (fromIntegral i :: Int32))
+ LitNumWord32 -> LitNumber nt (toInteger (fromIntegral i :: Word32))
LitNumInt64 -> LitNumber nt (toInteger (fromIntegral i :: Int64))
LitNumWord64 -> LitNumber nt (toInteger (fromIntegral i :: Word64))
LitNumInteger -> v
@@ -305,7 +333,13 @@ litNumCheckRange :: Platform -> LitNumType -> Integer -> Bool
litNumCheckRange platform nt i = case nt of
LitNumInt -> platformInIntRange platform i
LitNumWord -> platformInWordRange platform i
+ LitNumInt8 -> inInt8Range i
+ LitNumInt16 -> inInt16Range i
+ LitNumInt32 -> inInt32Range i
LitNumInt64 -> inInt64Range i
+ LitNumWord8 -> inWord8Range i
+ LitNumWord16 -> inWord16Range i
+ LitNumWord32 -> inWord32Range i
LitNumWord64 -> inWord64Range i
LitNumNatural -> i >= 0
LitNumInteger -> True
@@ -364,6 +398,84 @@ mkLitWordWrapC platform i = (n, i /= i')
where
n@(LitNumber _ i') = mkLitWordWrap platform i
+-- | Creates a 'Literal' of type @Int8#@
+mkLitInt8 :: Integer -> Literal
+mkLitInt8 x = ASSERT2( inInt8Range x, integer x ) (mkLitInt8Unchecked x)
+
+-- | Creates a 'Literal' of type @Int8#@.
+-- If the argument is out of the range, it is wrapped.
+mkLitInt8Wrap :: Platform -> Integer -> Literal
+mkLitInt8Wrap platform i = wrapLitNumber platform $ mkLitInt8Unchecked i
+
+-- | Creates a 'Literal' of type @Int8#@ without checking its range.
+mkLitInt8Unchecked :: Integer -> Literal
+mkLitInt8Unchecked i = LitNumber LitNumInt8 i
+
+-- | Creates a 'Literal' of type @Word8#@
+mkLitWord8 :: Integer -> Literal
+mkLitWord8 x = ASSERT2( inWord8Range x, integer x ) (mkLitWord8Unchecked x)
+
+-- | Creates a 'Literal' of type @Word8#@.
+-- If the argument is out of the range, it is wrapped.
+mkLitWord8Wrap :: Platform -> Integer -> Literal
+mkLitWord8Wrap platform i = wrapLitNumber platform $ mkLitWord8Unchecked i
+
+-- | Creates a 'Literal' of type @Word8#@ without checking its range.
+mkLitWord8Unchecked :: Integer -> Literal
+mkLitWord8Unchecked i = LitNumber LitNumWord8 i
+
+-- | Creates a 'Literal' of type @Int16#@
+mkLitInt16 :: Integer -> Literal
+mkLitInt16 x = ASSERT2( inInt16Range x, integer x ) (mkLitInt16Unchecked x)
+
+-- | Creates a 'Literal' of type @Int16#@.
+-- If the argument is out of the range, it is wrapped.
+mkLitInt16Wrap :: Platform -> Integer -> Literal
+mkLitInt16Wrap platform i = wrapLitNumber platform $ mkLitInt16Unchecked i
+
+-- | Creates a 'Literal' of type @Int16#@ without checking its range.
+mkLitInt16Unchecked :: Integer -> Literal
+mkLitInt16Unchecked i = LitNumber LitNumInt16 i
+
+-- | Creates a 'Literal' of type @Word16#@
+mkLitWord16 :: Integer -> Literal
+mkLitWord16 x = ASSERT2( inWord16Range x, integer x ) (mkLitWord16Unchecked x)
+
+-- | Creates a 'Literal' of type @Word16#@.
+-- If the argument is out of the range, it is wrapped.
+mkLitWord16Wrap :: Platform -> Integer -> Literal
+mkLitWord16Wrap platform i = wrapLitNumber platform $ mkLitWord16Unchecked i
+
+-- | Creates a 'Literal' of type @Word16#@ without checking its range.
+mkLitWord16Unchecked :: Integer -> Literal
+mkLitWord16Unchecked i = LitNumber LitNumWord16 i
+
+-- | Creates a 'Literal' of type @Int32#@
+mkLitInt32 :: Integer -> Literal
+mkLitInt32 x = ASSERT2( inInt32Range x, integer x ) (mkLitInt32Unchecked x)
+
+-- | Creates a 'Literal' of type @Int32#@.
+-- If the argument is out of the range, it is wrapped.
+mkLitInt32Wrap :: Platform -> Integer -> Literal
+mkLitInt32Wrap platform i = wrapLitNumber platform $ mkLitInt32Unchecked i
+
+-- | Creates a 'Literal' of type @Int32#@ without checking its range.
+mkLitInt32Unchecked :: Integer -> Literal
+mkLitInt32Unchecked i = LitNumber LitNumInt32 i
+
+-- | Creates a 'Literal' of type @Word32#@
+mkLitWord32 :: Integer -> Literal
+mkLitWord32 x = ASSERT2( inWord32Range x, integer x ) (mkLitWord32Unchecked x)
+
+-- | Creates a 'Literal' of type @Word32#@.
+-- If the argument is out of the range, it is wrapped.
+mkLitWord32Wrap :: Platform -> Integer -> Literal
+mkLitWord32Wrap platform i = wrapLitNumber platform $ mkLitWord32Unchecked i
+
+-- | Creates a 'Literal' of type @Word32#@ without checking its range.
+mkLitWord32Unchecked :: Integer -> Literal
+mkLitWord32Unchecked i = LitNumber LitNumWord32 i
+
-- | Creates a 'Literal' of type @Int64#@
mkLitInt64 :: Integer -> Literal
mkLitInt64 x = ASSERT2( inInt64Range x, integer x ) (mkLitInt64Unchecked x)
@@ -418,7 +530,20 @@ mkLitNatural x = ASSERT2( inNaturalRange x, integer x )
inNaturalRange :: Integer -> Bool
inNaturalRange x = x >= 0
-inInt64Range, inWord64Range :: Integer -> Bool
+inInt8Range, inWord8Range, inInt16Range, inWord16Range :: Integer -> Bool
+inInt32Range, inWord32Range, inInt64Range, inWord64Range :: Integer -> Bool
+inInt8Range x = x >= toInteger (minBound :: Int8) &&
+ x <= toInteger (maxBound :: Int8)
+inWord8Range x = x >= toInteger (minBound :: Word8) &&
+ x <= toInteger (maxBound :: Word8)
+inInt16Range x = x >= toInteger (minBound :: Int16) &&
+ x <= toInteger (maxBound :: Int16)
+inWord16Range x = x >= toInteger (minBound :: Word16) &&
+ x <= toInteger (maxBound :: Word16)
+inInt32Range x = x >= toInteger (minBound :: Int32) &&
+ x <= toInteger (maxBound :: Int32)
+inWord32Range x = x >= toInteger (minBound :: Word32) &&
+ x <= toInteger (maxBound :: Word32)
inInt64Range x = x >= toInteger (minBound :: Int64) &&
x <= toInteger (maxBound :: Int64)
inWord64Range x = x >= toInteger (minBound :: Word64) &&
@@ -466,6 +591,8 @@ mapLitValue _ _ l = pprPanic "mapLitValue" (ppr l)
narrow8IntLit, narrow16IntLit, narrow32IntLit,
narrow8WordLit, narrow16WordLit, narrow32WordLit,
+ int8Lit, int16Lit, int32Lit,
+ word8Lit, word16Lit, word32Lit,
charToIntLit, intToCharLit,
floatToIntLit, intToFloatLit, doubleToIntLit, intToDoubleLit,
floatToDoubleLit, doubleToFloatLit
@@ -489,16 +616,46 @@ intToWordLit platform (LitNumber LitNumInt i)
intToWordLit _ l = pprPanic "intToWordLit" (ppr l)
-- | Narrow a literal number (unchecked result range)
-narrowLit :: forall a. Integral a => Proxy a -> Literal -> Literal
-narrowLit _ (LitNumber nt i) = LitNumber nt (toInteger (fromInteger i :: a))
-narrowLit _ l = pprPanic "narrowLit" (ppr l)
-
-narrow8IntLit = narrowLit (Proxy :: Proxy Int8)
-narrow16IntLit = narrowLit (Proxy :: Proxy Int16)
-narrow32IntLit = narrowLit (Proxy :: Proxy Int32)
-narrow8WordLit = narrowLit (Proxy :: Proxy Word8)
-narrow16WordLit = narrowLit (Proxy :: Proxy Word16)
-narrow32WordLit = narrowLit (Proxy :: Proxy Word32)
+narrowLit' :: forall a. Integral a => Proxy a -> LitNumType -> Literal -> Literal
+narrowLit' _ nt' (LitNumber _ i) = LitNumber nt' (toInteger (fromInteger i :: a))
+narrowLit' _ _ l = pprPanic "narrowLit" (ppr l)
+
+narrow8IntLit = narrowLit' (Proxy :: Proxy Int8) LitNumInt
+narrow16IntLit = narrowLit' (Proxy :: Proxy Int16) LitNumInt
+narrow32IntLit = narrowLit' (Proxy :: Proxy Int32) LitNumInt
+narrow8WordLit = narrowLit' (Proxy :: Proxy Word8) LitNumWord
+narrow16WordLit = narrowLit' (Proxy :: Proxy Word16) LitNumWord
+narrow32WordLit = narrowLit' (Proxy :: Proxy Word32) LitNumWord
+
+narrowInt8Lit, narrowInt16Lit, narrowInt32Lit,
+ narrowWord8Lit, narrowWord16Lit, narrowWord32Lit :: Literal -> Literal
+narrowInt8Lit = narrowLit' (Proxy :: Proxy Int8) LitNumInt8
+narrowInt16Lit = narrowLit' (Proxy :: Proxy Int16) LitNumInt16
+narrowInt32Lit = narrowLit' (Proxy :: Proxy Int32) LitNumInt32
+narrowWord8Lit = narrowLit' (Proxy :: Proxy Word8) LitNumWord8
+narrowWord16Lit = narrowLit' (Proxy :: Proxy Word16) LitNumWord16
+narrowWord32Lit = narrowLit' (Proxy :: Proxy Word32) LitNumWord32
+
+-- | Extend a fixed-width literal (e.g. 'Int16#') to a word-sized literal (e.g.
+-- 'Int#').
+extendWordLit, extendIntLit :: Platform -> Literal -> Literal
+extendWordLit platform (LitNumber _nt i) = mkLitWord platform i
+extendWordLit _platform l = pprPanic "extendWordLit" (ppr l)
+extendIntLit platform (LitNumber _nt i) = mkLitInt platform i
+extendIntLit _platform l = pprPanic "extendIntLit" (ppr l)
+
+int8Lit (LitNumber _ i) = mkLitInt8 i
+int8Lit l = pprPanic "int8Lit" (ppr l)
+int16Lit (LitNumber _ i) = mkLitInt16 i
+int16Lit l = pprPanic "int16Lit" (ppr l)
+int32Lit (LitNumber _ i) = mkLitInt32 i
+int32Lit l = pprPanic "int32Lit" (ppr l)
+word8Lit (LitNumber _ i) = mkLitWord8 i
+word8Lit l = pprPanic "word8Lit" (ppr l)
+word16Lit (LitNumber _ i) = mkLitWord16 i
+word16Lit l = pprPanic "word16Lit" (ppr l)
+word32Lit (LitNumber _ i) = mkLitWord32 i
+word32Lit l = pprPanic "word32Lit" (ppr l)
charToIntLit (LitChar c) = mkLitIntUnchecked (toInteger (ord c))
charToIntLit l = pprPanic "charToIntLit" (ppr l)
@@ -572,8 +729,14 @@ litIsTrivial (LitNumber nt _) = case nt of
LitNumInteger -> False
LitNumNatural -> False
LitNumInt -> True
+ LitNumInt8 -> True
+ LitNumInt16 -> True
+ LitNumInt32 -> True
LitNumInt64 -> True
LitNumWord -> True
+ LitNumWord8 -> True
+ LitNumWord16 -> True
+ LitNumWord32 -> True
LitNumWord64 -> True
litIsTrivial _ = True
@@ -585,8 +748,14 @@ litIsDupable platform x = case x of
LitNumInteger -> platformInIntRange platform i
LitNumNatural -> platformInWordRange platform i
LitNumInt -> True
+ LitNumInt8 -> True
+ LitNumInt16 -> True
+ LitNumInt32 -> True
LitNumInt64 -> True
LitNumWord -> True
+ LitNumWord8 -> True
+ LitNumWord16 -> True
+ LitNumWord32 -> True
LitNumWord64 -> True
(LitString _) -> False
_ -> True
@@ -601,8 +770,14 @@ litIsLifted (LitNumber nt _) = case nt of
LitNumInteger -> True
LitNumNatural -> True
LitNumInt -> False
+ LitNumInt8 -> False
+ LitNumInt16 -> False
+ LitNumInt32 -> False
LitNumInt64 -> False
LitNumWord -> False
+ LitNumWord8 -> False
+ LitNumWord16 -> False
+ LitNumWord32 -> False
LitNumWord64 -> False
litIsLifted _ = False
@@ -623,8 +798,14 @@ literalType (LitNumber lt _) = case lt of
LitNumInteger -> integerTy
LitNumNatural -> naturalTy
LitNumInt -> intPrimTy
+ LitNumInt8 -> int8PrimTy
+ LitNumInt16 -> int16PrimTy
+ LitNumInt32 -> int32PrimTy
LitNumInt64 -> int64PrimTy
LitNumWord -> wordPrimTy
+ LitNumWord8 -> word8PrimTy
+ LitNumWord16 -> word16PrimTy
+ LitNumWord32 -> word32PrimTy
LitNumWord64 -> word64PrimTy
literalType (LitRubbish) = mkForAllTy a Inferred (mkTyVarTy a)
where
@@ -700,8 +881,14 @@ pprLiteral add_par (LitNumber nt i)
LitNumInteger -> pprIntegerVal add_par i
LitNumNatural -> pprIntegerVal add_par i
LitNumInt -> pprPrimInt i
+ LitNumInt8 -> pprPrimInt8 i
+ LitNumInt16 -> pprPrimInt16 i
+ LitNumInt32 -> pprPrimInt32 i
LitNumInt64 -> pprPrimInt64 i
LitNumWord -> pprPrimWord i
+ LitNumWord8 -> pprPrimWord8 i
+ LitNumWord16 -> pprPrimWord16 i
+ LitNumWord32 -> pprPrimWord32 i
LitNumWord64 -> pprPrimWord64 i
pprLiteral add_par (LitLabel l mb fod) =
add_par (text "__label" <+> b <+> ppr fod)
diff --git a/compiler/GHC/Utils/Outputable.hs b/compiler/GHC/Utils/Outputable.hs
index 3698c5a4b2..7cbd0c4ffd 100644
--- a/compiler/GHC/Utils/Outputable.hs
+++ b/compiler/GHC/Utils/Outputable.hs
@@ -62,7 +62,9 @@ module GHC.Utils.Outputable (
primFloatSuffix, primCharSuffix, primWordSuffix, primDoubleSuffix,
primInt64Suffix, primWord64Suffix, primIntSuffix,
- pprPrimChar, pprPrimInt, pprPrimWord, pprPrimInt64, pprPrimWord64,
+ pprPrimChar, pprPrimInt, pprPrimWord,
+ pprPrimInt8, pprPrimInt16, pprPrimInt32, pprPrimInt64,
+ pprPrimWord8, pprPrimWord16, pprPrimWord32, pprPrimWord64,
pprFastFilePath, pprFilePathString,
@@ -1149,22 +1151,40 @@ pprHsBytes bs = let escaped = concatMap escape $ BS.unpack bs
-- Postfix modifiers for unboxed literals.
-- See Note [Printing of literals in Core] in "GHC.Types.Literal".
primCharSuffix, primFloatSuffix, primIntSuffix :: SDoc
-primDoubleSuffix, primWordSuffix, primInt64Suffix, primWord64Suffix :: SDoc
+primDoubleSuffix, primWordSuffix :: SDoc
+primInt8Suffix, primWord8Suffix :: SDoc
+primInt16Suffix, primWord16Suffix :: SDoc
+primInt32Suffix, primWord32Suffix :: SDoc
+primInt64Suffix, primWord64Suffix :: SDoc
primCharSuffix = char '#'
primFloatSuffix = char '#'
primIntSuffix = char '#'
primDoubleSuffix = text "##"
primWordSuffix = text "##"
-primInt64Suffix = text "L#"
-primWord64Suffix = text "L##"
+primInt8Suffix = text "#8"
+primWord8Suffix = text "##8"
+primInt16Suffix = text "#16"
+primWord16Suffix = text "##16"
+primInt32Suffix = text "#32"
+primWord32Suffix = text "##32"
+primInt64Suffix = text "#64"
+primWord64Suffix = text "##64"
-- | Special combinator for showing unboxed literals.
pprPrimChar :: Char -> SDoc
-pprPrimInt, pprPrimWord, pprPrimInt64, pprPrimWord64 :: Integer -> SDoc
+pprPrimInt, pprPrimWord :: Integer -> SDoc
+pprPrimInt8, pprPrimInt16, pprPrimInt32, pprPrimInt64 :: Integer -> SDoc
+pprPrimWord8, pprPrimWord16, pprPrimWord32, pprPrimWord64 :: Integer -> SDoc
pprPrimChar c = pprHsChar c <> primCharSuffix
pprPrimInt i = integer i <> primIntSuffix
pprPrimWord w = word w <> primWordSuffix
+pprPrimInt8 i = integer i <> primInt8Suffix
+pprPrimInt16 i = integer i <> primInt16Suffix
+pprPrimInt32 i = integer i <> primInt32Suffix
pprPrimInt64 i = integer i <> primInt64Suffix
+pprPrimWord8 w = word w <> primWord8Suffix
+pprPrimWord16 w = word w <> primWord16Suffix
+pprPrimWord32 w = word w <> primWord32Suffix
pprPrimWord64 w = word w <> primWord64Suffix
---------------------
diff --git a/ghc/ghc-bin.cabal.in b/ghc/ghc-bin.cabal.in
index 2e42221d47..d29f71ab04 100644
--- a/ghc/ghc-bin.cabal.in
+++ b/ghc/ghc-bin.cabal.in
@@ -59,7 +59,7 @@ Executable ghc
-- NB: this is never built by the bootstrapping GHC+libraries
Build-depends:
deepseq == 1.4.*,
- ghc-prim >= 0.5.0 && < 0.8,
+ ghc-prim >= 0.5.0 && < 0.9,
ghci == @ProjectVersionMunged@,
haskeline == 0.8.*,
exceptions == 0.10.*,
diff --git a/libraries/array b/libraries/array
-Subproject 10e6c7e0522367677e4c33cc1c56eb852ef1342
+Subproject c7a696e3e6d5a6b00d3e00ca694af916f15bcff
diff --git a/libraries/base/GHC/Float.hs b/libraries/base/GHC/Float.hs
index 67cc11f9a9..5b859b1db9 100644
--- a/libraries/base/GHC/Float.hs
+++ b/libraries/base/GHC/Float.hs
@@ -1394,7 +1394,7 @@ castWord32ToFloat :: Word32 -> Float
castWord32ToFloat (W32# w#) = F# (stgWord32ToFloat w#)
foreign import prim "stg_word32ToFloatzh"
- stgWord32ToFloat :: Word# -> Float#
+ stgWord32ToFloat :: Word32# -> Float#
-- | @'castFloatToWord32' f@ does a bit-for-bit copy from a floating-point value
@@ -1407,7 +1407,7 @@ castFloatToWord32 :: Float -> Word32
castFloatToWord32 (F# f#) = W32# (stgFloatToWord32 f#)
foreign import prim "stg_floatToWord32zh"
- stgFloatToWord32 :: Float# -> Word#
+ stgFloatToWord32 :: Float# -> Word32#
diff --git a/libraries/base/GHC/IO/Encoding/CodePage.hs b/libraries/base/GHC/IO/Encoding/CodePage.hs
index 2532e071e6..6c77e65c41 100644
--- a/libraries/base/GHC/IO/Encoding/CodePage.hs
+++ b/libraries/base/GHC/IO/Encoding/CodePage.hs
@@ -174,7 +174,7 @@ indexInt (ConvArray p) (I# i) = I# (indexInt16OffAddr# p i)
{-# INLINE indexWord8 #-}
indexWord8 :: ConvArray Word8 -> Int -> Word8
-indexWord8 (ConvArray p) (I# i) = W8# (indexWord8OffAddr# p i)
+indexWord8 (ConvArray p) (I# i) = W8# (narrowWord8# (indexWord8OffAddr# p i))
{-# INLINE indexChar #-}
indexChar :: ConvArray Char -> Int -> Char
diff --git a/libraries/base/GHC/IO/Encoding/UTF16.hs b/libraries/base/GHC/IO/Encoding/UTF16.hs
index 192f30beb9..c77c131eef 100644
--- a/libraries/base/GHC/IO/Encoding/UTF16.hs
+++ b/libraries/base/GHC/IO/Encoding/UTF16.hs
@@ -342,8 +342,8 @@ utf16le_encode
chr2 :: Word16 -> Word16 -> Char
chr2 (W16# a#) (W16# b#) = C# (chr# (upper# +# lower# +# 0x10000#))
where
- !x# = word2Int# a#
- !y# = word2Int# b#
+ !x# = word2Int# (extendWord16# a#)
+ !y# = word2Int# (extendWord16# b#)
!upper# = uncheckedIShiftL# (x# -# 0xD800#) 10#
!lower# = y# -# 0xDC00#
{-# INLINE chr2 #-}
@@ -356,4 +356,3 @@ validate2 :: Word16 -> Word16 -> Bool
validate2 x1 x2 = x1 >= 0xD800 && x1 <= 0xDBFF &&
x2 >= 0xDC00 && x2 <= 0xDFFF
{-# INLINE validate2 #-}
-
diff --git a/libraries/base/GHC/IO/Encoding/UTF32.hs b/libraries/base/GHC/IO/Encoding/UTF32.hs
index 26b5e448ca..c14b365a04 100644
--- a/libraries/base/GHC/IO/Encoding/UTF32.hs
+++ b/libraries/base/GHC/IO/Encoding/UTF32.hs
@@ -309,10 +309,10 @@ chr4 :: Word8 -> Word8 -> Word8 -> Word8 -> Char
chr4 (W8# x1#) (W8# x2#) (W8# x3#) (W8# x4#) =
C# (chr# (z1# +# z2# +# z3# +# z4#))
where
- !y1# = word2Int# x1#
- !y2# = word2Int# x2#
- !y3# = word2Int# x3#
- !y4# = word2Int# x4#
+ !y1# = word2Int# (extendWord8# x1#)
+ !y2# = word2Int# (extendWord8# x2#)
+ !y3# = word2Int# (extendWord8# x3#)
+ !y4# = word2Int# (extendWord8# x4#)
!z1# = uncheckedIShiftL# y1# 24#
!z2# = uncheckedIShiftL# y2# 16#
!z3# = uncheckedIShiftL# y3# 8#
@@ -333,4 +333,3 @@ validate :: Char -> Bool
validate c = (x1 >= 0x0 && x1 < 0xD800) || (x1 > 0xDFFF && x1 <= 0x10FFFF)
where x1 = ord c
{-# INLINE validate #-}
-
diff --git a/libraries/base/GHC/IO/Encoding/UTF8.hs b/libraries/base/GHC/IO/Encoding/UTF8.hs
index 18d034ad15..d887a92960 100644
--- a/libraries/base/GHC/IO/Encoding/UTF8.hs
+++ b/libraries/base/GHC/IO/Encoding/UTF8.hs
@@ -11,7 +11,7 @@
-- Module : GHC.IO.Encoding.UTF8
-- Copyright : (c) The University of Glasgow, 2009
-- License : see libraries/base/LICENSE
---
+--
-- Maintainer : libraries@haskell.org
-- Stability : internal
-- Portability : non-portable
@@ -144,17 +144,17 @@ bom1 = 0xbb
bom2 = 0xbf
utf8_decode :: DecodeBuffer
-utf8_decode
+utf8_decode
input@Buffer{ bufRaw=iraw, bufL=ir0, bufR=iw, bufSize=_ }
output@Buffer{ bufRaw=oraw, bufL=_, bufR=ow0, bufSize=os }
- = let
+ = let
loop !ir !ow
| ow >= os = done OutputUnderflow ir ow
| ir >= iw = done InputUnderflow ir ow
| otherwise = do
c0 <- readWord8Buf iraw ir
case c0 of
- _ | c0 <= 0x7f -> do
+ _ | c0 <= 0x7f -> do
ow' <- writeCharBuf oraw ow (unsafeChr (fromIntegral c0))
loop (ir+1) ow'
| c0 >= 0xc0 && c0 <= 0xc1 -> invalid -- Overlong forms
@@ -170,7 +170,7 @@ utf8_decode
2 -> do -- check for an error even when we don't have
-- the full sequence yet (#3341)
c1 <- readWord8Buf iraw (ir+1)
- if not (validate3 c0 c1 0x80)
+ if not (validate3 c0 c1 0x80)
then invalid else done InputUnderflow ir ow
_ -> do
c1 <- readWord8Buf iraw (ir+1)
@@ -215,7 +215,7 @@ utf8_encode :: EncodeBuffer
utf8_encode
input@Buffer{ bufRaw=iraw, bufL=ir0, bufR=iw, bufSize=_ }
output@Buffer{ bufRaw=oraw, bufL=_, bufR=ow0, bufSize=os }
- = let
+ = let
done why !ir !ow = return (why,
if ir == iw then input{ bufL=0, bufR=0 }
else input{ bufL=ir },
@@ -255,7 +255,7 @@ utf8_encode
-- -----------------------------------------------------------------------------
-- UTF-8 primitives, lifted from Data.Text.Fusion.Utf8
-
+
ord2 :: Char -> (Word8,Word8)
ord2 c = assert (n >= 0x80 && n <= 0x07ff) (x1,x2)
where
@@ -283,8 +283,8 @@ ord4 c = assert (n >= 0x10000) (x1,x2,x3,x4)
chr2 :: Word8 -> Word8 -> Char
chr2 (W8# x1#) (W8# x2#) = C# (chr# (z1# +# z2#))
where
- !y1# = word2Int# x1#
- !y2# = word2Int# x2#
+ !y1# = word2Int# (extendWord8# x1#)
+ !y2# = word2Int# (extendWord8# x2#)
!z1# = uncheckedIShiftL# (y1# -# 0xC0#) 6#
!z2# = y2# -# 0x80#
{-# INLINE chr2 #-}
@@ -292,9 +292,9 @@ chr2 (W8# x1#) (W8# x2#) = C# (chr# (z1# +# z2#))
chr3 :: Word8 -> Word8 -> Word8 -> Char
chr3 (W8# x1#) (W8# x2#) (W8# x3#) = C# (chr# (z1# +# z2# +# z3#))
where
- !y1# = word2Int# x1#
- !y2# = word2Int# x2#
- !y3# = word2Int# x3#
+ !y1# = word2Int# (extendWord8# x1#)
+ !y2# = word2Int# (extendWord8# x2#)
+ !y3# = word2Int# (extendWord8# x3#)
!z1# = uncheckedIShiftL# (y1# -# 0xE0#) 12#
!z2# = uncheckedIShiftL# (y2# -# 0x80#) 6#
!z3# = y3# -# 0x80#
@@ -304,10 +304,10 @@ chr4 :: Word8 -> Word8 -> Word8 -> Word8 -> Char
chr4 (W8# x1#) (W8# x2#) (W8# x3#) (W8# x4#) =
C# (chr# (z1# +# z2# +# z3# +# z4#))
where
- !y1# = word2Int# x1#
- !y2# = word2Int# x2#
- !y3# = word2Int# x3#
- !y4# = word2Int# x4#
+ !y1# = word2Int# (extendWord8# x1#)
+ !y2# = word2Int# (extendWord8# x2#)
+ !y3# = word2Int# (extendWord8# x3#)
+ !y4# = word2Int# (extendWord8# x4#)
!z1# = uncheckedIShiftL# (y1# -# 0xF0#) 18#
!z2# = uncheckedIShiftL# (y2# -# 0x80#) 12#
!z3# = uncheckedIShiftL# (y3# -# 0x80#) 6#
@@ -346,7 +346,7 @@ validate4 :: Word8 -> Word8 -> Word8 -> Word8 -> Bool
validate4 x1 x2 x3 x4 = validate4_1 ||
validate4_2 ||
validate4_3
- where
+ where
validate4_1 = x1 == 0xF0 &&
between x2 0x90 0xBF &&
between x3 0x80 0xBF &&
@@ -359,4 +359,3 @@ validate4 x1 x2 x3 x4 = validate4_1 ||
between x2 0x80 0x8F &&
between x3 0x80 0xBF &&
between x4 0x80 0xBF
-
diff --git a/libraries/base/GHC/Int.hs b/libraries/base/GHC/Int.hs
index 5449a79c8f..08827e92c4 100644
--- a/libraries/base/GHC/Int.hs
+++ b/libraries/base/GHC/Int.hs
@@ -59,7 +59,7 @@ import GHC.Show
-- Int8 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 "HsInt8" #-} Int8 = I8# Int#
+data {-# CTYPE "HsInt8" #-} Int8 = I8# Int8#
-- ^ 8-bit signed integer type
-- See GHC.Classes#matching_overloaded_methods_in_rules
@@ -69,8 +69,8 @@ instance Eq Int8 where
(/=) = neInt8
eqInt8, neInt8 :: Int8 -> Int8 -> Bool
-eqInt8 (I8# x) (I8# y) = isTrue# (x ==# y)
-neInt8 (I8# x) (I8# y) = isTrue# (x /=# y)
+eqInt8 (I8# x) (I8# y) = isTrue# ((extendInt8# x) ==# (extendInt8# y))
+neInt8 (I8# x) (I8# y) = isTrue# ((extendInt8# x) /=# (extendInt8# 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# (x ># y)
-(I8# x) `geInt8` (I8# y) = isTrue# (x >=# y)
-(I8# x) `ltInt8` (I8# y) = isTrue# (x <# y)
-(I8# x) `leInt8` (I8# y) = isTrue# (x <=# y)
+(I8# x) `gtInt8` (I8# y) = isTrue# ((extendInt8# x) ># (extendInt8# y))
+(I8# x) `geInt8` (I8# y) = isTrue# ((extendInt8# x) >=# (extendInt8# y))
+(I8# x) `ltInt8` (I8# y) = isTrue# ((extendInt8# x) <# (extendInt8# y))
+(I8# x) `leInt8` (I8# y) = isTrue# ((extendInt8# x) <=# (extendInt8# y))
-- | @since 2.01
instance Show Int8 where
@@ -97,16 +97,16 @@ instance Show Int8 where
-- | @since 2.01
instance Num Int8 where
- (I8# x#) + (I8# y#) = I8# (narrow8Int# (x# +# y#))
- (I8# x#) - (I8# y#) = I8# (narrow8Int# (x# -# y#))
- (I8# x#) * (I8# y#) = I8# (narrow8Int# (x# *# y#))
- negate (I8# x#) = I8# (narrow8Int# (negateInt# x#))
+ (I8# x#) + (I8# y#) = I8# (narrowInt8# ((extendInt8# x#) +# (extendInt8# y#)))
+ (I8# x#) - (I8# y#) = I8# (narrowInt8# ((extendInt8# x#) -# (extendInt8# y#)))
+ (I8# x#) * (I8# y#) = I8# (narrowInt8# ((extendInt8# x#) *# (extendInt8# y#)))
+ negate (I8# x#) = I8# (narrowInt8# (negateInt# (extendInt8# x#)))
abs x | x >= 0 = x
| otherwise = negate x
signum x | x > 0 = 1
signum 0 = 0
signum _ = -1
- fromInteger i = I8# (narrow8Int# (integerToInt# i))
+ fromInteger i = I8# (narrowInt8# (integerToInt# i))
-- | @since 2.01
instance Real Int8 where
@@ -122,9 +122,9 @@ instance Enum Int8 where
| otherwise = predError "Int8"
toEnum i@(I# i#)
| i >= fromIntegral (minBound::Int8) && i <= fromIntegral (maxBound::Int8)
- = I8# i#
+ = I8# (narrowInt8# i#)
| otherwise = toEnumError "Int8" i (minBound::Int8, maxBound::Int8)
- fromEnum (I8# x#) = I# x#
+ fromEnum (I8# x#) = I# (extendInt8# x#)
enumFrom = boundedEnumFrom
enumFromThen = boundedEnumFromThen
@@ -133,34 +133,34 @@ 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# (narrow8Int# (x# `quotInt#` y#))
+ | otherwise = I8# (narrowInt8# ((extendInt8# x#) `quotInt#` (extendInt8# y#)))
rem (I8# x#) y@(I8# y#)
| y == 0 = divZeroError
- | otherwise = I8# (narrow8Int# (x# `remInt#` y#))
+ | otherwise = I8# (narrowInt8# ((extendInt8# x#) `remInt#` (extendInt8# y#)))
div x@(I8# x#) y@(I8# y#)
| y == 0 = divZeroError
| y == (-1) && x == minBound = overflowError -- Note [Order of tests]
- | otherwise = I8# (narrow8Int# (x# `divInt#` y#))
+ | otherwise = I8# (narrowInt8# ((extendInt8# x#) `divInt#` (extendInt8# y#)))
mod (I8# x#) y@(I8# y#)
| y == 0 = divZeroError
- | otherwise = I8# (narrow8Int# (x# `modInt#` y#))
+ | otherwise = I8# (narrowInt8# ((extendInt8# x#) `modInt#` (extendInt8# y#)))
quotRem x@(I8# x#) y@(I8# y#)
| y == 0 = divZeroError
-- Note [Order of tests]
| y == (-1) && x == minBound = (overflowError, 0)
- | otherwise = case x# `quotRemInt#` y# of
+ | otherwise = case (extendInt8# x#) `quotRemInt#` (extendInt8# y#) of
(# q, r #) ->
- (I8# (narrow8Int# q),
- I8# (narrow8Int# r))
+ (I8# (narrowInt8# q),
+ I8# (narrowInt8# r))
divMod x@(I8# x#) y@(I8# y#)
| y == 0 = divZeroError
-- Note [Order of tests]
| y == (-1) && x == minBound = (overflowError, 0)
- | otherwise = case x# `divModInt#` y# of
+ | otherwise = case (extendInt8# x#) `divModInt#` (extendInt8# y#) of
(# d, m #) ->
- (I8# (narrow8Int# d),
- I8# (narrow8Int# m))
- toInteger (I8# x#) = IS x#
+ (I8# (narrowInt8# d),
+ I8# (narrowInt8# m))
+ toInteger (I8# x#) = IS (extendInt8# x#)
-- | @since 2.01
instance Bounded Int8 where
@@ -184,34 +184,34 @@ instance Bits Int8 where
{-# INLINE testBit #-}
{-# INLINE popCount #-}
- (I8# x#) .&. (I8# y#) = I8# (x# `andI#` y#)
- (I8# x#) .|. (I8# y#) = I8# (x# `orI#` y#)
- (I8# x#) `xor` (I8# y#) = I8# (x# `xorI#` y#)
- complement (I8# x#) = I8# (notI# x#)
+ (I8# x#) .&. (I8# y#) = I8# (narrowInt8# ((extendInt8# x#) `andI#` (extendInt8# y#)))
+ (I8# x#) .|. (I8# y#) = I8# (narrowInt8# ((extendInt8# x#) `orI#` (extendInt8# y#)))
+ (I8# x#) `xor` (I8# y#) = I8# (narrowInt8# ((extendInt8# x#) `xorI#` (extendInt8# y#)))
+ complement (I8# x#) = I8# (narrowInt8# (notI# (extendInt8# x#)))
(I8# x#) `shift` (I# i#)
- | isTrue# (i# >=# 0#) = I8# (narrow8Int# (x# `iShiftL#` i#))
- | otherwise = I8# (x# `iShiftRA#` negateInt# i#)
+ | isTrue# (i# >=# 0#) = I8# (narrowInt8# ((extendInt8# x#) `iShiftL#` i#))
+ | otherwise = I8# (narrowInt8# ((extendInt8# x#) `iShiftRA#` negateInt# i#))
(I8# x#) `shiftL` (I# i#)
- | isTrue# (i# >=# 0#) = I8# (narrow8Int# (x# `iShiftL#` i#))
+ | isTrue# (i# >=# 0#) = I8# (narrowInt8# ((extendInt8# x#) `iShiftL#` i#))
| otherwise = overflowError
- (I8# x#) `unsafeShiftL` (I# i#) = I8# (narrow8Int# (x# `uncheckedIShiftL#` i#))
+ (I8# x#) `unsafeShiftL` (I# i#) = I8# (narrowInt8# ((extendInt8# x#) `uncheckedIShiftL#` i#))
(I8# x#) `shiftR` (I# i#)
- | isTrue# (i# >=# 0#) = I8# (x# `iShiftRA#` i#)
+ | isTrue# (i# >=# 0#) = I8# (narrowInt8# ((extendInt8# x#) `iShiftRA#` i#))
| otherwise = overflowError
- (I8# x#) `unsafeShiftR` (I# i#) = I8# (x# `uncheckedIShiftRA#` i#)
+ (I8# x#) `unsafeShiftR` (I# i#) = I8# (narrowInt8# ((extendInt8# x#) `uncheckedIShiftRA#` i#))
(I8# x#) `rotate` (I# i#)
| isTrue# (i'# ==# 0#)
= I8# x#
| otherwise
- = I8# (narrow8Int# (word2Int# ((x'# `uncheckedShiftL#` i'#) `or#`
+ = I8# (narrowInt8# (word2Int# ((x'# `uncheckedShiftL#` i'#) `or#`
(x'# `uncheckedShiftRL#` (8# -# i'#)))))
where
- !x'# = narrow8Word# (int2Word# x#)
+ !x'# = narrow8Word# (int2Word# (extendInt8# x#))
!i'# = word2Int# (int2Word# i# `and#` 7##)
bitSizeMaybe i = Just (finiteBitSize i)
bitSize i = finiteBitSize i
isSigned _ = True
- popCount (I8# x#) = I# (word2Int# (popCnt8# (int2Word# x#)))
+ popCount (I8# x#) = I# (word2Int# (popCnt8# (int2Word# (extendInt8# x#))))
bit = bitDefault
testBit = testBitDefault
@@ -220,13 +220,13 @@ instance FiniteBits Int8 where
{-# INLINE countLeadingZeros #-}
{-# INLINE countTrailingZeros #-}
finiteBitSize _ = 8
- countLeadingZeros (I8# x#) = I# (word2Int# (clz8# (int2Word# x#)))
- countTrailingZeros (I8# x#) = I# (word2Int# (ctz8# (int2Word# x#)))
+ countLeadingZeros (I8# x#) = I# (word2Int# (clz8# (int2Word# (extendInt8# x#))))
+ countTrailingZeros (I8# x#) = I# (word2Int# (ctz8# (int2Word# (extendInt8# x#))))
{-# RULES
"fromIntegral/Int8->Int8" fromIntegral = id :: Int8 -> Int8
-"fromIntegral/a->Int8" fromIntegral = \x -> case fromIntegral x of I# x# -> I8# (narrow8Int# x#)
-"fromIntegral/Int8->a" fromIntegral = \(I8# x#) -> fromIntegral (I# x#)
+"fromIntegral/a->Int8" fromIntegral = \x -> case fromIntegral x of I# x# -> I8# (narrowInt8# x#)
+"fromIntegral/Int8->a" fromIntegral = \(I8# x#) -> fromIntegral (I# (extendInt8# x#))
#-}
{-# RULES
@@ -266,7 +266,7 @@ instance FiniteBits Int8 where
-- Int16 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 "HsInt16" #-} Int16 = I16# Int#
+data {-# CTYPE "HsInt16" #-} Int16 = I16# Int16#
-- ^ 16-bit signed integer type
-- See GHC.Classes#matching_overloaded_methods_in_rules
@@ -276,8 +276,8 @@ instance Eq Int16 where
(/=) = neInt16
eqInt16, neInt16 :: Int16 -> Int16 -> Bool
-eqInt16 (I16# x) (I16# y) = isTrue# (x ==# y)
-neInt16 (I16# x) (I16# y) = isTrue# (x /=# y)
+eqInt16 (I16# x) (I16# y) = isTrue# ((extendInt16# x) ==# (extendInt16# y))
+neInt16 (I16# x) (I16# y) = isTrue# ((extendInt16# x) /=# (extendInt16# y))
{-# INLINE [1] eqInt16 #-}
{-# INLINE [1] neInt16 #-}
@@ -293,10 +293,10 @@ instance Ord Int16 where
{-# INLINE [1] ltInt16 #-}
{-# INLINE [1] leInt16 #-}
gtInt16, geInt16, ltInt16, leInt16 :: Int16 -> Int16 -> Bool
-(I16# x) `gtInt16` (I16# y) = isTrue# (x ># y)
-(I16# x) `geInt16` (I16# y) = isTrue# (x >=# y)
-(I16# x) `ltInt16` (I16# y) = isTrue# (x <# y)
-(I16# x) `leInt16` (I16# y) = isTrue# (x <=# y)
+(I16# x) `gtInt16` (I16# y) = isTrue# ((extendInt16# x) ># (extendInt16# y))
+(I16# x) `geInt16` (I16# y) = isTrue# ((extendInt16# x) >=# (extendInt16# y))
+(I16# x) `ltInt16` (I16# y) = isTrue# ((extendInt16# x) <# (extendInt16# y))
+(I16# x) `leInt16` (I16# y) = isTrue# ((extendInt16# x) <=# (extendInt16# y))
-- | @since 2.01
instance Show Int16 where
@@ -304,16 +304,16 @@ instance Show Int16 where
-- | @since 2.01
instance Num Int16 where
- (I16# x#) + (I16# y#) = I16# (narrow16Int# (x# +# y#))
- (I16# x#) - (I16# y#) = I16# (narrow16Int# (x# -# y#))
- (I16# x#) * (I16# y#) = I16# (narrow16Int# (x# *# y#))
- negate (I16# x#) = I16# (narrow16Int# (negateInt# x#))
+ (I16# x#) + (I16# y#) = I16# (narrowInt16# ((extendInt16# x#) +# (extendInt16# y#)))
+ (I16# x#) - (I16# y#) = I16# (narrowInt16# ((extendInt16# x#) -# (extendInt16# y#)))
+ (I16# x#) * (I16# y#) = I16# (narrowInt16# ((extendInt16# x#) *# (extendInt16# y#)))
+ negate (I16# x#) = I16# (narrowInt16# (negateInt# (extendInt16# x#)))
abs x | x >= 0 = x
| otherwise = negate x
signum x | x > 0 = 1
signum 0 = 0
signum _ = -1
- fromInteger i = I16# (narrow16Int# (integerToInt# i))
+ fromInteger i = I16# (narrowInt16# (integerToInt# i))
-- | @since 2.01
instance Real Int16 where
@@ -329,9 +329,9 @@ instance Enum Int16 where
| otherwise = predError "Int16"
toEnum i@(I# i#)
| i >= fromIntegral (minBound::Int16) && i <= fromIntegral (maxBound::Int16)
- = I16# i#
+ = I16# (narrowInt16# i#)
| otherwise = toEnumError "Int16" i (minBound::Int16, maxBound::Int16)
- fromEnum (I16# x#) = I# x#
+ fromEnum (I16# x#) = I# (extendInt16# x#)
enumFrom = boundedEnumFrom
enumFromThen = boundedEnumFromThen
@@ -340,34 +340,34 @@ 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# (narrow16Int# (x# `quotInt#` y#))
+ | otherwise = I16# (narrowInt16# ((extendInt16# x#) `quotInt#` (extendInt16# y#)))
rem (I16# x#) y@(I16# y#)
| y == 0 = divZeroError
- | otherwise = I16# (narrow16Int# (x# `remInt#` y#))
+ | otherwise = I16# (narrowInt16# ((extendInt16# x#) `remInt#` (extendInt16# y#)))
div x@(I16# x#) y@(I16# y#)
| y == 0 = divZeroError
| y == (-1) && x == minBound = overflowError -- Note [Order of tests]
- | otherwise = I16# (narrow16Int# (x# `divInt#` y#))
+ | otherwise = I16# (narrowInt16# ((extendInt16# x#) `divInt#` (extendInt16# y#)))
mod (I16# x#) y@(I16# y#)
| y == 0 = divZeroError
- | otherwise = I16# (narrow16Int# (x# `modInt#` y#))
+ | otherwise = I16# (narrowInt16# ((extendInt16# x#) `modInt#` (extendInt16# y#)))
quotRem x@(I16# x#) y@(I16# y#)
| y == 0 = divZeroError
-- Note [Order of tests]
| y == (-1) && x == minBound = (overflowError, 0)
- | otherwise = case x# `quotRemInt#` y# of
+ | otherwise = case (extendInt16# x#) `quotRemInt#` (extendInt16# y#) of
(# q, r #) ->
- (I16# (narrow16Int# q),
- I16# (narrow16Int# r))
+ (I16# (narrowInt16# q),
+ I16# (narrowInt16# r))
divMod x@(I16# x#) y@(I16# y#)
| y == 0 = divZeroError
-- Note [Order of tests]
| y == (-1) && x == minBound = (overflowError, 0)
- | otherwise = case x# `divModInt#` y# of
+ | otherwise = case (extendInt16# x#) `divModInt#` (extendInt16# y#) of
(# d, m #) ->
- (I16# (narrow16Int# d),
- I16# (narrow16Int# m))
- toInteger (I16# x#) = IS x#
+ (I16# (narrowInt16# d),
+ I16# (narrowInt16# m))
+ toInteger (I16# x#) = IS (extendInt16# x#)
-- | @since 2.01
instance Bounded Int16 where
@@ -391,34 +391,34 @@ instance Bits Int16 where
{-# INLINE testBit #-}
{-# INLINE popCount #-}
- (I16# x#) .&. (I16# y#) = I16# (x# `andI#` y#)
- (I16# x#) .|. (I16# y#) = I16# (x# `orI#` y#)
- (I16# x#) `xor` (I16# y#) = I16# (x# `xorI#` y#)
- complement (I16# x#) = I16# (notI# x#)
+ (I16# x#) .&. (I16# y#) = I16# (narrowInt16# ((extendInt16# x#) `andI#` (extendInt16# y#)))
+ (I16# x#) .|. (I16# y#) = I16# (narrowInt16# ((extendInt16# x#) `orI#` (extendInt16# y#)))
+ (I16# x#) `xor` (I16# y#) = I16# (narrowInt16# ((extendInt16# x#) `xorI#` (extendInt16# y#)))
+ complement (I16# x#) = I16# (narrowInt16# (notI# (extendInt16# x#)))
(I16# x#) `shift` (I# i#)
- | isTrue# (i# >=# 0#) = I16# (narrow16Int# (x# `iShiftL#` i#))
- | otherwise = I16# (x# `iShiftRA#` negateInt# i#)
+ | isTrue# (i# >=# 0#) = I16# (narrowInt16# ((extendInt16# x#) `iShiftL#` i#))
+ | otherwise = I16# (narrowInt16# ((extendInt16# x#) `iShiftRA#` negateInt# i#))
(I16# x#) `shiftL` (I# i#)
- | isTrue# (i# >=# 0#) = I16# (narrow16Int# (x# `iShiftL#` i#))
+ | isTrue# (i# >=# 0#) = I16# (narrowInt16# ((extendInt16# x#) `iShiftL#` i#))
| otherwise = overflowError
- (I16# x#) `unsafeShiftL` (I# i#) = I16# (narrow16Int# (x# `uncheckedIShiftL#` i#))
+ (I16# x#) `unsafeShiftL` (I# i#) = I16# (narrowInt16# ((extendInt16# x#) `uncheckedIShiftL#` i#))
(I16# x#) `shiftR` (I# i#)
- | isTrue# (i# >=# 0#) = I16# (x# `iShiftRA#` i#)
+ | isTrue# (i# >=# 0#) = I16# (narrowInt16# ((extendInt16# x#) `iShiftRA#` i#))
| otherwise = overflowError
- (I16# x#) `unsafeShiftR` (I# i#) = I16# (x# `uncheckedIShiftRA#` i#)
+ (I16# x#) `unsafeShiftR` (I# i#) = I16# (narrowInt16# ((extendInt16# x#) `uncheckedIShiftRA#` i#))
(I16# x#) `rotate` (I# i#)
| isTrue# (i'# ==# 0#)
= I16# x#
| otherwise
- = I16# (narrow16Int# (word2Int# ((x'# `uncheckedShiftL#` i'#) `or#`
+ = I16# (narrowInt16# (word2Int# ((x'# `uncheckedShiftL#` i'#) `or#`
(x'# `uncheckedShiftRL#` (16# -# i'#)))))
where
- !x'# = narrow16Word# (int2Word# x#)
+ !x'# = narrow16Word# (int2Word# (extendInt16# x#))
!i'# = word2Int# (int2Word# i# `and#` 15##)
bitSizeMaybe i = Just (finiteBitSize i)
bitSize i = finiteBitSize i
isSigned _ = True
- popCount (I16# x#) = I# (word2Int# (popCnt16# (int2Word# x#)))
+ popCount (I16# x#) = I# (word2Int# (popCnt16# (int2Word# (extendInt16# x#))))
bit = bitDefault
testBit = testBitDefault
@@ -427,15 +427,15 @@ instance FiniteBits Int16 where
{-# INLINE countLeadingZeros #-}
{-# INLINE countTrailingZeros #-}
finiteBitSize _ = 16
- countLeadingZeros (I16# x#) = I# (word2Int# (clz16# (int2Word# x#)))
- countTrailingZeros (I16# x#) = I# (word2Int# (ctz16# (int2Word# x#)))
+ countLeadingZeros (I16# x#) = I# (word2Int# (clz16# (int2Word# (extendInt16# x#))))
+ countTrailingZeros (I16# x#) = I# (word2Int# (ctz16# (int2Word# (extendInt16# x#))))
{-# RULES
-"fromIntegral/Word8->Int16" fromIntegral = \(W8# x#) -> I16# (word2Int# x#)
-"fromIntegral/Int8->Int16" fromIntegral = \(I8# x#) -> I16# x#
+"fromIntegral/Word8->Int16" fromIntegral = \(W8# x#) -> I16# (narrowInt16# (word2Int# (extendWord8# x#)))
+"fromIntegral/Int8->Int16" fromIntegral = \(I8# x#) -> I16# (narrowInt16# (extendInt8# x#))
"fromIntegral/Int16->Int16" fromIntegral = id :: Int16 -> Int16
-"fromIntegral/a->Int16" fromIntegral = \x -> case fromIntegral x of I# x# -> I16# (narrow16Int# x#)
-"fromIntegral/Int16->a" fromIntegral = \(I16# x#) -> fromIntegral (I# x#)
+"fromIntegral/a->Int16" fromIntegral = \x -> case fromIntegral x of I# x# -> I16# (narrowInt16# x#)
+"fromIntegral/Int16->a" fromIntegral = \(I16# x#) -> fromIntegral (I# (extendInt16# x#))
#-}
{-# RULES
@@ -478,7 +478,7 @@ instance FiniteBits Int16 where
-- from its logical range.
#endif
-data {-# CTYPE "HsInt32" #-} Int32 = I32# Int#
+data {-# CTYPE "HsInt32" #-} Int32 = I32# Int32#
-- ^ 32-bit signed integer type
-- See GHC.Classes#matching_overloaded_methods_in_rules
@@ -488,8 +488,8 @@ instance Eq Int32 where
(/=) = neInt32
eqInt32, neInt32 :: Int32 -> Int32 -> Bool
-eqInt32 (I32# x) (I32# y) = isTrue# (x ==# y)
-neInt32 (I32# x) (I32# y) = isTrue# (x /=# y)
+eqInt32 (I32# x) (I32# y) = isTrue# ((extendInt32# x) ==# (extendInt32# y))
+neInt32 (I32# x) (I32# y) = isTrue# ((extendInt32# x) /=# (extendInt32# y))
{-# INLINE [1] eqInt32 #-}
{-# INLINE [1] neInt32 #-}
@@ -505,10 +505,10 @@ instance Ord Int32 where
{-# INLINE [1] ltInt32 #-}
{-# INLINE [1] leInt32 #-}
gtInt32, geInt32, ltInt32, leInt32 :: Int32 -> Int32 -> Bool
-(I32# x) `gtInt32` (I32# y) = isTrue# (x ># y)
-(I32# x) `geInt32` (I32# y) = isTrue# (x >=# y)
-(I32# x) `ltInt32` (I32# y) = isTrue# (x <# y)
-(I32# x) `leInt32` (I32# y) = isTrue# (x <=# y)
+(I32# x) `gtInt32` (I32# y) = isTrue# ((extendInt32# x) ># (extendInt32# y))
+(I32# x) `geInt32` (I32# y) = isTrue# ((extendInt32# x) >=# (extendInt32# y))
+(I32# x) `ltInt32` (I32# y) = isTrue# ((extendInt32# x) <# (extendInt32# y))
+(I32# x) `leInt32` (I32# y) = isTrue# ((extendInt32# x) <=# (extendInt32# y))
-- | @since 2.01
instance Show Int32 where
@@ -516,16 +516,16 @@ instance Show Int32 where
-- | @since 2.01
instance Num Int32 where
- (I32# x#) + (I32# y#) = I32# (narrow32Int# (x# +# y#))
- (I32# x#) - (I32# y#) = I32# (narrow32Int# (x# -# y#))
- (I32# x#) * (I32# y#) = I32# (narrow32Int# (x# *# y#))
- negate (I32# x#) = I32# (narrow32Int# (negateInt# x#))
+ (I32# x#) + (I32# y#) = I32# (narrowInt32# ((extendInt32# x#) +# (extendInt32# y#)))
+ (I32# x#) - (I32# y#) = I32# (narrowInt32# ((extendInt32# x#) -# (extendInt32# y#)))
+ (I32# x#) * (I32# y#) = I32# (narrowInt32# ((extendInt32# x#) *# (extendInt32# y#)))
+ negate (I32# x#) = I32# (narrowInt32# (negateInt# (extendInt32# x#)))
abs x | x >= 0 = x
| otherwise = negate x
signum x | x > 0 = 1
signum 0 = 0
signum _ = -1
- fromInteger i = I32# (narrow32Int# (integerToInt# i))
+ fromInteger i = I32# (narrowInt32# (integerToInt# i))
-- | @since 2.01
instance Enum Int32 where
@@ -536,14 +536,14 @@ instance Enum Int32 where
| x /= minBound = x - 1
| otherwise = predError "Int32"
#if WORD_SIZE_IN_BITS == 32
- toEnum (I# i#) = I32# i#
+ toEnum (I# i#) = I32# (narrowInt32# i#)
#else
toEnum i@(I# i#)
| i >= fromIntegral (minBound::Int32) && i <= fromIntegral (maxBound::Int32)
- = I32# i#
+ = I32# (narrowInt32# i#)
| otherwise = toEnumError "Int32" i (minBound::Int32, maxBound::Int32)
#endif
- fromEnum (I32# x#) = I# x#
+ fromEnum (I32# x#) = I# (extendInt32# x#)
enumFrom = boundedEnumFrom
enumFromThen = boundedEnumFromThen
@@ -552,42 +552,42 @@ 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# (narrow32Int# (x# `quotInt#` y#))
+ | otherwise = I32# (narrowInt32# ((extendInt32# x#) `quotInt#` (extendInt32# y#)))
rem (I32# x#) y@(I32# y#)
| y == 0 = divZeroError
-- The quotRem CPU instruction fails for minBound `quotRem` -1,
-- but minBound `rem` -1 is well-defined (0). We therefore
-- special-case it.
| y == (-1) = 0
- | otherwise = I32# (narrow32Int# (x# `remInt#` y#))
+ | otherwise = I32# (narrowInt32# ((extendInt32# x#) `remInt#` (extendInt32# y#)))
div x@(I32# x#) y@(I32# y#)
| y == 0 = divZeroError
| y == (-1) && x == minBound = overflowError -- Note [Order of tests]
- | otherwise = I32# (narrow32Int# (x# `divInt#` y#))
+ | otherwise = I32# (narrowInt32# ((extendInt32# x#) `divInt#` (extendInt32# y#)))
mod (I32# x#) y@(I32# y#)
| y == 0 = divZeroError
-- The divMod CPU instruction fails for minBound `divMod` -1,
-- but minBound `mod` -1 is well-defined (0). We therefore
-- special-case it.
| y == (-1) = 0
- | otherwise = I32# (narrow32Int# (x# `modInt#` y#))
+ | otherwise = I32# (narrowInt32# ((extendInt32# x#) `modInt#` (extendInt32# y#)))
quotRem x@(I32# x#) y@(I32# y#)
| y == 0 = divZeroError
-- Note [Order of tests]
| y == (-1) && x == minBound = (overflowError, 0)
- | otherwise = case x# `quotRemInt#` y# of
+ | otherwise = case (extendInt32# x#) `quotRemInt#` (extendInt32# y#) of
(# q, r #) ->
- (I32# (narrow32Int# q),
- I32# (narrow32Int# r))
+ (I32# (narrowInt32# q),
+ I32# (narrowInt32# r))
divMod x@(I32# x#) y@(I32# y#)
| y == 0 = divZeroError
-- Note [Order of tests]
| y == (-1) && x == minBound = (overflowError, 0)
- | otherwise = case x# `divModInt#` y# of
+ | otherwise = case (extendInt32# x#) `divModInt#` (extendInt32# y#) of
(# d, m #) ->
- (I32# (narrow32Int# d),
- I32# (narrow32Int# m))
- toInteger (I32# x#) = IS x#
+ (I32# (narrowInt32# d),
+ I32# (narrowInt32# m))
+ toInteger (I32# x#) = IS (extendInt32# x#)
-- | @since 2.01
instance Read Int32 where
@@ -600,35 +600,35 @@ instance Bits Int32 where
{-# INLINE testBit #-}
{-# INLINE popCount #-}
- (I32# x#) .&. (I32# y#) = I32# (x# `andI#` y#)
- (I32# x#) .|. (I32# y#) = I32# (x# `orI#` y#)
- (I32# x#) `xor` (I32# y#) = I32# (x# `xorI#` y#)
- complement (I32# x#) = I32# (notI# x#)
+ (I32# x#) .&. (I32# y#) = I32# (narrowInt32# ((extendInt32# x#) `andI#` (extendInt32# y#)))
+ (I32# x#) .|. (I32# y#) = I32# (narrowInt32# ((extendInt32# x#) `orI#` (extendInt32# y#)))
+ (I32# x#) `xor` (I32# y#) = I32# (narrowInt32# ((extendInt32# x#) `xorI#` (extendInt32# y#)))
+ complement (I32# x#) = I32# (narrowInt32# (notI# (extendInt32# x#)))
(I32# x#) `shift` (I# i#)
- | isTrue# (i# >=# 0#) = I32# (narrow32Int# (x# `iShiftL#` i#))
- | otherwise = I32# (x# `iShiftRA#` negateInt# i#)
+ | isTrue# (i# >=# 0#) = I32# (narrowInt32# ((extendInt32# x#) `iShiftL#` i#))
+ | otherwise = I32# (narrowInt32# ((extendInt32# x#) `iShiftRA#` negateInt# i#))
(I32# x#) `shiftL` (I# i#)
- | isTrue# (i# >=# 0#) = I32# (narrow32Int# (x# `iShiftL#` i#))
+ | isTrue# (i# >=# 0#) = I32# (narrowInt32# ((extendInt32# x#) `iShiftL#` i#))
| otherwise = overflowError
(I32# x#) `unsafeShiftL` (I# i#) =
- I32# (narrow32Int# (x# `uncheckedIShiftL#` i#))
+ I32# (narrowInt32# ((extendInt32# x#) `uncheckedIShiftL#` i#))
(I32# x#) `shiftR` (I# i#)
- | isTrue# (i# >=# 0#) = I32# (x# `iShiftRA#` i#)
+ | isTrue# (i# >=# 0#) = I32# (narrowInt32# ((extendInt32# x#) `iShiftRA#` i#))
| otherwise = overflowError
- (I32# x#) `unsafeShiftR` (I# i#) = I32# (x# `uncheckedIShiftRA#` i#)
+ (I32# x#) `unsafeShiftR` (I# i#) = I32# (narrowInt32# ((extendInt32# x#) `uncheckedIShiftRA#` i#))
(I32# x#) `rotate` (I# i#)
| isTrue# (i'# ==# 0#)
= I32# x#
| otherwise
- = I32# (narrow32Int# (word2Int# ((x'# `uncheckedShiftL#` i'#) `or#`
+ = I32# (narrowInt32# (word2Int# ((x'# `uncheckedShiftL#` i'#) `or#`
(x'# `uncheckedShiftRL#` (32# -# i'#)))))
where
- !x'# = narrow32Word# (int2Word# x#)
+ !x'# = narrow32Word# (int2Word# (extendInt32# x#))
!i'# = word2Int# (int2Word# i# `and#` 31##)
bitSizeMaybe i = Just (finiteBitSize i)
bitSize i = finiteBitSize i
isSigned _ = True
- popCount (I32# x#) = I# (word2Int# (popCnt32# (int2Word# x#)))
+ popCount (I32# x#) = I# (word2Int# (popCnt32# (int2Word# (extendInt32# x#))))
bit = bitDefault
testBit = testBitDefault
@@ -637,17 +637,17 @@ instance FiniteBits Int32 where
{-# INLINE countLeadingZeros #-}
{-# INLINE countTrailingZeros #-}
finiteBitSize _ = 32
- countLeadingZeros (I32# x#) = I# (word2Int# (clz32# (int2Word# x#)))
- countTrailingZeros (I32# x#) = I# (word2Int# (ctz32# (int2Word# x#)))
+ countLeadingZeros (I32# x#) = I# (word2Int# (clz32# (int2Word# (extendInt32# x#))))
+ countTrailingZeros (I32# x#) = I# (word2Int# (ctz32# (int2Word# (extendInt32# x#))))
{-# RULES
-"fromIntegral/Word8->Int32" fromIntegral = \(W8# x#) -> I32# (word2Int# x#)
-"fromIntegral/Word16->Int32" fromIntegral = \(W16# x#) -> I32# (word2Int# x#)
-"fromIntegral/Int8->Int32" fromIntegral = \(I8# x#) -> I32# x#
-"fromIntegral/Int16->Int32" fromIntegral = \(I16# x#) -> I32# x#
+"fromIntegral/Word8->Int32" fromIntegral = \(W8# x#) -> I32# (narrowInt32# (word2Int# (extendWord8# x#)))
+"fromIntegral/Word16->Int32" fromIntegral = \(W16# x#) -> I32# (narrowInt32# (word2Int# (extendWord16# x#)))
+"fromIntegral/Int8->Int32" fromIntegral = \(I8# x#) -> I32# (narrowInt32# (extendInt8# x#))
+"fromIntegral/Int16->Int32" fromIntegral = \(I16# x#) -> I32# (narrowInt32# (extendInt16# x#))
"fromIntegral/Int32->Int32" fromIntegral = id :: Int32 -> Int32
-"fromIntegral/a->Int32" fromIntegral = \x -> case fromIntegral x of I# x# -> I32# (narrow32Int# x#)
-"fromIntegral/Int32->a" fromIntegral = \(I32# x#) -> fromIntegral (I# x#)
+"fromIntegral/a->Int32" fromIntegral = \x -> case fromIntegral x of I# x# -> I32# (narrowInt32# x#)
+"fromIntegral/Int32->a" fromIntegral = \(I32# x#) -> fromIntegral (I# (extendInt32# x#))
#-}
{-# RULES
diff --git a/libraries/base/GHC/Storable.hs b/libraries/base/GHC/Storable.hs
index d9b9382211..359c136b2b 100644
--- a/libraries/base/GHC/Storable.hs
+++ b/libraries/base/GHC/Storable.hs
@@ -91,17 +91,17 @@ readDoubleOffPtr (Ptr a) (I# i)
readStablePtrOffPtr (Ptr a) (I# i)
= IO $ \s -> case readStablePtrOffAddr# a i s of (# s2, x #) -> (# s2, StablePtr x #)
readInt8OffPtr (Ptr a) (I# i)
- = IO $ \s -> case readInt8OffAddr# a i s of (# s2, x #) -> (# s2, I8# x #)
+ = IO $ \s -> case readInt8OffAddr# a i s of (# s2, x #) -> (# s2, I8# (narrowInt8# x) #)
readWord8OffPtr (Ptr a) (I# i)
- = IO $ \s -> case readWord8OffAddr# a i s of (# s2, x #) -> (# s2, W8# x #)
+ = IO $ \s -> case readWord8OffAddr# a i s of (# s2, x #) -> (# s2, W8# (narrowWord8# x) #)
readInt16OffPtr (Ptr a) (I# i)
- = IO $ \s -> case readInt16OffAddr# a i s of (# s2, x #) -> (# s2, I16# x #)
+ = IO $ \s -> case readInt16OffAddr# a i s of (# s2, x #) -> (# s2, I16# (narrowInt16# x) #)
readWord16OffPtr (Ptr a) (I# i)
- = IO $ \s -> case readWord16OffAddr# a i s of (# s2, x #) -> (# s2, W16# x #)
+ = IO $ \s -> case readWord16OffAddr# a i s of (# s2, x #) -> (# s2, W16# (narrowWord16# x) #)
readInt32OffPtr (Ptr a) (I# i)
- = IO $ \s -> case readInt32OffAddr# a i s of (# s2, x #) -> (# s2, I32# x #)
+ = IO $ \s -> case readInt32OffAddr# a i s of (# s2, x #) -> (# s2, I32# (narrowInt32# x) #)
readWord32OffPtr (Ptr a) (I# i)
- = IO $ \s -> case readWord32OffAddr# a i s of (# s2, x #) -> (# s2, W32# x #)
+ = IO $ \s -> case readWord32OffAddr# a i s of (# s2, x #) -> (# s2, W32# (narrowWord32# x) #)
readInt64OffPtr (Ptr a) (I# i)
= IO $ \s -> case readInt64OffAddr# a i s of (# s2, x #) -> (# s2, I64# x #)
readWord64OffPtr (Ptr a) (I# i)
@@ -141,17 +141,17 @@ writeDoubleOffPtr (Ptr a) (I# i) (D# x)
writeStablePtrOffPtr (Ptr a) (I# i) (StablePtr x)
= IO $ \s -> case writeStablePtrOffAddr# a i x s of s2 -> (# s2 , () #)
writeInt8OffPtr (Ptr a) (I# i) (I8# x)
- = IO $ \s -> case writeInt8OffAddr# a i x s of s2 -> (# s2, () #)
+ = IO $ \s -> case writeInt8OffAddr# a i (extendInt8# x) s of s2 -> (# s2, () #)
writeWord8OffPtr (Ptr a) (I# i) (W8# x)
- = IO $ \s -> case writeWord8OffAddr# a i x s of s2 -> (# s2, () #)
+ = IO $ \s -> case writeWord8OffAddr# a i (extendWord8# x) s of s2 -> (# s2, () #)
writeInt16OffPtr (Ptr a) (I# i) (I16# x)
- = IO $ \s -> case writeInt16OffAddr# a i x s of s2 -> (# s2, () #)
+ = IO $ \s -> case writeInt16OffAddr# a i (extendInt16# x) s of s2 -> (# s2, () #)
writeWord16OffPtr (Ptr a) (I# i) (W16# x)
- = IO $ \s -> case writeWord16OffAddr# a i x s of s2 -> (# s2, () #)
+ = IO $ \s -> case writeWord16OffAddr# a i (extendWord16# x) s of s2 -> (# s2, () #)
writeInt32OffPtr (Ptr a) (I# i) (I32# x)
- = IO $ \s -> case writeInt32OffAddr# a i x s of s2 -> (# s2, () #)
+ = IO $ \s -> case writeInt32OffAddr# a i (extendInt32# x) s of s2 -> (# s2, () #)
writeWord32OffPtr (Ptr a) (I# i) (W32# x)
- = IO $ \s -> case writeWord32OffAddr# a i x s of s2 -> (# s2, () #)
+ = IO $ \s -> case writeWord32OffAddr# a i (extendWord32# x) s of s2 -> (# s2, () #)
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)
diff --git a/libraries/base/GHC/Word.hs b/libraries/base/GHC/Word.hs
index 75ed7d1f73..4ff2cc4837 100644
--- a/libraries/base/GHC/Word.hs
+++ b/libraries/base/GHC/Word.hs
@@ -67,7 +67,10 @@ import GHC.Show
-- Word8 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 "HsWord8" #-} Word8 = W8# Word#
+data {-# CTYPE "HsWord8" #-} Word8
+ = W8# Word8#
+
+
-- ^ 8-bit unsigned integer type
-- See GHC.Classes#matching_overloaded_methods_in_rules
@@ -77,8 +80,8 @@ instance Eq Word8 where
(/=) = neWord8
eqWord8, neWord8 :: Word8 -> Word8 -> Bool
-eqWord8 (W8# x) (W8# y) = isTrue# (x `eqWord#` y)
-neWord8 (W8# x) (W8# y) = isTrue# (x `neWord#` y)
+eqWord8 (W8# x) (W8# y) = isTrue# ((extendWord8# x) `eqWord#` (extendWord8# y))
+neWord8 (W8# x) (W8# y) = isTrue# ((extendWord8# x) `neWord#` (extendWord8# y))
{-# INLINE [1] eqWord8 #-}
{-# INLINE [1] neWord8 #-}
@@ -94,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# (x `gtWord#` y)
-(W8# x) `geWord8` (W8# y) = isTrue# (x `geWord#` y)
-(W8# x) `ltWord8` (W8# y) = isTrue# (x `ltWord#` y)
-(W8# x) `leWord8` (W8# y) = isTrue# (x `leWord#` y)
+(W8# x) `gtWord8` (W8# y) = isTrue# ((extendWord8# x) `gtWord#` (extendWord8# y))
+(W8# x) `geWord8` (W8# y) = isTrue# ((extendWord8# x) `geWord#` (extendWord8# y))
+(W8# x) `ltWord8` (W8# y) = isTrue# ((extendWord8# x) `ltWord#` (extendWord8# y))
+(W8# x) `leWord8` (W8# y) = isTrue# ((extendWord8# x) `leWord#` (extendWord8# y))
-- | @since 2.01
instance Show Word8 where
@@ -105,14 +108,14 @@ instance Show Word8 where
-- | @since 2.01
instance Num Word8 where
- (W8# x#) + (W8# y#) = W8# (narrow8Word# (x# `plusWord#` y#))
- (W8# x#) - (W8# y#) = W8# (narrow8Word# (x# `minusWord#` y#))
- (W8# x#) * (W8# y#) = W8# (narrow8Word# (x# `timesWord#` y#))
- negate (W8# x#) = W8# (narrow8Word# (int2Word# (negateInt# (word2Int# x#))))
+ (W8# x#) + (W8# y#) = W8# (narrowWord8# ((extendWord8# x#) `plusWord#` (extendWord8# y#)))
+ (W8# x#) - (W8# y#) = W8# (narrowWord8# ((extendWord8# x#) `minusWord#` (extendWord8# y#)))
+ (W8# x#) * (W8# y#) = W8# (narrowWord8# ((extendWord8# x#) `timesWord#` (extendWord8# y#)))
+ negate (W8# x#) = W8# (narrowWord8# (int2Word# (negateInt# (word2Int# ((extendWord8# x#))))))
abs x = x
signum 0 = 0
signum _ = 1
- fromInteger i = W8# (narrow8Word# (integerToWord# i))
+ fromInteger i = W8# (narrowWord8# (integerToWord# i))
-- | @since 2.01
instance Real Word8 where
@@ -128,35 +131,36 @@ instance Enum Word8 where
| otherwise = predError "Word8"
toEnum i@(I# i#)
| i >= 0 && i <= fromIntegral (maxBound::Word8)
- = W8# (int2Word# i#)
+ = W8# (narrowWord8# (int2Word# i#))
| otherwise = toEnumError "Word8" i (minBound::Word8, maxBound::Word8)
- fromEnum (W8# x#) = I# (word2Int# x#)
+ fromEnum (W8# x#) = I# (word2Int# (extendWord8# x#))
enumFrom = boundedEnumFrom
enumFromThen = boundedEnumFromThen
-- | @since 2.01
instance Integral Word8 where
quot (W8# x#) y@(W8# y#)
- | y /= 0 = W8# (x# `quotWord#` y#)
+ | y /= 0 = W8# (narrowWord8# ((extendWord8# x#) `quotWord#` (extendWord8# y#)))
| otherwise = divZeroError
rem (W8# x#) y@(W8# y#)
- | y /= 0 = W8# (x# `remWord#` y#)
+ | y /= 0 = W8# (narrowWord8# ((extendWord8# x#) `remWord#` (extendWord8# y#)))
| otherwise = divZeroError
div (W8# x#) y@(W8# y#)
- | y /= 0 = W8# (x# `quotWord#` y#)
+ | y /= 0 = W8# (narrowWord8# ((extendWord8# x#) `quotWord#` (extendWord8# y#)))
| otherwise = divZeroError
mod (W8# x#) y@(W8# y#)
- | y /= 0 = W8# (x# `remWord#` y#)
+ | y /= 0 = W8# (narrowWord8# ((extendWord8# x#) `remWord#` (extendWord8# y#)))
| otherwise = divZeroError
quotRem (W8# x#) y@(W8# y#)
- | y /= 0 = case x# `quotRemWord#` y# of
+ | y /= 0 = case (extendWord8# x#) `quotRemWord#` (extendWord8# y#) of
(# q, r #) ->
- (W8# q, W8# r)
+ (W8# (narrowWord8# q), W8# (narrowWord8# r))
| otherwise = divZeroError
divMod (W8# x#) y@(W8# y#)
- | y /= 0 = (W8# (x# `quotWord#` y#), W8# (x# `remWord#` y#))
+ | y /= 0 = (W8# (narrowWord8# ((extendWord8# x#) `quotWord#` (extendWord8# y#)))
+ ,W8# (narrowWord8# ((extendWord8# x#) `remWord#` (extendWord8# y#))))
| otherwise = divZeroError
- toInteger (W8# x#) = IS (word2Int# x#)
+ toInteger (W8# x#) = IS (word2Int# (extendWord8# x#))
-- | @since 2.01
instance Bounded Word8 where
@@ -176,33 +180,32 @@ instance Bits Word8 where
{-# INLINE testBit #-}
{-# INLINE popCount #-}
- (W8# x#) .&. (W8# y#) = W8# (x# `and#` y#)
- (W8# x#) .|. (W8# y#) = W8# (x# `or#` y#)
- (W8# x#) `xor` (W8# y#) = W8# (x# `xor#` y#)
- complement (W8# x#) = W8# (x# `xor#` mb#)
- where !(W8# mb#) = maxBound
+ (W8# x#) .&. (W8# y#) = W8# (narrowWord8# ((extendWord8# x#) `and#` (extendWord8# y#)))
+ (W8# x#) .|. (W8# y#) = W8# (narrowWord8# ((extendWord8# x#) `or#` (extendWord8# y#)))
+ (W8# x#) `xor` (W8# y#) = W8# (narrowWord8# ((extendWord8# x#) `xor#` (extendWord8# y#)))
+ complement (W8# x#) = W8# (narrowWord8# (not# (extendWord8# x#)))
(W8# x#) `shift` (I# i#)
- | isTrue# (i# >=# 0#) = W8# (narrow8Word# (x# `shiftL#` i#))
- | otherwise = W8# (x# `shiftRL#` negateInt# i#)
+ | isTrue# (i# >=# 0#) = W8# (narrowWord8# ((extendWord8# x#) `shiftL#` i#))
+ | otherwise = W8# (narrowWord8# ((extendWord8# x#) `shiftRL#` negateInt# i#))
(W8# x#) `shiftL` (I# i#)
- | isTrue# (i# >=# 0#) = W8# (narrow8Word# (x# `shiftL#` i#))
+ | isTrue# (i# >=# 0#) = W8# (narrowWord8# ((extendWord8# x#) `shiftL#` i#))
| otherwise = overflowError
(W8# x#) `unsafeShiftL` (I# i#) =
- W8# (narrow8Word# (x# `uncheckedShiftL#` i#))
+ W8# (narrowWord8# ((extendWord8# x#) `uncheckedShiftL#` i#))
(W8# x#) `shiftR` (I# i#)
- | isTrue# (i# >=# 0#) = W8# (x# `shiftRL#` i#)
+ | isTrue# (i# >=# 0#) = W8# (narrowWord8# ((extendWord8# x#) `shiftRL#` i#))
| otherwise = overflowError
- (W8# x#) `unsafeShiftR` (I# i#) = W8# (x# `uncheckedShiftRL#` i#)
+ (W8# x#) `unsafeShiftR` (I# i#) = W8# (narrowWord8# ((extendWord8# x#) `uncheckedShiftRL#` i#))
(W8# x#) `rotate` (I# i#)
| isTrue# (i'# ==# 0#) = W8# x#
- | otherwise = W8# (narrow8Word# ((x# `uncheckedShiftL#` i'#) `or#`
- (x# `uncheckedShiftRL#` (8# -# i'#))))
+ | otherwise = W8# (narrowWord8# (((extendWord8# x#) `uncheckedShiftL#` i'#) `or#`
+ ((extendWord8# x#) `uncheckedShiftRL#` (8# -# i'#))))
where
!i'# = word2Int# (int2Word# i# `and#` 7##)
bitSizeMaybe i = Just (finiteBitSize i)
bitSize i = finiteBitSize i
isSigned _ = False
- popCount (W8# x#) = I# (word2Int# (popCnt8# x#))
+ popCount (W8# x#) = I# (word2Int# (popCnt8# (extendWord8# x#)))
bit = bitDefault
testBit = testBitDefault
@@ -211,14 +214,14 @@ instance FiniteBits Word8 where
{-# INLINE countLeadingZeros #-}
{-# INLINE countTrailingZeros #-}
finiteBitSize _ = 8
- countLeadingZeros (W8# x#) = I# (word2Int# (clz8# x#))
- countTrailingZeros (W8# x#) = I# (word2Int# (ctz8# x#))
+ countLeadingZeros (W8# x#) = I# (word2Int# (clz8# (extendWord8# x#)))
+ countTrailingZeros (W8# x#) = I# (word2Int# (ctz8# (extendWord8# x#)))
{-# RULES
"fromIntegral/Word8->Word8" fromIntegral = id :: Word8 -> Word8
"fromIntegral/Word8->Integer" fromIntegral = toInteger :: Word8 -> Integer
-"fromIntegral/a->Word8" fromIntegral = \x -> case fromIntegral x of W# x# -> W8# (narrow8Word# x#)
-"fromIntegral/Word8->a" fromIntegral = \(W8# x#) -> fromIntegral (W# x#)
+"fromIntegral/a->Word8" fromIntegral = \x -> case fromIntegral x of W# x# -> W8# (narrowWord8# x#)
+"fromIntegral/Word8->a" fromIntegral = \(W8# x#) -> fromIntegral (W# (extendWord8# x#))
#-}
{-# RULES
@@ -258,7 +261,7 @@ instance FiniteBits Word8 where
-- Word16 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 "HsWord16" #-} Word16 = W16# Word#
+data {-# CTYPE "HsWord16" #-} Word16 = W16# Word16#
-- ^ 16-bit unsigned integer type
-- See GHC.Classes#matching_overloaded_methods_in_rules
@@ -268,8 +271,8 @@ instance Eq Word16 where
(/=) = neWord16
eqWord16, neWord16 :: Word16 -> Word16 -> Bool
-eqWord16 (W16# x) (W16# y) = isTrue# (x `eqWord#` y)
-neWord16 (W16# x) (W16# y) = isTrue# (x `neWord#` y)
+eqWord16 (W16# x) (W16# y) = isTrue# ((extendWord16# x) `eqWord#` (extendWord16# y))
+neWord16 (W16# x) (W16# y) = isTrue# ((extendWord16# x) `neWord#` (extendWord16# y))
{-# INLINE [1] eqWord16 #-}
{-# INLINE [1] neWord16 #-}
@@ -285,10 +288,10 @@ instance Ord Word16 where
{-# INLINE [1] ltWord16 #-}
{-# INLINE [1] leWord16 #-}
gtWord16, geWord16, ltWord16, leWord16 :: Word16 -> Word16 -> Bool
-(W16# x) `gtWord16` (W16# y) = isTrue# (x `gtWord#` y)
-(W16# x) `geWord16` (W16# y) = isTrue# (x `geWord#` y)
-(W16# x) `ltWord16` (W16# y) = isTrue# (x `ltWord#` y)
-(W16# x) `leWord16` (W16# y) = isTrue# (x `leWord#` y)
+(W16# x) `gtWord16` (W16# y) = isTrue# ((extendWord16# x) `gtWord#` (extendWord16# y))
+(W16# x) `geWord16` (W16# y) = isTrue# ((extendWord16# x) `geWord#` (extendWord16# y))
+(W16# x) `ltWord16` (W16# y) = isTrue# ((extendWord16# x) `ltWord#` (extendWord16# y))
+(W16# x) `leWord16` (W16# y) = isTrue# ((extendWord16# x) `leWord#` (extendWord16# y))
-- | @since 2.01
instance Show Word16 where
@@ -296,14 +299,14 @@ instance Show Word16 where
-- | @since 2.01
instance Num Word16 where
- (W16# x#) + (W16# y#) = W16# (narrow16Word# (x# `plusWord#` y#))
- (W16# x#) - (W16# y#) = W16# (narrow16Word# (x# `minusWord#` y#))
- (W16# x#) * (W16# y#) = W16# (narrow16Word# (x# `timesWord#` y#))
- negate (W16# x#) = W16# (narrow16Word# (int2Word# (negateInt# (word2Int# x#))))
+ (W16# x#) + (W16# y#) = W16# (narrowWord16# ((extendWord16# x#) `plusWord#` (extendWord16# y#)))
+ (W16# x#) - (W16# y#) = W16# (narrowWord16# ((extendWord16# x#) `minusWord#` (extendWord16# y#)))
+ (W16# x#) * (W16# y#) = W16# (narrowWord16# ((extendWord16# x#) `timesWord#` (extendWord16# y#)))
+ negate (W16# x#) = W16# (narrowWord16# (int2Word# (negateInt# (word2Int# (extendWord16# x#)))))
abs x = x
signum 0 = 0
signum _ = 1
- fromInteger i = W16# (narrow16Word# (integerToWord# i))
+ fromInteger i = W16# (narrowWord16# (integerToWord# i))
-- | @since 2.01
instance Real Word16 where
@@ -319,35 +322,36 @@ instance Enum Word16 where
| otherwise = predError "Word16"
toEnum i@(I# i#)
| i >= 0 && i <= fromIntegral (maxBound::Word16)
- = W16# (int2Word# i#)
+ = W16# (narrowWord16# (int2Word# i#))
| otherwise = toEnumError "Word16" i (minBound::Word16, maxBound::Word16)
- fromEnum (W16# x#) = I# (word2Int# x#)
+ fromEnum (W16# x#) = I# (word2Int# (extendWord16# x#))
enumFrom = boundedEnumFrom
enumFromThen = boundedEnumFromThen
-- | @since 2.01
instance Integral Word16 where
quot (W16# x#) y@(W16# y#)
- | y /= 0 = W16# (x# `quotWord#` y#)
+ | y /= 0 = W16# (narrowWord16# ((extendWord16# x#) `quotWord#` (extendWord16# y#)))
| otherwise = divZeroError
rem (W16# x#) y@(W16# y#)
- | y /= 0 = W16# (x# `remWord#` y#)
+ | y /= 0 = W16# (narrowWord16# ((extendWord16# x#) `remWord#` (extendWord16# y#)))
| otherwise = divZeroError
div (W16# x#) y@(W16# y#)
- | y /= 0 = W16# (x# `quotWord#` y#)
+ | y /= 0 = W16# (narrowWord16# ((extendWord16# x#) `quotWord#` (extendWord16# y#)))
| otherwise = divZeroError
mod (W16# x#) y@(W16# y#)
- | y /= 0 = W16# (x# `remWord#` y#)
+ | y /= 0 = W16# (narrowWord16# ((extendWord16# x#) `remWord#` (extendWord16# y#)))
| otherwise = divZeroError
quotRem (W16# x#) y@(W16# y#)
- | y /= 0 = case x# `quotRemWord#` y# of
+ | y /= 0 = case (extendWord16# x#) `quotRemWord#` (extendWord16# y#) of
(# q, r #) ->
- (W16# q, W16# r)
+ (W16# (narrowWord16# q), W16# (narrowWord16# r))
| otherwise = divZeroError
divMod (W16# x#) y@(W16# y#)
- | y /= 0 = (W16# (x# `quotWord#` y#), W16# (x# `remWord#` y#))
+ | y /= 0 = (W16# (narrowWord16# ((extendWord16# x#) `quotWord#` (extendWord16# y#)))
+ ,W16# (narrowWord16# ((extendWord16# x#) `remWord#` (extendWord16# y#))))
| otherwise = divZeroError
- toInteger (W16# x#) = IS (word2Int# x#)
+ toInteger (W16# x#) = IS (word2Int# (extendWord16# x#))
-- | @since 2.01
instance Bounded Word16 where
@@ -367,33 +371,32 @@ instance Bits Word16 where
{-# INLINE testBit #-}
{-# INLINE popCount #-}
- (W16# x#) .&. (W16# y#) = W16# (x# `and#` y#)
- (W16# x#) .|. (W16# y#) = W16# (x# `or#` y#)
- (W16# x#) `xor` (W16# y#) = W16# (x# `xor#` y#)
- complement (W16# x#) = W16# (x# `xor#` mb#)
- where !(W16# mb#) = maxBound
+ (W16# x#) .&. (W16# y#) = W16# (narrowWord16# ((extendWord16# x#) `and#` (extendWord16# y#)))
+ (W16# x#) .|. (W16# y#) = W16# (narrowWord16# ((extendWord16# x#) `or#` (extendWord16# y#)))
+ (W16# x#) `xor` (W16# y#) = W16# (narrowWord16# ((extendWord16# x#) `xor#` (extendWord16# y#)))
+ complement (W16# x#) = W16# (narrowWord16# (not# (extendWord16# x#)))
(W16# x#) `shift` (I# i#)
- | isTrue# (i# >=# 0#) = W16# (narrow16Word# (x# `shiftL#` i#))
- | otherwise = W16# (x# `shiftRL#` negateInt# i#)
+ | isTrue# (i# >=# 0#) = W16# (narrowWord16# ((extendWord16# x#) `shiftL#` i#))
+ | otherwise = W16# (narrowWord16# ((extendWord16# x#) `shiftRL#` negateInt# i#))
(W16# x#) `shiftL` (I# i#)
- | isTrue# (i# >=# 0#) = W16# (narrow16Word# (x# `shiftL#` i#))
+ | isTrue# (i# >=# 0#) = W16# (narrowWord16# ((extendWord16# x#) `shiftL#` i#))
| otherwise = overflowError
(W16# x#) `unsafeShiftL` (I# i#) =
- W16# (narrow16Word# (x# `uncheckedShiftL#` i#))
+ W16# (narrowWord16# ((extendWord16# x#) `uncheckedShiftL#` i#))
(W16# x#) `shiftR` (I# i#)
- | isTrue# (i# >=# 0#) = W16# (x# `shiftRL#` i#)
+ | isTrue# (i# >=# 0#) = W16# (narrowWord16# ((extendWord16# x#) `shiftRL#` i#))
| otherwise = overflowError
- (W16# x#) `unsafeShiftR` (I# i#) = W16# (x# `uncheckedShiftRL#` i#)
+ (W16# x#) `unsafeShiftR` (I# i#) = W16# (narrowWord16# ((extendWord16# x#) `uncheckedShiftRL#` i#))
(W16# x#) `rotate` (I# i#)
| isTrue# (i'# ==# 0#) = W16# x#
- | otherwise = W16# (narrow16Word# ((x# `uncheckedShiftL#` i'#) `or#`
- (x# `uncheckedShiftRL#` (16# -# i'#))))
+ | otherwise = W16# (narrowWord16# (((extendWord16# x#) `uncheckedShiftL#` i'#) `or#`
+ ((extendWord16# x#) `uncheckedShiftRL#` (16# -# i'#))))
where
!i'# = word2Int# (int2Word# i# `and#` 15##)
bitSizeMaybe i = Just (finiteBitSize i)
bitSize i = finiteBitSize i
isSigned _ = False
- popCount (W16# x#) = I# (word2Int# (popCnt16# x#))
+ popCount (W16# x#) = I# (word2Int# (popCnt16# (extendWord16# x#)))
bit = bitDefault
testBit = testBitDefault
@@ -402,21 +405,21 @@ instance FiniteBits Word16 where
{-# INLINE countLeadingZeros #-}
{-# INLINE countTrailingZeros #-}
finiteBitSize _ = 16
- countLeadingZeros (W16# x#) = I# (word2Int# (clz16# x#))
- countTrailingZeros (W16# x#) = I# (word2Int# (ctz16# x#))
+ countLeadingZeros (W16# x#) = I# (word2Int# (clz16# (extendWord16# x#)))
+ countTrailingZeros (W16# x#) = I# (word2Int# (ctz16# (extendWord16# x#)))
-- | Reverse order of bytes in 'Word16'.
--
-- @since 4.7.0.0
byteSwap16 :: Word16 -> Word16
-byteSwap16 (W16# w#) = W16# (narrow16Word# (byteSwap16# w#))
+byteSwap16 (W16# w#) = W16# (narrowWord16# (byteSwap16# (extendWord16# w#)))
{-# RULES
-"fromIntegral/Word8->Word16" fromIntegral = \(W8# x#) -> W16# x#
+"fromIntegral/Word8->Word16" fromIntegral = \(W8# x#) -> W16# (narrowWord16# (extendWord8# x#))
"fromIntegral/Word16->Word16" fromIntegral = id :: Word16 -> Word16
"fromIntegral/Word16->Integer" fromIntegral = toInteger :: Word16 -> Integer
-"fromIntegral/a->Word16" fromIntegral = \x -> case fromIntegral x of W# x# -> W16# (narrow16Word# x#)
-"fromIntegral/Word16->a" fromIntegral = \(W16# x#) -> fromIntegral (W# x#)
+"fromIntegral/a->Word16" fromIntegral = \x -> case fromIntegral x of W# x# -> W16# (narrowWord16# x#)
+"fromIntegral/Word16->a" fromIntegral = \(W16# x#) -> fromIntegral (W# (extendWord16# x#))
#-}
{-# RULES
@@ -492,7 +495,7 @@ byteSwap16 (W16# w#) = W16# (narrow16Word# (byteSwap16# w#))
#endif
-data {-# CTYPE "HsWord32" #-} Word32 = W32# Word#
+data {-# CTYPE "HsWord32" #-} Word32 = W32# Word32#
-- ^ 32-bit unsigned integer type
-- See GHC.Classes#matching_overloaded_methods_in_rules
@@ -502,8 +505,8 @@ instance Eq Word32 where
(/=) = neWord32
eqWord32, neWord32 :: Word32 -> Word32 -> Bool
-eqWord32 (W32# x) (W32# y) = isTrue# (x `eqWord#` y)
-neWord32 (W32# x) (W32# y) = isTrue# (x `neWord#` y)
+eqWord32 (W32# x) (W32# y) = isTrue# ((extendWord32# x) `eqWord#` (extendWord32# y))
+neWord32 (W32# x) (W32# y) = isTrue# ((extendWord32# x) `neWord#` (extendWord32# y))
{-# INLINE [1] eqWord32 #-}
{-# INLINE [1] neWord32 #-}
@@ -519,21 +522,21 @@ instance Ord Word32 where
{-# INLINE [1] ltWord32 #-}
{-# INLINE [1] leWord32 #-}
gtWord32, geWord32, ltWord32, leWord32 :: Word32 -> Word32 -> Bool
-(W32# x) `gtWord32` (W32# y) = isTrue# (x `gtWord#` y)
-(W32# x) `geWord32` (W32# y) = isTrue# (x `geWord#` y)
-(W32# x) `ltWord32` (W32# y) = isTrue# (x `ltWord#` y)
-(W32# x) `leWord32` (W32# y) = isTrue# (x `leWord#` y)
+(W32# x) `gtWord32` (W32# y) = isTrue# ((extendWord32# x) `gtWord#` (extendWord32# y))
+(W32# x) `geWord32` (W32# y) = isTrue# ((extendWord32# x) `geWord#` (extendWord32# y))
+(W32# x) `ltWord32` (W32# y) = isTrue# ((extendWord32# x) `ltWord#` (extendWord32# y))
+(W32# x) `leWord32` (W32# y) = isTrue# ((extendWord32# x) `leWord#` (extendWord32# y))
-- | @since 2.01
instance Num Word32 where
- (W32# x#) + (W32# y#) = W32# (narrow32Word# (x# `plusWord#` y#))
- (W32# x#) - (W32# y#) = W32# (narrow32Word# (x# `minusWord#` y#))
- (W32# x#) * (W32# y#) = W32# (narrow32Word# (x# `timesWord#` y#))
- negate (W32# x#) = W32# (narrow32Word# (int2Word# (negateInt# (word2Int# x#))))
+ (W32# x#) + (W32# y#) = W32# (narrowWord32# ((extendWord32# x#) `plusWord#` (extendWord32# y#)))
+ (W32# x#) - (W32# y#) = W32# (narrowWord32# ((extendWord32# x#) `minusWord#` (extendWord32# y#)))
+ (W32# x#) * (W32# y#) = W32# (narrowWord32# ((extendWord32# x#) `timesWord#` (extendWord32# y#)))
+ negate (W32# x#) = W32# (narrowWord32# (int2Word# (negateInt# (word2Int# (extendWord32# x#)))))
abs x = x
signum 0 = 0
signum _ = 1
- fromInteger i = W32# (narrow32Word# (integerToWord# i))
+ fromInteger i = W32# (narrowWord32# (integerToWord# i))
-- | @since 2.01
instance Enum Word32 where
@@ -548,19 +551,19 @@ instance Enum Word32 where
#if WORD_SIZE_IN_BITS > 32
&& i <= fromIntegral (maxBound::Word32)
#endif
- = W32# (int2Word# i#)
+ = W32# (narrowWord32# (int2Word# i#))
| otherwise = toEnumError "Word32" i (minBound::Word32, maxBound::Word32)
#if WORD_SIZE_IN_BITS == 32
fromEnum x@(W32# x#)
| x <= fromIntegral (maxBound::Int)
- = I# (word2Int# x#)
+ = I# (word2Int# (extendWord32# x#))
| otherwise = fromEnumError "Word32" x
enumFrom = integralEnumFrom
enumFromThen = integralEnumFromThen
enumFromTo = integralEnumFromTo
enumFromThenTo = integralEnumFromThenTo
#else
- fromEnum (W32# x#) = I# (word2Int# x#)
+ fromEnum (W32# x#) = I# (word2Int# (extendWord32# x#))
enumFrom = boundedEnumFrom
enumFromThen = boundedEnumFromThen
#endif
@@ -568,33 +571,34 @@ instance Enum Word32 where
-- | @since 2.01
instance Integral Word32 where
quot (W32# x#) y@(W32# y#)
- | y /= 0 = W32# (x# `quotWord#` y#)
+ | y /= 0 = W32# (narrowWord32# ((extendWord32# x#) `quotWord#` (extendWord32# y#)))
| otherwise = divZeroError
rem (W32# x#) y@(W32# y#)
- | y /= 0 = W32# (x# `remWord#` y#)
+ | y /= 0 = W32# (narrowWord32# ((extendWord32# x#) `remWord#` (extendWord32# y#)))
| otherwise = divZeroError
div (W32# x#) y@(W32# y#)
- | y /= 0 = W32# (x# `quotWord#` y#)
+ | y /= 0 = W32# (narrowWord32# ((extendWord32# x#) `quotWord#` (extendWord32# y#)))
| otherwise = divZeroError
mod (W32# x#) y@(W32# y#)
- | y /= 0 = W32# (x# `remWord#` y#)
+ | y /= 0 = W32# (narrowWord32# ((extendWord32# x#) `remWord#` (extendWord32# y#)))
| otherwise = divZeroError
quotRem (W32# x#) y@(W32# y#)
- | y /= 0 = case x# `quotRemWord#` y# of
+ | y /= 0 = case (extendWord32# x#) `quotRemWord#` (extendWord32# y#) of
(# q, r #) ->
- (W32# q, W32# r)
+ (W32# (narrowWord32# q), W32# (narrowWord32# r))
| otherwise = divZeroError
divMod (W32# x#) y@(W32# y#)
- | y /= 0 = (W32# (x# `quotWord#` y#), W32# (x# `remWord#` y#))
+ | y /= 0 = (W32# (narrowWord32# ((extendWord32# x#) `quotWord#` (extendWord32# y#)))
+ ,W32# (narrowWord32# ((extendWord32# x#) `remWord#` (extendWord32# y#))))
| otherwise = divZeroError
toInteger (W32# x#)
#if WORD_SIZE_IN_BITS == 32
| isTrue# (i# >=# 0#) = IS i#
- | otherwise = integerFromWord# x#
+ | otherwise = integerFromWord# (extendWord32# x#)
where
- !i# = word2Int# x#
+ !i# = word2Int# (extendWord32# x#)
#else
- = IS (word2Int# x#)
+ = IS (word2Int# (extendWord32# x#))
#endif
-- | @since 2.01
@@ -604,33 +608,32 @@ instance Bits Word32 where
{-# INLINE testBit #-}
{-# INLINE popCount #-}
- (W32# x#) .&. (W32# y#) = W32# (x# `and#` y#)
- (W32# x#) .|. (W32# y#) = W32# (x# `or#` y#)
- (W32# x#) `xor` (W32# y#) = W32# (x# `xor#` y#)
- complement (W32# x#) = W32# (x# `xor#` mb#)
- where !(W32# mb#) = maxBound
+ (W32# x#) .&. (W32# y#) = W32# (narrowWord32# ((extendWord32# x#) `and#` (extendWord32# y#)))
+ (W32# x#) .|. (W32# y#) = W32# (narrowWord32# ((extendWord32# x#) `or#` (extendWord32# y#)))
+ (W32# x#) `xor` (W32# y#) = W32# (narrowWord32# ((extendWord32# x#) `xor#` (extendWord32# y#)))
+ complement (W32# x#) = W32# (narrowWord32# (not# (extendWord32# x#)))
(W32# x#) `shift` (I# i#)
- | isTrue# (i# >=# 0#) = W32# (narrow32Word# (x# `shiftL#` i#))
- | otherwise = W32# (x# `shiftRL#` negateInt# i#)
+ | isTrue# (i# >=# 0#) = W32# (narrowWord32# ((extendWord32# x#) `shiftL#` i#))
+ | otherwise = W32# (narrowWord32# ((extendWord32# x#) `shiftRL#` negateInt# i#))
(W32# x#) `shiftL` (I# i#)
- | isTrue# (i# >=# 0#) = W32# (narrow32Word# (x# `shiftL#` i#))
+ | isTrue# (i# >=# 0#) = W32# (narrowWord32# ((extendWord32# x#) `shiftL#` i#))
| otherwise = overflowError
(W32# x#) `unsafeShiftL` (I# i#) =
- W32# (narrow32Word# (x# `uncheckedShiftL#` i#))
+ W32# (narrowWord32# ((extendWord32# x#) `uncheckedShiftL#` i#))
(W32# x#) `shiftR` (I# i#)
- | isTrue# (i# >=# 0#) = W32# (x# `shiftRL#` i#)
+ | isTrue# (i# >=# 0#) = W32# (narrowWord32# ((extendWord32# x#) `shiftRL#` i#))
| otherwise = overflowError
- (W32# x#) `unsafeShiftR` (I# i#) = W32# (x# `uncheckedShiftRL#` i#)
+ (W32# x#) `unsafeShiftR` (I# i#) = W32# (narrowWord32# ((extendWord32# x#) `uncheckedShiftRL#` i#))
(W32# x#) `rotate` (I# i#)
| isTrue# (i'# ==# 0#) = W32# x#
- | otherwise = W32# (narrow32Word# ((x# `uncheckedShiftL#` i'#) `or#`
- (x# `uncheckedShiftRL#` (32# -# i'#))))
+ | otherwise = W32# (narrowWord32# (((extendWord32# x#) `uncheckedShiftL#` i'#) `or#`
+ ((extendWord32# x#) `uncheckedShiftRL#` (32# -# i'#))))
where
!i'# = word2Int# (int2Word# i# `and#` 31##)
bitSizeMaybe i = Just (finiteBitSize i)
bitSize i = finiteBitSize i
isSigned _ = False
- popCount (W32# x#) = I# (word2Int# (popCnt32# x#))
+ popCount (W32# x#) = I# (word2Int# (popCnt32# (extendWord32# x#)))
bit = bitDefault
testBit = testBitDefault
@@ -639,16 +642,16 @@ instance FiniteBits Word32 where
{-# INLINE countLeadingZeros #-}
{-# INLINE countTrailingZeros #-}
finiteBitSize _ = 32
- countLeadingZeros (W32# x#) = I# (word2Int# (clz32# x#))
- countTrailingZeros (W32# x#) = I# (word2Int# (ctz32# x#))
+ countLeadingZeros (W32# x#) = I# (word2Int# (clz32# (extendWord32# x#)))
+ countTrailingZeros (W32# x#) = I# (word2Int# (ctz32# (extendWord32# x#)))
{-# RULES
-"fromIntegral/Word8->Word32" fromIntegral = \(W8# x#) -> W32# x#
-"fromIntegral/Word16->Word32" fromIntegral = \(W16# x#) -> W32# x#
+"fromIntegral/Word8->Word32" fromIntegral = \(W8# x#) -> W32# (narrowWord32# (extendWord8# x#))
+"fromIntegral/Word16->Word32" fromIntegral = \(W16# x#) -> W32# (narrowWord32# (extendWord16# x#))
"fromIntegral/Word32->Word32" fromIntegral = id :: Word32 -> Word32
"fromIntegral/Word32->Integer" fromIntegral = toInteger :: Word32 -> Integer
-"fromIntegral/a->Word32" fromIntegral = \x -> case fromIntegral x of W# x# -> W32# (narrow32Word# x#)
-"fromIntegral/Word32->a" fromIntegral = \(W32# x#) -> fromIntegral (W# x#)
+"fromIntegral/a->Word32" fromIntegral = \x -> case fromIntegral x of W# x# -> W32# (narrowWord32# x#)
+"fromIntegral/Word32->a" fromIntegral = \(W32# x#) -> fromIntegral (W# (extendWord32# x#))
#-}
-- | @since 2.01
@@ -679,7 +682,7 @@ instance Ix Word32 where
--
-- @since 4.7.0.0
byteSwap32 :: Word32 -> Word32
-byteSwap32 (W32# w#) = W32# (narrow32Word# (byteSwap32# w#))
+byteSwap32 (W32# w#) = W32# (narrowWord32# (byteSwap32# (extendWord32# w#)))
------------------------------------------------------------------------
-- type Word64
@@ -969,8 +972,7 @@ instance Bits Word64 where
(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# (x# `xor#` mb#)
- where !(W64# mb#) = maxBound
+ complement (W64# x#) = W64# (not# x#)
(W64# x#) `shift` (I# i#)
| isTrue# (i# >=# 0#) = W64# (x# `shiftL#` i#)
| otherwise = W64# (x# `shiftRL#` negateInt# i#)
@@ -1050,19 +1052,19 @@ byteSwap64 (W64# w#) = W64# (byteSwap# w#)
--
-- @since 4.12.0.0
bitReverse8 :: Word8 -> Word8
-bitReverse8 (W8# w#) = W8# (narrow8Word# (bitReverse8# w#))
+bitReverse8 (W8# w#) = W8# (narrowWord8# (bitReverse8# (extendWord8# w#)))
-- | Reverse the order of the bits in a 'Word16'.
--
-- @since 4.12.0.0
bitReverse16 :: Word16 -> Word16
-bitReverse16 (W16# w#) = W16# (narrow16Word# (bitReverse16# w#))
+bitReverse16 (W16# w#) = W16# (narrowWord16# (bitReverse16# (extendWord16# w#)))
-- | Reverse the order of the bits in a 'Word32'.
--
-- @since 4.12.0.0
bitReverse32 :: Word32 -> Word32
-bitReverse32 (W32# w#) = W32# (narrow32Word# (bitReverse32# w#))
+bitReverse32 (W32# w#) = W32# (narrowWord32# (bitReverse32# (extendWord32# w#)))
-- | Reverse the order of the bits in a 'Word64'.
--
diff --git a/libraries/base/base.cabal b/libraries/base/base.cabal
index 5da92855f7..f620affcbf 100644
--- a/libraries/base/base.cabal
+++ b/libraries/base/base.cabal
@@ -88,7 +88,7 @@ Library
build-depends:
rts == 1.0,
- ghc-prim >= 0.5.1.0 && < 0.8,
+ ghc-prim >= 0.5.1.0 && < 0.9,
ghc-bignum >= 1.0 && < 2.0
exposed-modules:
diff --git a/libraries/binary b/libraries/binary
-Subproject dfaf780596328c9184758452b78288e8f405fcc
+Subproject b224410161f112dd1133a787ded9831799589ce
diff --git a/libraries/bytestring b/libraries/bytestring
-Subproject e043aacfc4202a59ccae8b8c8cf0e1ad83a3f20
+Subproject 8b5d8d0da24aefdc4d950174bf396b32335d7e0
diff --git a/libraries/ghc-bignum/ghc-bignum.cabal b/libraries/ghc-bignum/ghc-bignum.cabal
index bc478cf108..b1d600bd15 100644
--- a/libraries/ghc-bignum/ghc-bignum.cabal
+++ b/libraries/ghc-bignum/ghc-bignum.cabal
@@ -77,7 +77,7 @@ library
ForeignFunctionInterface
build-depends:
- ghc-prim >= 0.5.1.0 && < 0.8
+ ghc-prim >= 0.5.1.0 && < 0.9
hs-source-dirs: src/
include-dirs: include/
diff --git a/libraries/ghc-compact/ghc-compact.cabal b/libraries/ghc-compact/ghc-compact.cabal
index 4c55e09e4e..7ddb956355 100644
--- a/libraries/ghc-compact/ghc-compact.cabal
+++ b/libraries/ghc-compact/ghc-compact.cabal
@@ -36,7 +36,7 @@ library
UnboxedTuples
CPP
- build-depends: ghc-prim >= 0.5.3 && < 0.8,
+ build-depends: ghc-prim >= 0.5.3 && < 0.9,
base >= 4.9.0 && < 4.17,
bytestring >= 0.10.6.0
ghc-options: -Wall
diff --git a/libraries/ghc-heap/ghc-heap.cabal.in b/libraries/ghc-heap/ghc-heap.cabal.in
index a80d9f7ad3..e0f15abd3f 100644
--- a/libraries/ghc-heap/ghc-heap.cabal.in
+++ b/libraries/ghc-heap/ghc-heap.cabal.in
@@ -23,7 +23,7 @@ library
default-language: Haskell2010
build-depends: base >= 4.9.0 && < 5.0
- , ghc-prim > 0.2 && < 0.8
+ , ghc-prim > 0.2 && < 0.9
, rts == 1.0.*
ghc-options: -Wall
diff --git a/libraries/ghc-prim/ghc-prim.cabal b/libraries/ghc-prim/ghc-prim.cabal
index bca9225023..05fd60f09a 100644
--- a/libraries/ghc-prim/ghc-prim.cabal
+++ b/libraries/ghc-prim/ghc-prim.cabal
@@ -1,6 +1,6 @@
cabal-version: 2.2
name: ghc-prim
-version: 0.7.0
+version: 0.8.0
-- NOTE: Don't forget to update ./changelog.md
license: BSD-3-Clause
license-file: LICENSE
diff --git a/libraries/ghci/GHCi/BreakArray.hs b/libraries/ghci/GHCi/BreakArray.hs
index a0f9d03bdc..05d13bda67 100644
--- a/libraries/ghci/GHCi/BreakArray.hs
+++ b/libraries/ghci/GHCi/BreakArray.hs
@@ -32,10 +32,20 @@ import Control.Monad
import Data.Word
import GHC.Word
-import GHC.Exts
+import GHC.Exts hiding (extendWord8#, narrowWord8#)
import GHC.IO ( IO(..) )
import System.IO.Unsafe ( unsafeDupablePerformIO )
+#if MIN_VERSION_base(4,16,0)
+import GHC.Base (extendWord8#, narrowWord8#)
+#else
+narrowWord8#, extendWord8# :: Word# -> Word#
+narrowWord8# w = w
+extendWord8# w = w
+{-# INLINE narrowWord8# #-}
+{-# INLINE extendWord8# #-}
+#endif
+
data BreakArray = BA (MutableByteArray# RealWorld)
breakOff, breakOn :: Word8
@@ -96,7 +106,7 @@ newBreakArray entries@(I# sz) = do
case breakOff of
W8# off -> do
let loop n | isTrue# (n ==# sz) = return ()
- | otherwise = do writeBA# array n off; loop (n +# 1#)
+ | otherwise = do writeBA# array n (extendWord8# off); loop (n +# 1#)
loop 0#
return $ BA array
@@ -105,11 +115,11 @@ writeBA# array i word = IO $ \s ->
case writeWord8Array# array i word s of { s -> (# s, () #) }
writeBreakArray :: BreakArray -> Int -> Word8 -> IO ()
-writeBreakArray (BA array) (I# i) (W8# word) = writeBA# array i word
+writeBreakArray (BA array) (I# i) (W8# word) = writeBA# array i (extendWord8# word)
readBA# :: MutableByteArray# RealWorld -> Int# -> IO Word8
readBA# array i = IO $ \s ->
- case readWord8Array# array i s of { (# s, c #) -> (# s, W8# c #) }
+ case readWord8Array# array i s of { (# s, c #) -> (# s, W8# (narrowWord8# c) #) }
readBreakArray :: BreakArray -> Int -> IO Word8
readBreakArray (BA array) (I# i) = readBA# array i
diff --git a/libraries/ghci/ghci.cabal.in b/libraries/ghci/ghci.cabal.in
index e33b703b49..39ba3ccbe7 100644
--- a/libraries/ghci/ghci.cabal.in
+++ b/libraries/ghci/ghci.cabal.in
@@ -73,6 +73,7 @@ library
Build-Depends:
array == 0.5.*,
base >= 4.8 && < 4.17,
+ ghc-prim >= 0.5.0 && < 0.9,
binary == 0.8.*,
bytestring == 0.10.*,
containers >= 0.5 && < 0.7,
diff --git a/libraries/text b/libraries/text
-Subproject 80cb9ee2eb7141171171318bbd6760fe8001252
+Subproject f1a2e141a79ebc0a57ab2d641db00cef3ff60a4
diff --git a/rts/Libdw.c b/rts/Libdw.c
index 9619479313..25399a00fe 100644
--- a/rts/Libdw.c
+++ b/rts/Libdw.c
@@ -133,6 +133,11 @@ int libdwLookupLocation(LibdwSession *session, Location *frame,
Dwfl_Module *mod = dwfl_addrmodule(session->dwfl, addr);
if (mod == NULL)
return 1;
+ // avoid unaligned pointer value
+ // Using &frame->object_file as argument to dwfl_module_info leads to
+ //
+ // error: taking address of packed member of ‘struct Location_’ may result in an unaligned pointer value [-Werror=address-of-packed-member]
+ //
void *object_file = &frame->object_file;
dwfl_module_info(mod, NULL, NULL, NULL, NULL, NULL,
object_file, NULL);
diff --git a/testsuite/driver/testlib.py b/testsuite/driver/testlib.py
index 4828df9736..cfc65d38d6 100644
--- a/testsuite/driver/testlib.py
+++ b/testsuite/driver/testlib.py
@@ -2163,7 +2163,7 @@ def normalise_callstacks(s: str) -> str:
s = re.sub(r'CallStack \(from -prof\):(\n .*)*\n?', '', s)
return s
-tyCon_re = re.compile(r'TyCon\s*\d+L?\#\#\s*\d+L?\#\#\s*', flags=re.MULTILINE)
+tyCon_re = re.compile(r'TyCon\s*\d+L?\#\#(64)?\s*\d+L?\#\#(64)?\s*', flags=re.MULTILINE)
def normalise_type_reps(s: str) -> str:
""" Normalise out fingerprints from Typeable TyCon representations """
diff --git a/testsuite/tests/array/should_run/arr020.hs b/testsuite/tests/array/should_run/arr020.hs
index bb025eff03..db715b054e 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# w# s# of
+ = ST $ \s# -> case writeWord32Array# mba# i# (extendWord32# w#) s# of
s'# -> (# s'#, () #)
indexArray :: ByteArray Word32 -> Int -> Word32
indexArray (ByteArray arr#) (I# i#)
- = W32# (indexWord32Array# arr# i#)
+ = W32# (narrowWord32# (indexWord32Array# arr# i#))
unsafeFreezeByteArray :: MutableByteArray s -> ST s (ByteArray e)
unsafeFreezeByteArray (MutableByteArray mba#)
@@ -68,7 +68,7 @@ unsafeFreezeArrayArray (MutableArrayArray marrs#)
(# s'#, arrs# #) -> (# s'#, ArrayArray arrs# #)
unsafeDeepFreezeArrayArray :: forall s e
- . MutableArrayArray s (MutableByteArray s)
+ . MutableArrayArray s (MutableByteArray s)
-> ST s (ArrayArray (ByteArray e))
unsafeDeepFreezeArrayArray marrs@(MutableArrayArray marrs#)
= do { let n = I# (sizeofMutableArrayArray# marrs#)
@@ -112,7 +112,7 @@ newUnboxedArray2D values
}
unboxedArray2D :: UnboxedArray2D Word32
-unboxedArray2D
+unboxedArray2D
= newUnboxedArray2D
[ [1..10]
, [11..200]
@@ -125,7 +125,7 @@ indexUnboxedArray2D :: UnboxedArray2D Word32 -> (Int, Int) -> Word32
indexUnboxedArray2D arr (i, j)
= indexArrayArray arr i `indexArray` j
-main
+main
= do { print $ unboxedArray2D `indexUnboxedArray2D` (3, 1000)
; performGC
; print $ unboxedArray2D `indexUnboxedArray2D` (3, 1000)
diff --git a/testsuite/tests/backpack/should_compile/bkp16.stderr b/testsuite/tests/backpack/should_compile/bkp16.stderr
index f035aae2e1..d09d6e6823 100644
--- a/testsuite/tests/backpack/should_compile/bkp16.stderr
+++ b/testsuite/tests/backpack/should_compile/bkp16.stderr
@@ -4,5 +4,5 @@
Instantiating q
[1 of 1] Including p[Int=base-4.13.0.0:GHC.Exts]
Instantiating p[Int=base-4.13.0.0:GHC.Exts]
- [1 of 1] Including ghc-prim-0.7.0
+ [1 of 1] Including ghc-prim-0.8.0
[1 of 1] Compiling Int[sig] ( p/Int.hsig, bkp16.out/p/p-97PZnzqiJmd2hTwUNGdjod/Int.o )
diff --git a/testsuite/tests/codeGen/should_run/cgrun070.hs b/testsuite/tests/codeGen/should_run/cgrun070.hs
index d37032a707..53f640116f 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# a
+ a -> W8# (narrowWord8# a)
writeWord8Array :: MByteArray s -> Int -> Word8 -> ST s ()
writeWord8Array marr (I# i#) (W8# a) = ST $ \ s# ->
- case writeWord8Array# (unMBA marr) i# a s# of
+ case writeWord8Array# (unMBA marr) i# (extendWord8# 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 403bc49a3c..fb1b26252f 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# (narrow16Word# (byteSwap16# w#))
+bswap16 (W16# w#) = W16# (narrowWord16# (byteSwap16# (extendWord16# w#)))
bswap32 :: Word32 -> Word32
-bswap32 (W32# w#) = W32# (narrow32Word# (byteSwap32# w#))
+bswap32 (W32# w#) = W32# (narrowWord32# (byteSwap32# (extendWord32# 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 09e35b4d8a..89a4679e5f 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# (pdep8# src# mask#)
+ pdep (W8# src#) (W8# mask#) = W8# (narrowWord8# (pdep8# (extendWord8# src#) (extendWord8# mask#)))
instance Pdep Word16 where
- pdep (W16# src#) (W16# mask#) = W16# (pdep16# src# mask#)
+ pdep (W16# src#) (W16# mask#) = W16# (narrowWord16# (pdep16# (extendWord16# src#) (extendWord16# mask#)))
instance Pdep Word32 where
- pdep (W32# src#) (W32# mask#) = W32# (pdep32# src# mask#)
+ pdep (W32# src#) (W32# mask#) = W32# (narrowWord32# (pdep32# (extendWord32# src#) (extendWord32# 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 7fa42d74e0..a6ae331cf6 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# (pext8# src# mask#)
+ pext (W8# src#) (W8# mask#) = W8# (narrowWord8# (pext8# (extendWord8# src#) (extendWord8# mask#)))
instance Pext Word16 where
- pext (W16# src#) (W16# mask#) = W16# (pext16# src# mask#)
+ pext (W16# src#) (W16# mask#) = W16# (narrowWord16# (pext16# (extendWord16# src#) (extendWord16# mask#)))
instance Pext Word32 where
- pext (W32# src#) (W32# mask#) = W32# (pext32# src# mask#)
+ pext (W32# src#) (W32# mask#) = W32# (narrowWord32# (pext32# (extendWord32# src#) (extendWord32# 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 5bd0e58588..e155bc45a5 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# (indexWord8Array# ba# i#)
+ = W8# (narrowWord8# (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# j# s of
+ = ST $ \s -> case writeWord8Array# mba# i# (extendWord8# j#) s of
s' -> (# s', () #)
unsafeFreezeByteArray :: MBA s -> ST s BA
diff --git a/testsuite/tests/dependent/should_compile/T14729.stderr b/testsuite/tests/dependent/should_compile/T14729.stderr
index f3e8a1fdf9..60707bb193 100644
--- a/testsuite/tests/dependent/should_compile/T14729.stderr
+++ b/testsuite/tests/dependent/should_compile/T14729.stderr
@@ -11,4 +11,4 @@ COERCION AXIOMS
FAMILY INSTANCES
type instance F Int = Bool -- Defined at T14729.hs:10:15
Dependent modules: []
-Dependent packages: [base-4.16.0.0, ghc-bignum-1.0, ghc-prim-0.7.0]
+Dependent packages: [base-4.16.0.0, ghc-bignum-1.0, ghc-prim-0.8.0]
diff --git a/testsuite/tests/dependent/should_compile/T15743.stderr b/testsuite/tests/dependent/should_compile/T15743.stderr
index 4aeecbcc23..20bfaafadb 100644
--- a/testsuite/tests/dependent/should_compile/T15743.stderr
+++ b/testsuite/tests/dependent/should_compile/T15743.stderr
@@ -3,4 +3,4 @@ TYPE CONSTRUCTORS
forall {k1} k2 (k3 :: k2). Proxy k3 -> k1 -> k2 -> *
roles nominal nominal nominal phantom phantom phantom
Dependent modules: []
-Dependent packages: [base-4.16.0.0, ghc-bignum-1.0, ghc-prim-0.7.0]
+Dependent packages: [base-4.16.0.0, ghc-bignum-1.0, ghc-prim-0.8.0]
diff --git a/testsuite/tests/dependent/should_compile/T15743e.stderr b/testsuite/tests/dependent/should_compile/T15743e.stderr
index 01e20c63b9..8db06cbdcb 100644
--- a/testsuite/tests/dependent/should_compile/T15743e.stderr
+++ b/testsuite/tests/dependent/should_compile/T15743e.stderr
@@ -54,4 +54,4 @@ DATA CONSTRUCTORS
(d :: Proxy k5) (e :: Proxy k7).
f c -> T k8 a b f c d e
Dependent modules: []
-Dependent packages: [base-4.16.0.0, ghc-bignum-1.0, ghc-prim-0.7.0]
+Dependent packages: [base-4.16.0.0, ghc-bignum-1.0, ghc-prim-0.8.0]
diff --git a/testsuite/tests/ffi/should_run/T16650a.hs b/testsuite/tests/ffi/should_run/T16650a.hs
index ab1cd9c67e..6a43a55118 100644
--- a/testsuite/tests/ffi/should_run/T16650a.hs
+++ b/testsuite/tests/ffi/should_run/T16650a.hs
@@ -44,4 +44,4 @@ luckySingleton = IO $ \s0 -> case newByteArray# 1# s0 of
readByteArray :: MutableByteArray -> Int -> IO Word8
readByteArray (MutableByteArray b#) (I# i#) = IO $ \s0 ->
case readWord8Array# b# i# s0 of
- (# s1, w #) -> (# s1, W8# w #)
+ (# s1, w #) -> (# s1, W8# (narrowWord8# w) #)
diff --git a/testsuite/tests/ffi/should_run/T16650b.hs b/testsuite/tests/ffi/should_run/T16650b.hs
index 763329fc8b..ba0d4a72a0 100644
--- a/testsuite/tests/ffi/should_run/T16650b.hs
+++ b/testsuite/tests/ffi/should_run/T16650b.hs
@@ -53,7 +53,7 @@ luckySingleton = IO $ \s0 -> case newByteArray# 1# s0 of
readByteArray :: MutableByteArray -> Int -> IO Word8
readByteArray (MutableByteArray b#) (I# i#) = IO $ \s0 ->
case readWord8Array# b# i# s0 of
- (# s1, w #) -> (# s1, W8# w #)
+ (# s1, w #) -> (# s1, W8# (narrowWord8# 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 8e0aaeef50..8953e9b02d 100644
--- a/testsuite/tests/ffi/should_run/UnliftedNewtypesByteArrayOffset.hs
+++ b/testsuite/tests/ffi/should_run/UnliftedNewtypesByteArrayOffset.hs
@@ -35,7 +35,7 @@ main = do
readByteArray :: MutableByteArray -> Int -> IO Word8
readByteArray (MutableByteArray b#) (I# i#) = IO $ \s0 ->
case readWord8Array# b# i# s0 of
- (# s1, w #) -> (# s1, W8# w #)
+ (# s1, w #) -> (# s1, W8# (narrowWord8# w) #)
-- Create a new mutable byte array of length 1 with the sole byte
-- set to the 105.
@@ -43,5 +43,3 @@ luckySingleton :: IO MutableByteArray
luckySingleton = IO $ \s0 -> case newByteArray# 1# s0 of
(# s1, marr# #) -> case writeWord8Array# marr# 0# 105## s1 of
s2 -> (# s2, MutableByteArray marr# #)
-
-
diff --git a/testsuite/tests/indexed-types/should_compile/T15711.stderr b/testsuite/tests/indexed-types/should_compile/T15711.stderr
index 3e5cf86195..7c47eaf82a 100644
--- a/testsuite/tests/indexed-types/should_compile/T15711.stderr
+++ b/testsuite/tests/indexed-types/should_compile/T15711.stderr
@@ -3,4 +3,4 @@ TYPE CONSTRUCTORS
associated type family F{2} :: forall a. Maybe a -> *
roles nominal nominal
Dependent modules: []
-Dependent packages: [base-4.16.0.0, ghc-bignum-1.0, ghc-prim-0.7.0]
+Dependent packages: [base-4.16.0.0, ghc-bignum-1.0, ghc-prim-0.8.0]
diff --git a/testsuite/tests/indexed-types/should_compile/T15852.stderr b/testsuite/tests/indexed-types/should_compile/T15852.stderr
index 05aef7ca0d..8c212a06b6 100644
--- a/testsuite/tests/indexed-types/should_compile/T15852.stderr
+++ b/testsuite/tests/indexed-types/should_compile/T15852.stderr
@@ -9,4 +9,4 @@ FAMILY INSTANCES
data instance forall {k1} {k2} {j :: k1} {c :: k2}.
DF (Proxy c) -- Defined at T15852.hs:10:15
Dependent modules: []
-Dependent packages: [base-4.16.0.0, ghc-bignum-1.0, ghc-prim-0.7.0]
+Dependent packages: [base-4.16.0.0, ghc-bignum-1.0, ghc-prim-0.8.0]
diff --git a/testsuite/tests/lib/integer/integerImportExport.hs b/testsuite/tests/lib/integer/integerImportExport.hs
index bef208afd0..ab044214ed 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# (indexWord8Array# a# (word2Int# n#))
+indexByteArray a# n# = W8# (narrowWord8# (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 w s of s -> (# s, () #)
+writeByteArray arr i (W8# w) = IO $ \s -> case writeWord8Array# arr i (extendWord8# 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
new file mode 100644
index 0000000000..726bcc374e
--- /dev/null
+++ b/testsuite/tests/numeric/should_compile/T16402.stderr-ws-32
@@ -0,0 +1,133 @@
+
+==================== Tidy Core ====================
+Result size of Tidy Core
+ = {terms: 124, types: 172, coercions: 0, joins: 0/0}
+
+-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
+$trModule4 = "main"#
+
+-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
+$trModule3 = TrNameS $trModule4
+
+-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
+$trModule2 = "T16402"#
+
+-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
+$trModule1 = TrNameS $trModule2
+
+-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0}
+$trModule = Module $trModule3 $trModule1
+
+-- RHS size: {terms: 18, types: 25, coercions: 0, joins: 0/0}
+smallWord_bar
+ = \ x ->
+ case x of { W64# x# ->
+ case {__pkg_ccall ghc-prim Word64#
+ -> State# RealWorld -> (# State# RealWorld, Word# #)}
+ x# realWorld#
+ of
+ { (# ds1, ds2 #) ->
+ case {__pkg_ccall ghc-prim Word#
+ -> State# RealWorld -> (# State# RealWorld, Word64# #)}
+ (and# ds2 0xffff##) realWorld#
+ of
+ { (# ds4, ds5 #) ->
+ W64# ds5
+ }
+ }
+ }
+
+-- RHS size: {terms: 24, types: 36, coercions: 0, joins: 0/0}
+smallWord_foo
+ = \ x ->
+ case x of { W64# x# ->
+ case {__pkg_ccall ghc-prim Word64#
+ -> Word64# -> State# RealWorld -> (# State# RealWorld, Word64# #)}
+ x# 0xffff##64 realWorld#
+ of
+ { (# ds2, ds3 #) ->
+ case {__pkg_ccall ghc-prim Word64#
+ -> State# RealWorld -> (# State# RealWorld, Word# #)}
+ ds3 realWorld#
+ of
+ { (# ds1, ds4 #) ->
+ case {__pkg_ccall ghc-prim Word#
+ -> State# RealWorld -> (# State# RealWorld, Word64# #)}
+ (and# ds4 0xffff##) realWorld#
+ of
+ { (# ds5, ds6 #) ->
+ W64# ds6
+ }
+ }
+ }
+ }
+
+-- RHS size: {terms: 18, types: 25, coercions: 0, joins: 0/0}
+smallInt_bar
+ = \ x ->
+ case x of { I64# x# ->
+ case {__pkg_ccall ghc-prim Int64#
+ -> State# RealWorld -> (# State# RealWorld, Int# #)}
+ x# realWorld#
+ of
+ { (# ds1, ds2 #) ->
+ case {__pkg_ccall ghc-prim Int#
+ -> State# RealWorld -> (# State# RealWorld, Int64# #)}
+ (extendInt16# (narrowInt16# ds2)) realWorld#
+ of
+ { (# ds4, ds5 #) ->
+ I64# ds5
+ }
+ }
+ }
+
+-- RHS size: {terms: 35, types: 67, coercions: 0, joins: 0/0}
+$wsmallInt_foo
+ = \ ww ->
+ case {__pkg_ccall ghc-prim Int64#
+ -> State# RealWorld -> (# State# RealWorld, Word64# #)}
+ 1245183#64 realWorld#
+ of
+ { (# ds2, ds3 #) ->
+ case {__pkg_ccall ghc-prim Int64#
+ -> State# RealWorld -> (# State# RealWorld, Word64# #)}
+ ww realWorld#
+ of
+ { (# ds4, ds5 #) ->
+ case {__pkg_ccall ghc-prim Word64#
+ -> Word64# -> State# RealWorld -> (# State# RealWorld, Word64# #)}
+ ds5 ds3 realWorld#
+ of
+ { (# ds6, ds7 #) ->
+ case {__pkg_ccall ghc-prim Word64#
+ -> State# RealWorld -> (# State# RealWorld, Int64# #)}
+ ds7 realWorld#
+ of
+ { (# ds8, ds9 #) ->
+ case {__pkg_ccall ghc-prim Int64#
+ -> State# RealWorld -> (# State# RealWorld, Int# #)}
+ ds9 realWorld#
+ of
+ { (# ds1, ds11 #) ->
+ case {__pkg_ccall ghc-prim Int#
+ -> State# RealWorld -> (# State# RealWorld, Int64# #)}
+ (extendInt16# (narrowInt16# ds11)) realWorld#
+ of
+ { (# ds12, ds13 #) ->
+ ds13
+ }
+ }
+ }
+ }
+ }
+ }
+
+-- RHS size: {terms: 10, types: 4, coercions: 0, joins: 0/0}
+smallInt_foo
+ = \ w ->
+ case w of { I64# ww1 ->
+ case $wsmallInt_foo ww1 of ww2 { __DEFAULT -> I64# ww2 }
+ }
+
+
+
diff --git a/testsuite/tests/numeric/should_compile/T16402.stderr b/testsuite/tests/numeric/should_compile/T16402.stderr-ws-64
index 75db843376..d81adaaa7b 100644
--- a/testsuite/tests/numeric/should_compile/T16402.stderr
+++ b/testsuite/tests/numeric/should_compile/T16402.stderr-ws-64
@@ -1,7 +1,7 @@
==================== Tidy Core ====================
Result size of Tidy Core
- = {terms: 34, types: 19, coercions: 0, joins: 0/0}
+ = {terms: 36, types: 19, coercions: 0, joins: 0/0}
-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
$trModule4 = "main"#
@@ -18,16 +18,17 @@ $trModule1 = TrNameS $trModule2
-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0}
$trModule = Module $trModule3 $trModule1
--- RHS size: {terms: 7, types: 3, coercions: 0, joins: 0/0}
+-- RHS size: {terms: 8, types: 3, coercions: 0, joins: 0/0}
smallWord_bar
- = \ x -> case x of { W64# x# -> W64# (narrow16Word# x#) }
+ = \ x -> case x of { W64# x# -> W64# (and# x# 0xffff##) }
-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
smallWord_foo = smallWord_bar
--- RHS size: {terms: 7, types: 3, coercions: 0, joins: 0/0}
+-- RHS size: {terms: 8, types: 3, coercions: 0, joins: 0/0}
smallInt_bar
- = \ x -> case x of { I64# x# -> I64# (narrow16Int# x#) }
+ = \ x ->
+ case x of { I64# x# -> I64# (extendInt16# (narrowInt16# 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 3779d52341..305a12cab3 100644
--- a/testsuite/tests/parser/should_run/BinaryLiterals2.hs
+++ b/testsuite/tests/parser/should_run/BinaryLiterals2.hs
@@ -6,6 +6,7 @@
module Main where
+import GHC.Base
import GHC.Types
import GHC.Int
@@ -26,4 +27,4 @@ main = do
, -0B11111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111
]
- print [ I8# -0B10000000#, I8# 0B1111111# ]
+ print [ I8# (narrowInt8# -0B10000000#), I8# (narrowInt8# 0B1111111#) ]
diff --git a/testsuite/tests/polykinds/T15592.stderr b/testsuite/tests/polykinds/T15592.stderr
index 5f0334b43b..c0f494f281 100644
--- a/testsuite/tests/polykinds/T15592.stderr
+++ b/testsuite/tests/polykinds/T15592.stderr
@@ -5,4 +5,4 @@ DATA CONSTRUCTORS
MkT :: forall {k} k1 (f :: k1 -> k -> *) (a :: k1) (b :: k).
f a b -> T f a b -> T f a b
Dependent modules: []
-Dependent packages: [base-4.16.0.0, ghc-bignum-1.0, ghc-prim-0.7.0]
+Dependent packages: [base-4.16.0.0, ghc-bignum-1.0, ghc-prim-0.8.0]
diff --git a/testsuite/tests/polykinds/T15592b.stderr b/testsuite/tests/polykinds/T15592b.stderr
index e2a538f9d8..e64b81cebe 100644
--- a/testsuite/tests/polykinds/T15592b.stderr
+++ b/testsuite/tests/polykinds/T15592b.stderr
@@ -4,4 +4,4 @@ TYPE CONSTRUCTORS
forall k (f :: k -> *) (a :: k). f a -> *
roles nominal nominal nominal nominal
Dependent modules: []
-Dependent packages: [base-4.16.0.0, ghc-bignum-1.0, ghc-prim-0.7.0]
+Dependent packages: [base-4.16.0.0, ghc-bignum-1.0, ghc-prim-0.8.0]
diff --git a/testsuite/tests/printer/T18052a.stderr b/testsuite/tests/printer/T18052a.stderr
index de339de3c4..582a14a32c 100644
--- a/testsuite/tests/printer/T18052a.stderr
+++ b/testsuite/tests/printer/T18052a.stderr
@@ -6,7 +6,7 @@ TYPE CONSTRUCTORS
PATTERN SYNONYMS
(:||:) :: forall {a} {b}. a -> b -> (a, b)
Dependent modules: []
-Dependent packages: [base-4.16.0.0, ghc-bignum-1.0, ghc-prim-0.7.0]
+Dependent packages: [base-4.16.0.0, ghc-bignum-1.0, ghc-prim-0.8.0]
==================== Tidy Core ====================
Result size of Tidy Core
@@ -36,6 +36,3 @@ T18052a.$m:||:
(cont :: a -> b -> r)
_ [Occ=Dead] ->
case scrut of { (x, y) -> cont x y }
-
-
-
diff --git a/testsuite/tests/profiling/should_run/T3001-2.hs b/testsuite/tests/profiling/should_run/T3001-2.hs
index 6511491a46..186fd2f2f9 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# (w `uncheckedShiftL#` i)
+shiftl_w32 (W32# w) (I# i) = W32# (narrowWord32# ((extendWord32# 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# (w `uncheckedShiftRL#` i)
+shiftr_w32 (W32# w) (I# i) = W32# (narrowWord32# ((extendWord32# w) `uncheckedShiftRL#` i))
flush :: Builder
flush = Builder $ \ k buf@(Buffer p o u l) ->
@@ -291,4 +291,3 @@ instance Semigroup Builder where
instance Monoid Builder where
mempty = emptyBuilder
mappend = (<>)
-
diff --git a/testsuite/tests/simplCore/should_compile/T5359a.hs b/testsuite/tests/simplCore/should_compile/T5359a.hs
index ebe85ba4a0..8c4a0beaf7 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# w#))
+unsafeChrT (W16# w#) = C# (chr# (word2Int# (extendWord16# 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# r#)
+ case indexWord16Array# aBA i# of r# -> (W16# (narrowWord16# r#))
{-# INLINE unsafeIndex #-}
empty :: Array
diff --git a/testsuite/tests/simplCore/should_compile/T8832.stdout b/testsuite/tests/simplCore/should_compile/T8832.stdout
deleted file mode 100644
index 3e23710089..0000000000
--- a/testsuite/tests/simplCore/should_compile/T8832.stdout
+++ /dev/null
@@ -1,11 +0,0 @@
-i = GHC.Types.I# 0#
-i8 = GHC.Int.I8# 0#
-i16 = GHC.Int.I16# 0#
-i32 = GHC.Int.I32# 0#
-i64 = GHC.Int.I64# 0#
-w = GHC.Types.W# 0##
-w8 = GHC.Word.W8# 0##
-w16 = GHC.Word.W16# 0##
-w32 = GHC.Word.W32# 0##
-w64 = GHC.Word.W64# 0##
-z = 0
diff --git a/testsuite/tests/simplCore/should_compile/T8832.stdout-ws-32 b/testsuite/tests/simplCore/should_compile/T8832.stdout-ws-32
index 3186412561..459d2689c7 100644
--- a/testsuite/tests/simplCore/should_compile/T8832.stdout-ws-32
+++ b/testsuite/tests/simplCore/should_compile/T8832.stdout-ws-32
@@ -1,9 +1,9 @@
i = GHC.Types.I# 0#
-i8 = GHC.Int.I8# 0#
-i16 = GHC.Int.I16# 0#
-i32 = GHC.Int.I32# 0#
+i8 = GHC.Int.I8# 0#8
+i16 = GHC.Int.I16# 0#16
+i32 = GHC.Int.I32# 0#32
w = GHC.Types.W# 0##
-w8 = GHC.Word.W8# 0##
-w16 = GHC.Word.W16# 0##
-w32 = GHC.Word.W32# 0##
+w8 = GHC.Word.W8# 0##8
+w16 = GHC.Word.W16# 0##16
+w32 = GHC.Word.W32# 0##32
z = 0
diff --git a/testsuite/tests/simplCore/should_compile/T8832.stdout-ws-64 b/testsuite/tests/simplCore/should_compile/T8832.stdout-ws-64
new file mode 100644
index 0000000000..657f517c68
--- /dev/null
+++ b/testsuite/tests/simplCore/should_compile/T8832.stdout-ws-64
@@ -0,0 +1,11 @@
+i = GHC.Types.I# 0#
+i8 = GHC.Int.I8# 0#8
+i16 = GHC.Int.I16# 0#16
+i32 = GHC.Int.I32# 0#32
+i64 = GHC.Int.I64# 0#
+w = GHC.Types.W# 0##
+w8 = GHC.Word.W8# 0##8
+w16 = GHC.Word.W16# 0##16
+w32 = GHC.Word.W32# 0##32
+w64 = GHC.Word.W64# 0##
+z = 0
diff --git a/testsuite/tests/typecheck/should_compile/T12763.stderr b/testsuite/tests/typecheck/should_compile/T12763.stderr
index 552fd5f1d2..2496d16dcd 100644
--- a/testsuite/tests/typecheck/should_compile/T12763.stderr
+++ b/testsuite/tests/typecheck/should_compile/T12763.stderr
@@ -8,4 +8,4 @@ COERCION AXIOMS
CLASS INSTANCES
instance C Int -- Defined at T12763.hs:9:10
Dependent modules: []
-Dependent packages: [base-4.16.0.0, ghc-bignum-1.0, ghc-prim-0.7.0]
+Dependent packages: [base-4.16.0.0, ghc-bignum-1.0, ghc-prim-0.8.0]
diff --git a/utils/haddock b/utils/haddock
-Subproject 25fa8fde84701c010fa466c2648f8f6d10265e8
+Subproject 2d06af2fc535dacc4bac45d45e8eb95a7620caa