[Git][ghc/ghc][wip/T22710] primops: Introduce unsafeThawByteArray#

[Ben Gamari (@bgamari)]

Ben Gamari pushed to branch wip/T22710 at Glasgow Haskell Compiler / GHC


Commits:
e00a806a by Ben Gamari at 2023-07-01T11:31:29-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

- - - - -


6 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/primops/should_run/T22710.hs
- testsuite/tests/primops/should_run/all.T


Changes:

=====================================
compiler/GHC/Builtin/primops.txt.pp
=====================================
@@ -1922,6 +1922,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/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/all.T
=====================================
@@ -72,3 +72,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/-/commit/e00a806ac22a444d941bf85d199ccbaf36c461cc

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e00a806ac22a444d941bf85d199ccbaf36c461cc
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/20230701/72816378/attachment-0001.html>