[Git][ghc/ghc][wip/angerman/aarch64-ncg] 5 commits: [CmmSized Int] move Int32# section.
Moritz Angermann
gitlab at gitlab.haskell.org
Sun Nov 1 07:30:49 UTC 2020
Moritz Angermann pushed to branch wip/angerman/aarch64-ncg at Glasgow Haskell Compiler / GHC
Commits:
beba3454 by Moritz Angermann at 2020-10-28T15:25:02+08:00
[CmmSized Int] move Int32# section.
- - - - -
8aef9557 by Moritz Angermann at 2020-10-28T15:58:35+08:00
[CmmSized Word] W8/W16/W32
- - - - -
88764dd4 by Moritz Angermann at 2020-10-28T17:16:33+08:00
[CmmSize Word] pt 2
- - - - -
dade52f5 by Moritz Angermann at 2020-11-01T15:09:55+08:00
[CmmSize Wor] pt 3
- - - - -
80115ada by Moritz Angermann at 2020-11-01T15:30:18+08:00
[CmmSized] bump submoudles
- - - - -
28 changed files:
- compiler/GHC/Builtin/Names.hs
- compiler/GHC/Builtin/Types.hs
- compiler/GHC/Builtin/primops.txt.pp
- compiler/GHC/CmmToAsm/Ppr.hs
- compiler/GHC/Core/Opt/ConstantFold.hs
- compiler/GHC/HsToCore/PmCheck/Oracle.hs
- compiler/GHC/HsToCore/Quote.hs
- compiler/GHC/StgToCmm/Prim.hs
- compiler/ghc.cabal.in
- ghc/ghc-bin.cabal.in
- libraries/array
- libraries/base/GHC/Float.hs
- libraries/base/GHC/IO/Encoding/UTF16.hs
- libraries/base/GHC/IO/Encoding/UTF32.hs
- libraries/base/GHC/IO/Encoding/UTF8.hs
- libraries/base/GHC/Int.hs
- libraries/base/GHC/Storable.hs
- libraries/base/GHC/Word.hs
- libraries/base/base.cabal
- libraries/binary
- libraries/bytestring
- libraries/ghc-bignum/ghc-bignum.cabal
- libraries/ghc-compact/ghc-compact.cabal
- libraries/ghc-heap/ghc-heap.cabal.in
- libraries/ghc-prim/ghc-prim.cabal
- libraries/ghci/GHCi/BreakArray.hs
- libraries/ghci/ghci.cabal.in
- libraries/text
Changes:
=====================================
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,
@@ -1468,7 +1468,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
=====================================
compiler/GHC/Builtin/Types.hs
=====================================
@@ -54,9 +54,6 @@ module GHC.Builtin.Types (
-- * Word
wordTyCon, wordDataCon, wordTyConName, wordTy,
- -- * Word8
- word8TyCon, word8DataCon, word8TyConName, word8Ty,
-
-- * List
listTyCon, listTyCon_RDR, listTyConName, listTyConKey,
nilDataCon, nilDataConName, nilDataConKey,
@@ -248,7 +245,6 @@ wiredInTyCons = [ -- Units are not treated like other tuples, because they
, floatTyCon
, intTyCon
, wordTyCon
- , word8TyCon
, listTyCon
, orderingTyCon
, maybeTyCon
@@ -352,11 +348,9 @@ nothingDataConName = mkWiredInDataConName UserSyntax gHC_MAYBE (fsLit "Nothing")
justDataConName = mkWiredInDataConName UserSyntax gHC_MAYBE (fsLit "Just")
justDataConKey justDataCon
-wordTyConName, wordDataConName, word8TyConName, word8DataConName :: Name
+wordTyConName, wordDataConName :: 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
floatTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "Float") floatTyConKey floatTyCon
@@ -1543,17 +1537,6 @@ wordTyCon = pcTyCon wordTyConName
wordDataCon :: DataCon
wordDataCon = pcDataCon wordDataConName [] [wordPrimTy] wordTyCon
-word8Ty :: Type
-word8Ty = mkTyConTy word8TyCon
-
-word8TyCon :: TyCon
-word8TyCon = pcTyCon word8TyConName
- (Just (CType NoSourceText Nothing
- (NoSourceText, fsLit "HsWord8"))) []
- [word8DataCon]
-word8DataCon :: DataCon
-word8DataCon = pcDataCon word8DataConName [] [wordPrimTy] word8TyCon
-
floatTy :: Type
floatTy = mkTyConTy floatTyCon
=====================================
compiler/GHC/Builtin/primops.txt.pp
=====================================
@@ -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#
@@ -407,16 +407,6 @@ primop Int16LeOp "leInt16#" Compare Int16# -> Int16# -> Int#
primop Int16LtOp "ltInt16#" Compare Int16# -> Int16# -> Int#
primop Int16NeOp "neInt16#" Compare Int16# -> Int16# -> Int#
-------------------------------------------------------------------------
-section "Int32#"
- {Operations on 32-bit integers.}
-------------------------------------------------------------------------
-
-primtype Int32#
-
-primop Int32ExtendOp "extendInt32#" GenPrimOp Int32# -> Int#
-primop Int32NarrowOp "narrowInt32#" GenPrimOp Int# -> Int32#
-
------------------------------------------------------------------------
section "Word16#"
{Operations on 16-bit unsigned integers.}
@@ -424,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#
@@ -458,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#"
=====================================
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_ghc_prim(0,8,0)
+import GHC.Base (extendWord8#)
+#else
+import GHC.Prim (Word#)
+extendWord8# :: Word# -> Word#
+extendWord8# w = w
+#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)
=====================================
compiler/GHC/Core/Opt/ConstantFold.hs
=====================================
@@ -214,10 +214,10 @@ primOpRules nm = \case
, narrowSubsumesAnd AndIOp Int32NarrowOp 32 ]
-- Int64NarrowOp -> mkPrimOpRule nm 1 [ narrowSubsumesAnd AndIOp Int64NarrowOp 64 ]
- -- Word8Narrow -> mkPrimOpRule nm 1 [ narrowSubsumesAnd AndOp Word8Narrow 8 ]
- -- Word16Narrow -> mkPrimOpRule nm 1 [ narrowSubsumesAnd AndOp Word16Narrow 16 ]
- -- Word32Narrow -> mkPrimOpRule nm 1 [ narrowSubsumesAnd AndOp Word32Narrow 32 ]
- -- Word64Narrow -> mkPrimOpRule nm 1 [ narrowSubsumesAnd AndOp Word64Narrow 64 ]
+ -- Word8NarrowOp -> mkPrimOpRule nm 1 [ narrowSubsumesAnd AndOp Word8NarrowOp 8 ]
+ -- Word16NarrowOp -> mkPrimOpRule nm 1 [ narrowSubsumesAnd AndOp Word16NarrowOp 16 ]
+ -- Word32NarrowOp -> mkPrimOpRule nm 1 [ narrowSubsumesAnd AndOp Word32NarrowOp 32 ]
+ -- Word64NarrowOp -> mkPrimOpRule nm 1 [ narrowSubsumesAnd AndOp Word64NarrowOp 64 ]
WordToIntOp -> mkPrimOpRule nm 1 [ liftLitPlatform wordToIntLit
, inversePrimOp IntToWordOp ]
=====================================
compiler/GHC/HsToCore/PmCheck/Oracle.hs
=====================================
@@ -1235,7 +1235,7 @@ inhabitationCandidates MkDelta{ delta_ty_st = ty_st } ty = do
-- | All these types are trivially inhabited
triviallyInhabitedTyCons :: UniqSet TyCon
triviallyInhabitedTyCons = mkUniqSet [
- charTyCon, doubleTyCon, floatTyCon, intTyCon, wordTyCon, word8TyCon
+ charTyCon, doubleTyCon, floatTyCon, intTyCon, wordTyCon
]
isTyConTriviallyInhabited :: TyCon -> Bool
=====================================
compiler/GHC/HsToCore/Quote.hs
=====================================
@@ -2750,13 +2750,14 @@ repTyVarSig (MkC bndr) = rep2 tyVarSigName [bndr]
-- Literals
repLiteral :: HsLit GhcRn -> MetaM (Core TH.Lit)
-repLiteral (HsStringPrim _ bs)
- = do platform <- getPlatform
- word8_ty <- lookupType word8TyConName
- let w8s = unpack bs
- w8s_expr = map (\w8 -> mkCoreConApps word8DataCon
- [mkWordLit platform (toInteger w8)]) w8s
- rep2_nw stringPrimLName [mkListExpr word8_ty w8s_expr]
+-- XXX this needs fixing.
+-- repLiteral (HsStringPrim _ bs)
+-- = do platform <- getPlatform
+-- word8_ty <- lookupType word8TyConName
+-- let w8s = unpack bs
+-- w8s_expr = map (\w8 -> mkCoreConApps word8DataCon
+-- [mkWordLit platform (toInteger w8)]) w8s
+-- rep2_nw stringPrimLName [mkListExpr word8_ty w8s_expr]
repLiteral lit
= do lit' <- case lit of
HsIntPrim _ i -> mk_integer i
=====================================
compiler/GHC/StgToCmm/Prim.hs
=====================================
@@ -1190,8 +1190,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)
@@ -1224,15 +1224,10 @@ emitPrimOp dflags primop = case primop of
Int16LtOp -> \args -> opTranslate args (MO_S_Lt W16)
Int16NeOp -> \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)
-
-- 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)
@@ -1247,6 +1242,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))
=====================================
compiler/ghc.cabal.in
=====================================
@@ -58,6 +58,7 @@ Library
Exposed: False
Build-Depends: base >= 4.11 && < 4.16,
+ ghc-prim >= 0.5.0 && < 0.9,
deepseq >= 1.4 && < 1.5,
directory >= 1 && < 1.4,
process >= 1 && < 1.7,
=====================================
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.*,
=====================================
libraries/array
=====================================
@@ -1 +1 @@
-Subproject commit eac14efeb5883ab18195b2eb6167f19853b59e88
+Subproject commit 2cb74575a736fc8a8cf01ac7ce3664343559ac86
=====================================
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#
=====================================
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 #-}
-
=====================================
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 #-}
-
=====================================
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 at haskell.org
-- Stability : internal
-- Portability : non-portable
@@ -144,17 +144,17 @@ bom1 = 0xbb
bom2 = 0xbf
utf8_decode :: DecodeBuffer
-utf8_decode
+utf8_decode
input at Buffer{ bufRaw=iraw, bufL=ir0, bufR=iw, bufSize=_ }
output at 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 at Buffer{ bufRaw=iraw, bufL=ir0, bufR=iw, bufSize=_ }
output at 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
-
=====================================
libraries/base/GHC/Int.hs
=====================================
@@ -431,7 +431,7 @@ instance FiniteBits Int16 where
countTrailingZeros (I16# x#) = I# (word2Int# (ctz16# (int2Word# (extendInt16# x#))))
{-# RULES
-"fromIntegral/Word8->Int16" fromIntegral = \(W8# x#) -> I16# (narrowInt16# (word2Int# 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# (narrowInt16# x#)
@@ -641,8 +641,8 @@ instance FiniteBits Int32 where
countTrailingZeros (I32# x#) = I# (word2Int# (ctz32# (int2Word# (extendInt32# x#))))
{-# RULES
-"fromIntegral/Word8->Int32" fromIntegral = \(W8# x#) -> I32# (narrowInt32# (word2Int# x#))
-"fromIntegral/Word16->Int32" fromIntegral = \(W16# x#) -> I32# (narrowInt32# (word2Int# 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
=====================================
libraries/base/GHC/Storable.hs
=====================================
@@ -93,15 +93,15 @@ readStablePtrOffPtr (Ptr a) (I# i)
readInt8OffPtr (Ptr a) (I# i)
= 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# (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# (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)
@@ -143,15 +143,15 @@ writeStablePtrOffPtr (Ptr a) (I# i) (StablePtr x)
writeInt8OffPtr (Ptr a) (I# i) (I8# x)
= 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 (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 (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)
=====================================
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,33 @@ 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#)
+ (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# ((extendWord8# x#) `xor#` (extendWord8# mb#)))
where !(W8# mb#) = maxBound
(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 +215,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 +262,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 +272,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 +289,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 +300,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 +323,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 +372,33 @@ 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#)
+ (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# ((extendWord16# x#) `xor#` (extendWord16# mb#)))
where !(W16# mb#) = maxBound
(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 +407,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 +497,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 +507,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 +524,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 +553,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 +573,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#
#else
- = IS (word2Int# x#)
+ = IS (word2Int# (extendWord32# x#))
#endif
-- | @since 2.01
@@ -604,33 +610,33 @@ 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#)
+ (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# ((extendWord32# x#) `xor#` (extendWord32# mb#)))
where !(W32# mb#) = maxBound
(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 +645,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 +685,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
@@ -1050,19 +1056,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'.
--
=====================================
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:
=====================================
libraries/binary
=====================================
@@ -1 +1 @@
-Subproject commit dfaf780596328c9184758452b78288e8f405fcc1
+Subproject commit ddee463e99fcda352f497d5fc925a72a1cf24faa
=====================================
libraries/bytestring
=====================================
@@ -1 +1 @@
-Subproject commit e6cb01e2ec0bfdd19298418c85f220925a9fa307
+Subproject commit 9e542456b9b5514de7574774e47932c0bedd5b43
=====================================
libraries/ghc-bignum/ghc-bignum.cabal
=====================================
@@ -80,7 +80,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/
=====================================
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.16,
bytestring >= 0.10.6.0
ghc-options: -Wall
=====================================
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
=====================================
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
=====================================
libraries/ghci/GHCi/BreakArray.hs
=====================================
@@ -32,10 +32,19 @@ 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_ghc_prim(0,8,0)
+import GHC.Base (extendWord8#, narrowWord8#)
+#else
+import GHC.Prim (Word#)
+narrowWord8#, extendWord8# :: Word# -> Word#
+narrowWord8# w = w
+extendWord8# w = w
+#endif
+
data BreakArray = BA (MutableByteArray# RealWorld)
breakOff, breakOn :: Word8
@@ -96,7 +105,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 +114,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
=====================================
libraries/ghci/ghci.cabal.in
=====================================
@@ -73,6 +73,7 @@ library
Build-Depends:
array == 0.5.*,
base >= 4.8 && < 4.16,
+ ghc-prim >= 0.5.0 && < 0.9,
binary == 0.8.*,
bytestring == 0.10.*,
containers >= 0.5 && < 0.7,
=====================================
libraries/text
=====================================
@@ -1 +1 @@
-Subproject commit 80cb9ee2eb7141171171318bbd6760fe80012524
+Subproject commit 9ead2aba5ac72f4acc74b12ec45972f865600916
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/170903093be2a26ee527a68354a0d6bca4264e50...80115ada7822e3c3006a2290a60492f6dbc6f205
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/170903093be2a26ee527a68354a0d6bca4264e50...80115ada7822e3c3006a2290a60492f6dbc6f205
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20201101/3e0b75d8/attachment-0001.html>
More information about the ghc-commits
mailing list