[Git][ghc/ghc][master] 2 commits: primops: Introduce unsafeThawByteArray#
Marge Bot (@marge-bot)
gitlab at gitlab.haskell.org
Sat Jul 22 03:24:22 UTC 2023
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
c30cea53 by Ben Gamari at 2023-07-21T23:23:49-04:00
primops: Introduce unsafeThawByteArray#
This addresses an odd asymmetry in the ByteArray# primops, which
previously provided unsafeFreezeByteArray# but no corresponding
thaw operation.
Closes #22710
- - - - -
87f9bd47 by Ben Gamari at 2023-07-21T23:23:49-04:00
testsuite: Elaborate in interface stability README
This discussion didn't make it into the original MR.
- - - - -
12 changed files:
- compiler/GHC/Builtin/primops.txt.pp
- compiler/GHC/StgToCmm/Prim.hs
- compiler/GHC/StgToJS/Prim.hs
- libraries/ghc-prim/changelog.md
- testsuite/tests/interface-stability/README.mkd
- testsuite/tests/interface-stability/base-exports.stdout
- testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs
- testsuite/tests/interface-stability/base-exports.stdout-mingw32
- testsuite/tests/interface-stability/base-exports.stdout-ws-32
- + testsuite/tests/primops/should_run/T22710.hs
- + testsuite/tests/primops/should_run/T22710.stdout
- testsuite/tests/primops/should_run/all.T
Changes:
=====================================
compiler/GHC/Builtin/primops.txt.pp
=====================================
@@ -1929,6 +1929,14 @@ primop UnsafeFreezeByteArrayOp "unsafeFreezeByteArray#" GenPrimOp
with
has_side_effects = True
+primop UnsafeThawByteArrayOp "unsafeThawByteArray#" GenPrimOp
+ ByteArray# -> State# s -> (# State# s, MutableByteArray# s #)
+ {Make an immutable byte array mutable, without copying.
+
+ @since 0.12.0.0}
+ with
+ has_side_effects = True
+
primop SizeofByteArrayOp "sizeofByteArray#" GenPrimOp
ByteArray# -> Int#
{Return the size of the array in bytes.}
=====================================
compiler/GHC/StgToCmm/Prim.hs
=====================================
@@ -371,6 +371,10 @@ emitPrimOp cfg primop =
UnsafeFreezeByteArrayOp -> \[arg] -> opIntoRegs $ \[res] ->
emitAssign (CmmLocal res) arg
+-- #define unsafeThawByteArrayzh(r,a) r=(a)
+ UnsafeThawByteArrayOp -> \[arg] -> opIntoRegs $ \[res] ->
+ emitAssign (CmmLocal res) arg
+
-- Reading/writing pointer arrays
ReadArrayOp -> \[obj, ix] -> opIntoRegs $ \[res] ->
=====================================
compiler/GHC/StgToJS/Prim.hs
=====================================
@@ -652,6 +652,7 @@ genPrim prof bound ty op = case op of
ShrinkMutableByteArrayOp_Char -> \[] [a,n] -> PrimInline $ appS "h$shrinkMutableByteArray" [a,n]
ResizeMutableByteArrayOp_Char -> \[r] [a,n] -> PrimInline $ r |= app "h$resizeMutableByteArray" [a,n]
UnsafeFreezeByteArrayOp -> \[a] [b] -> PrimInline $ a |= b
+ UnsafeThawByteArrayOp -> \[a] [b] -> PrimInline $ a |= b
SizeofByteArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "len"
SizeofMutableByteArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "len"
GetSizeofMutableByteArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "len"
=====================================
libraries/ghc-prim/changelog.md
=====================================
@@ -1,3 +1,10 @@
+## 0.12.0
+
+- Shipped with GHC 9.10.1
+
+- The `unsafeThawByteArray#` primop was added, serving as a inverse to the existing
+ `unsafeFreezeByteArray#` primop (see #22710).
+
## 0.11.0
- Shipped with GHC 9.8.1
=====================================
testsuite/tests/interface-stability/README.mkd
=====================================
@@ -5,7 +5,31 @@ core libraries do not inadvertently change. They use the `utils/dump-decls`
utility to dump all exported declarations of all exposed modules for the
following packages:
- * base
+ * `base`
These are compared against the expected exports in the test's corresponding
`.stdout` file.
+
+
+## Updating expected output
+
+The `base-exports` test in particular has rather platform-dependent output.
+Consequently, updating its output can be a bit tricky. There are two ways by
+which one can do this:
+
+ * Extrapolation: The various platforms' `base-exports.stdout` files are
+ similar enough that one can often apply the same patch of one file to the
+ others. For instance:
+ ```
+ for f in testsuite/tests/interface-stability/base-exports.stdout-*; do
+ git show | sed -e "s/base-exports.stdout/$(basename $f)/" | patch -p1
+ done
+ ```
+ In the case of conflicts, increasing the fuzz factor (using `-F`) can be
+ quite effective.
+
+ * Using CI: Each CI job produces a tarball, `unexpected-test-output.tar.gz`,
+ which contains the output produced by the job's failing tests. Simply
+ download this tarball and extracting the appropriate `base-exports.stdout-*`
+ files into this directory.
+
=====================================
testsuite/tests/interface-stability/base-exports.stdout
=====================================
@@ -4650,6 +4650,7 @@ module GHC.Base where
unsafeFreezeSmallArray# :: forall {l :: Levity} d (a :: TYPE (BoxedRep l)). SmallMutableArray# d a -> State# d -> (# State# d, SmallArray# a #)
unsafePtrEquality# :: forall (a :: UnliftedType) (b :: UnliftedType). a -> b -> Int#
unsafeThawArray# :: forall {l :: Levity} (a :: TYPE (BoxedRep l)) d. Array# a -> State# d -> (# State# d, MutableArray# d a #)
+ unsafeThawByteArray# :: forall d. ByteArray# -> State# d -> (# State# d, MutableByteArray# d #)
unsafeThawSmallArray# :: forall {l :: Levity} (a :: TYPE (BoxedRep l)) d. SmallArray# a -> State# d -> (# State# d, SmallMutableArray# d a #)
until :: forall a. (a -> Bool) -> (a -> a) -> a -> a
vacuous :: forall (f :: * -> *) a. Functor f => f Void -> f a
@@ -6703,6 +6704,7 @@ module GHC.Exts where
unsafeFreezeSmallArray# :: forall {l :: Levity} d (a :: TYPE (BoxedRep l)). SmallMutableArray# d a -> State# d -> (# State# d, SmallArray# a #)
unsafePtrEquality# :: forall (a :: UnliftedType) (b :: UnliftedType). a -> b -> Int#
unsafeThawArray# :: forall {l :: Levity} (a :: TYPE (BoxedRep l)) d. Array# a -> State# d -> (# State# d, MutableArray# d a #)
+ unsafeThawByteArray# :: forall d. ByteArray# -> State# d -> (# State# d, MutableByteArray# d #)
unsafeThawSmallArray# :: forall {l :: Levity} (a :: TYPE (BoxedRep l)) d. SmallArray# a -> State# d -> (# State# d, SmallMutableArray# d a #)
void# :: (# #)
waitRead# :: forall d. Int# -> State# d -> State# d
=====================================
testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs
=====================================
@@ -4650,6 +4650,7 @@ module GHC.Base where
unsafeFreezeSmallArray# :: forall {l :: Levity} d (a :: TYPE (BoxedRep l)). SmallMutableArray# d a -> State# d -> (# State# d, SmallArray# a #)
unsafePtrEquality# :: forall (a :: UnliftedType) (b :: UnliftedType). a -> b -> Int#
unsafeThawArray# :: forall {l :: Levity} (a :: TYPE (BoxedRep l)) d. Array# a -> State# d -> (# State# d, MutableArray# d a #)
+ unsafeThawByteArray# :: forall d. ByteArray# -> State# d -> (# State# d, MutableByteArray# d #)
unsafeThawSmallArray# :: forall {l :: Levity} (a :: TYPE (BoxedRep l)) d. SmallArray# a -> State# d -> (# State# d, SmallMutableArray# d a #)
until :: forall a. (a -> Bool) -> (a -> a) -> a -> a
vacuous :: forall (f :: * -> *) a. Functor f => f Void -> f a
@@ -6672,6 +6673,7 @@ module GHC.Exts where
unsafeFreezeSmallArray# :: forall {l :: Levity} d (a :: TYPE (BoxedRep l)). SmallMutableArray# d a -> State# d -> (# State# d, SmallArray# a #)
unsafePtrEquality# :: forall (a :: UnliftedType) (b :: UnliftedType). a -> b -> Int#
unsafeThawArray# :: forall {l :: Levity} (a :: TYPE (BoxedRep l)) d. Array# a -> State# d -> (# State# d, MutableArray# d a #)
+ unsafeThawByteArray# :: forall d. ByteArray# -> State# d -> (# State# d, MutableByteArray# d #)
unsafeThawSmallArray# :: forall {l :: Levity} (a :: TYPE (BoxedRep l)) d. SmallArray# a -> State# d -> (# State# d, SmallMutableArray# d a #)
void# :: (# #)
waitRead# :: forall d. Int# -> State# d -> State# d
=====================================
testsuite/tests/interface-stability/base-exports.stdout-mingw32
=====================================
@@ -4653,6 +4653,7 @@ module GHC.Base where
unsafeFreezeSmallArray# :: forall {l :: Levity} d (a :: TYPE (BoxedRep l)). SmallMutableArray# d a -> State# d -> (# State# d, SmallArray# a #)
unsafePtrEquality# :: forall (a :: UnliftedType) (b :: UnliftedType). a -> b -> Int#
unsafeThawArray# :: forall {l :: Levity} (a :: TYPE (BoxedRep l)) d. Array# a -> State# d -> (# State# d, MutableArray# d a #)
+ unsafeThawByteArray# :: forall d. ByteArray# -> State# d -> (# State# d, MutableByteArray# d #)
unsafeThawSmallArray# :: forall {l :: Levity} (a :: TYPE (BoxedRep l)) d. SmallArray# a -> State# d -> (# State# d, SmallMutableArray# d a #)
until :: forall a. (a -> Bool) -> (a -> a) -> a -> a
vacuous :: forall (f :: * -> *) a. Functor f => f Void -> f a
@@ -6852,6 +6853,7 @@ module GHC.Exts where
unsafeFreezeSmallArray# :: forall {l :: Levity} d (a :: TYPE (BoxedRep l)). SmallMutableArray# d a -> State# d -> (# State# d, SmallArray# a #)
unsafePtrEquality# :: forall (a :: UnliftedType) (b :: UnliftedType). a -> b -> Int#
unsafeThawArray# :: forall {l :: Levity} (a :: TYPE (BoxedRep l)) d. Array# a -> State# d -> (# State# d, MutableArray# d a #)
+ unsafeThawByteArray# :: forall d. ByteArray# -> State# d -> (# State# d, MutableByteArray# d #)
unsafeThawSmallArray# :: forall {l :: Levity} (a :: TYPE (BoxedRep l)) d. SmallArray# a -> State# d -> (# State# d, SmallMutableArray# d a #)
void# :: (# #)
waitRead# :: forall d. Int# -> State# d -> State# d
=====================================
testsuite/tests/interface-stability/base-exports.stdout-ws-32
=====================================
@@ -4650,6 +4650,7 @@ module GHC.Base where
unsafeFreezeSmallArray# :: forall {l :: Levity} d (a :: TYPE (BoxedRep l)). SmallMutableArray# d a -> State# d -> (# State# d, SmallArray# a #)
unsafePtrEquality# :: forall (a :: UnliftedType) (b :: UnliftedType). a -> b -> Int#
unsafeThawArray# :: forall {l :: Levity} (a :: TYPE (BoxedRep l)) d. Array# a -> State# d -> (# State# d, MutableArray# d a #)
+ unsafeThawByteArray# :: forall d. ByteArray# -> State# d -> (# State# d, MutableByteArray# d #)
unsafeThawSmallArray# :: forall {l :: Levity} (a :: TYPE (BoxedRep l)) d. SmallArray# a -> State# d -> (# State# d, SmallMutableArray# d a #)
until :: forall a. (a -> Bool) -> (a -> a) -> a -> a
vacuous :: forall (f :: * -> *) a. Functor f => f Void -> f a
@@ -6703,6 +6704,7 @@ module GHC.Exts where
unsafeFreezeSmallArray# :: forall {l :: Levity} d (a :: TYPE (BoxedRep l)). SmallMutableArray# d a -> State# d -> (# State# d, SmallArray# a #)
unsafePtrEquality# :: forall (a :: UnliftedType) (b :: UnliftedType). a -> b -> Int#
unsafeThawArray# :: forall {l :: Levity} (a :: TYPE (BoxedRep l)) d. Array# a -> State# d -> (# State# d, MutableArray# d a #)
+ unsafeThawByteArray# :: forall d. ByteArray# -> State# d -> (# State# d, MutableByteArray# d #)
unsafeThawSmallArray# :: forall {l :: Levity} (a :: TYPE (BoxedRep l)) d. SmallArray# a -> State# d -> (# State# d, SmallMutableArray# d a #)
void# :: (# #)
waitRead# :: forall d. Int# -> State# d -> State# d
=====================================
testsuite/tests/primops/should_run/T22710.hs
=====================================
@@ -0,0 +1,55 @@
+-- | Test 'unsafeThawByteArray#'.
+
+{-# LANGUAGE MagicHash, UnboxedTuples #-}
+
+import GHC.Exts (newByteArray#, indexWord8Array#, writeWord8Array#,
+ unsafeFreezeByteArray#, unsafeThawByteArray#,
+ ByteArray#, MutableByteArray#, Int(I#))
+import GHC.Word
+import GHC.ST
+import Prelude hiding (toList)
+
+main :: IO ()
+main = do
+ res <- return $ runST $ do
+ let n = 32 :: Int
+ marr <- newByteArray n
+ mapM_ (\i -> writeWord8Array marr i (fromIntegral i)) [0..n-1]
+ arr <- unsafeFreezeByteArray marr
+ marr' <- unsafeThawByteArray arr
+ arr' <- unsafeFreezeByteArray marr'
+ return $ toList arr' 5
+
+ print res
+
+data ByteArray = ByteArray { unBA :: ByteArray# }
+data MByteArray s = MByteArray { unMBA :: MutableByteArray# s }
+
+newByteArray :: Int -> ST s (MByteArray s)
+newByteArray (I# n#) = ST $ \s# -> case newByteArray# n# s# of
+ (# s2#, marr# #) -> (# s2#, MByteArray marr# #)
+
+indexWord8Array :: ByteArray -> Int -> Word8
+indexWord8Array arr (I# i#) = case indexWord8Array# (unBA arr) i# of
+ a -> W8# a
+
+writeWord8Array :: MByteArray s -> Int -> Word8 -> ST s ()
+writeWord8Array marr (I# i#) (W8# a) = ST $ \ s# ->
+ case writeWord8Array# (unMBA marr) i# a s# of
+ s2# -> (# s2#, () #)
+
+unsafeFreezeByteArray :: MByteArray s -> ST s ByteArray
+unsafeFreezeByteArray marr = ST $ \ s# ->
+ case unsafeFreezeByteArray# (unMBA marr) s# of
+ (# s2#, arr# #) -> (# s2#, ByteArray arr# #)
+
+unsafeThawByteArray :: ByteArray -> ST s (MByteArray s)
+unsafeThawByteArray arr = ST $ \ s# ->
+ case unsafeThawByteArray# (unBA arr) s# of
+ (# s2#, marr# #) -> (# s2#, MByteArray marr# #)
+
+toList :: ByteArray -> Int -> [Word8]
+toList arr n = go 0
+ where
+ go i | i >= n = []
+ | otherwise = indexWord8Array arr i : go (i+1)
=====================================
testsuite/tests/primops/should_run/T22710.stdout
=====================================
@@ -0,0 +1 @@
+[0,1,2,3,4]
=====================================
testsuite/tests/primops/should_run/all.T
=====================================
@@ -71,3 +71,4 @@ test('FMA_ConstantFold'
test('T21624', normal, compile_and_run, [''])
test('T23071', ignore_stdout, compile_and_run, [''])
+test('T22710', normal, compile_and_run, [''])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b444c16f4ff64938a8bec9587bd90209bda682b9...87f9bd47780eb06b0953fee1fb445306d29db882
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b444c16f4ff64938a8bec9587bd90209bda682b9...87f9bd47780eb06b0953fee1fb445306d29db882
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/20230721/e16228c9/attachment-0001.html>
More information about the ghc-commits
mailing list