[Git][ghc/ghc][wip/angerman/aarch64-ncg] 5 commits: [CmmSized Word] Constant Fold
Moritz Angermann
gitlab at gitlab.haskell.org
Mon Nov 2 05:56:22 UTC 2020
Moritz Angermann pushed to branch wip/angerman/aarch64-ncg at Glasgow Haskell Compiler / GHC
Commits:
fe9a0293 by Moritz Angermann at 2020-11-02T10:02:15+08:00
[CmmSized Word] Constant Fold
- - - - -
a0903f8e by Moritz Angermann at 2020-11-02T10:03:44+08:00
[CmmSized Word] Fix testsuite
- - - - -
4d64b5af by Moritz Angermann at 2020-11-02T11:25:08+08:00
fix bytestring bump
- - - - -
13a7028b by Moritz Angermann at 2020-11-02T13:50:47+08:00
[CmmSized Word] More constant folds
- - - - -
e98e3d12 by Moritz Angermann at 2020-11-02T13:55:57+08:00
[SizedCmm Word] Trying to fix TH Quotes
- - - - -
27 changed files:
- compiler/GHC/Builtin/Types.hs
- compiler/GHC/Core.hs
- compiler/GHC/Core/Opt/ConstantFold.hs
- compiler/GHC/HsToCore/Quote.hs
- libraries/bytestring
- testsuite/tests/array/should_run/arr020.hs
- testsuite/tests/backpack/should_compile/bkp16.stderr
- testsuite/tests/codeGen/should_run/cgrun070.hs
- testsuite/tests/codeGen/should_run/cgrun072.hs
- testsuite/tests/codeGen/should_run/cgrun075.hs
- testsuite/tests/codeGen/should_run/cgrun076.hs
- testsuite/tests/codeGen/should_run/compareByteArrays.hs
- testsuite/tests/dependent/should_compile/T14729.stderr
- testsuite/tests/dependent/should_compile/T15743.stderr
- testsuite/tests/dependent/should_compile/T15743e.stderr
- testsuite/tests/ffi/should_run/T16650a.hs
- testsuite/tests/ffi/should_run/T16650b.hs
- testsuite/tests/ffi/should_run/UnliftedNewtypesByteArrayOffset.hs
- testsuite/tests/indexed-types/should_compile/T15711.stderr
- testsuite/tests/indexed-types/should_compile/T15852.stderr
- testsuite/tests/lib/integer/integerImportExport.hs
- testsuite/tests/polykinds/T15592.stderr
- testsuite/tests/polykinds/T15592b.stderr
- testsuite/tests/printer/T18052a.stderr
- testsuite/tests/profiling/should_run/T3001-2.hs
- testsuite/tests/simplCore/should_compile/T5359a.hs
- testsuite/tests/typecheck/should_compile/T12763.stderr
Changes:
=====================================
compiler/GHC/Builtin/Types.hs
=====================================
@@ -54,6 +54,9 @@ module GHC.Builtin.Types (
-- * Word
wordTyCon, wordDataCon, wordTyConName, wordTy,
+ -- * Word8
+ word8TyCon, word8DataCon, word8Ty,
+
-- * List
listTyCon, listTyCon_RDR, listTyConName, listTyConKey,
nilDataCon, nilDataConName, nilDataConKey,
@@ -348,9 +351,10 @@ nothingDataConName = mkWiredInDataConName UserSyntax gHC_MAYBE (fsLit "Nothing")
justDataConName = mkWiredInDataConName UserSyntax gHC_MAYBE (fsLit "Just")
justDataConKey justDataCon
-wordTyConName, wordDataConName :: Name
+wordTyConName, wordDataConName, word8DataConName :: Name
wordTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "Word") wordTyConKey wordTyCon
wordDataConName = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "W#") wordDataConKey wordDataCon
+word8DataConName = mkWiredInDataConName UserSyntax gHC_WORD (fsLit "W8#") word8DataConKey word8DataCon
floatTyConName, floatDataConName, doubleTyConName, doubleDataConName :: Name
floatTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "Float") floatTyConKey floatTyCon
@@ -1537,6 +1541,17 @@ 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 [] [word8PrimTy] word8TyCon
+
floatTy :: Type
floatTy = mkTyConTy floatTyCon
=====================================
compiler/GHC/Core.hs
=====================================
@@ -29,6 +29,7 @@ module GHC.Core (
mkIntLit, mkIntLitInt,
mkWordLit, mkWordLitWord,
+ mkWord8Lit, mkWord8LitWord,
mkWord64LitWord64, mkInt64LitInt64,
mkCharLit, mkStringLit,
mkFloatLit, mkFloatLitFloat,
@@ -1995,6 +1996,12 @@ mkWordLitWord :: Platform -> Word -> Expr b
mkWordLit platform w = Lit (mkLitWord platform w)
mkWordLitWord platform w = Lit (mkLitWord platform (toInteger w))
+mkWord8Lit :: Platform -> Integer -> Expr b
+mkWord8Lit _platform w = Lit (mkLitWord8 w)
+
+mkWord8LitWord :: Platform -> Integer -> Expr b
+mkWord8LitWord _platform w = Lit (mkLitWord8 (toInteger w))
+
mkWord64LitWord64 :: Word64 -> Expr b
mkWord64LitWord64 w = Lit (mkLitWord64 (toInteger w))
=====================================
compiler/GHC/Core/Opt/ConstantFold.hs
=====================================
@@ -212,6 +212,26 @@ primOpRules nm = \case
, subsumedByPrimOp Int16NarrowOp
, subsumedByPrimOp Int32NarrowOp
, narrowSubsumesAnd AndIOp Int32NarrowOp 32 ]
+
+ Word8ExtendOp -> mkPrimOpRule nm 1 [ do [Var primop_id `App` e] <- getArgs
+ matchPrimOpId Word8NarrowOp primop_id
+ return (Var (mkPrimOpId Narrow8WordOp) `App` e) ]
+ Word16ExtendOp -> mkPrimOpRule nm 1 [ do [Var primop_id `App` e] <- getArgs
+ matchPrimOpId Word16NarrowOp primop_id
+ return (Var (mkPrimOpId Narrow16WordOp) `App` e) ]
+ Word32ExtendOp -> mkPrimOpRule nm 1 [ do [Var primop_id `App` e] <- getArgs
+ matchPrimOpId Word32NarrowOp primop_id
+ return (Var (mkPrimOpId Narrow32WordOp) `App` e) ]
+ Word8NarrowOp -> mkPrimOpRule nm 1 [ subsumedByPrimOp Word8NarrowOp
+ , narrowSubsumesAnd AndOp Word8NarrowOp 8 ]
+ Word16NarrowOp -> mkPrimOpRule nm 1 [ subsumedByPrimOp Word8NarrowOp
+ , subsumedByPrimOp Word16NarrowOp
+ , narrowSubsumesAnd AndOp Word16NarrowOp 16 ]
+ Word32NarrowOp -> mkPrimOpRule nm 1 [ subsumedByPrimOp Word8NarrowOp
+ , subsumedByPrimOp Word16NarrowOp
+ , subsumedByPrimOp Word32NarrowOp
+ , narrowSubsumesAnd AndOp Word32NarrowOp 32 ]
+
-- Int64NarrowOp -> mkPrimOpRule nm 1 [ narrowSubsumesAnd AndIOp Int64NarrowOp 64 ]
-- Word8NarrowOp -> mkPrimOpRule nm 1 [ narrowSubsumesAnd AndOp Word8NarrowOp 8 ]
=====================================
compiler/GHC/HsToCore/Quote.hs
=====================================
@@ -2750,14 +2750,13 @@ repTyVarSig (MkC bndr) = rep2 tyVarSigName [bndr]
-- Literals
repLiteral :: HsLit GhcRn -> MetaM (Core TH.Lit)
--- 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 (HsStringPrim _ bs)
+ = do platform <- getPlatform
+ word8_ty <- lookupType word8TyConName
+ let w8s = unpack bs
+ w8s_expr = map (\w8 -> mkCoreConApps word8DataCon
+ [mkWord8Lit platform (toInteger w8)]) w8s
+ rep2_nw stringPrimLName [mkListExpr word8_ty w8s_expr]
repLiteral lit
= do lit' <- case lit of
HsIntPrim _ i -> mk_integer i
=====================================
libraries/bytestring
=====================================
@@ -1 +1 @@
-Subproject commit 9e542456b9b5514de7574774e47932c0bedd5b43
+Subproject commit 01754193492044e446f57442e0c9473972e5951e
=====================================
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)
=====================================
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 )
=====================================
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)
=====================================
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#)
=====================================
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#)
=====================================
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#)
=====================================
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
=====================================
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.15.0.0, ghc-bignum-1.0, ghc-prim-0.7.0]
+Dependent packages: [base-4.15.0.0, ghc-bignum-1.0, ghc-prim-0.8.0]
=====================================
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.15.0.0, ghc-bignum-1.0, ghc-prim-0.7.0]
+Dependent packages: [base-4.15.0.0, ghc-bignum-1.0, ghc-prim-0.8.0]
=====================================
testsuite/tests/dependent/should_compile/T15743e.stderr
=====================================
@@ -52,4 +52,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.15.0.0, ghc-bignum-1.0, ghc-prim-0.7.0]
+Dependent packages: [base-4.15.0.0, ghc-bignum-1.0, ghc-prim-0.8.0]
=====================================
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) #)
=====================================
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.
=====================================
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# #)
-
-
=====================================
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.15.0.0, ghc-bignum-1.0, ghc-prim-0.7.0]
+Dependent packages: [base-4.15.0.0, ghc-bignum-1.0, ghc-prim-0.8.0]
=====================================
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.15.0.0, ghc-bignum-1.0, ghc-prim-0.7.0]
+Dependent packages: [base-4.15.0.0, ghc-bignum-1.0, ghc-prim-0.8.0]
=====================================
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))
=====================================
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.15.0.0, ghc-bignum-1.0, ghc-prim-0.7.0]
+Dependent packages: [base-4.15.0.0, ghc-bignum-1.0, ghc-prim-0.8.0]
=====================================
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.15.0.0, ghc-bignum-1.0, ghc-prim-0.7.0]
+Dependent packages: [base-4.15.0.0, ghc-bignum-1.0, ghc-prim-0.8.0]
=====================================
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.15.0.0, ghc-bignum-1.0, ghc-prim-0.7.0]
+Dependent packages: [base-4.15.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 }
-
-
-
=====================================
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 = (<>)
-
=====================================
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
=====================================
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.15.0.0, ghc-bignum-1.0, ghc-prim-0.7.0]
+Dependent packages: [base-4.15.0.0, ghc-bignum-1.0, ghc-prim-0.8.0]
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/80115ada7822e3c3006a2290a60492f6dbc6f205...e98e3d124a92cdf48108d918e501a132eaaee53a
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/80115ada7822e3c3006a2290a60492f6dbc6f205...e98e3d124a92cdf48108d918e501a132eaaee53a
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/20201102/2403ed51/attachment-0001.html>
More information about the ghc-commits
mailing list