[Git][ghc/ghc][wip/T22710] 3 commits: hadrian: Fix dependencies of docs:* rule

Ben Gamari (@bgamari) gitlab at gitlab.haskell.org
Sat Jul 1 15:30:59 UTC 2023



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


Commits:
d7f6448a by Matthew Pickering at 2023-06-30T12:38:43-04:00
hadrian: Fix dependencies of docs:* rule

For the docs:* rule we need to actually build the package rather than
just the haddocks for the dependent packages. Therefore we depend on the
.conf files of the packages we are trying to build documentation for as
well as the .haddock files.

Fixes #23472

- - - - -
cec90389 by sheaf at 2023-06-30T12:39:27-04:00
Add tests for #22106

Fixes #22106

- - - - -
7d4e56ee by Ben Gamari at 2023-07-01T11:30:46-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

- - - - -


14 changed files:

- compiler/GHC/Builtin/primops.txt.pp
- compiler/GHC/StgToCmm/Prim.hs
- compiler/GHC/StgToJS/Prim.hs
- hadrian/src/Rules/Documentation.hs
- libraries/ghc-prim/changelog.md
- + testsuite/tests/overloadedrecflds/should_compile/T22106_A.hs
- + testsuite/tests/overloadedrecflds/should_compile/T22106_B.hs
- + testsuite/tests/overloadedrecflds/should_compile/T22106_C.hs
- + testsuite/tests/overloadedrecflds/should_compile/T22106_C.stderr
- + testsuite/tests/overloadedrecflds/should_compile/T22106_D.hs
- + testsuite/tests/overloadedrecflds/should_compile/T22106_aux.hs
- testsuite/tests/overloadedrecflds/should_compile/all.T
- + 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# s -> State# s -> (# State# s, MutableByteArray# #)
+   {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"


=====================================
hadrian/src/Rules/Documentation.hs
=====================================
@@ -258,6 +258,15 @@ buildPackageDocumentation = do
         need [ takeDirectory file  -/- "haddock-prologue.txt"]
         haddocks <- haddockDependencies context
 
+        -- Build Haddock documentation
+        -- TODO: Pass the correct way from Rules via Context.
+        dynamicPrograms <- dynamicGhcPrograms =<< flavour
+        let haddockWay = if dynamicPrograms then dynamic else vanilla
+
+        -- Build the dependencies of the package we are going to build documentation for
+        dep_pkgs <- sequence [pkgConfFile (context { way = haddockWay, Context.package = p})
+                             | (p, _) <- haddocks]
+
         -- `ghc-prim` has a source file for 'GHC.Prim' which is generated just
         -- for Haddock. We need to 'union' (instead of '++') to avoid passing
         -- 'GHC.PrimopWrappers' (which unfortunately shows up in both
@@ -266,12 +275,8 @@ buildPackageDocumentation = do
         vanillaSrcs <- hsSources context
         let srcs = vanillaSrcs `union` generatedSrcs
 
-        need $ srcs ++ (map snd haddocks)
+        need $ srcs ++ (map snd haddocks) ++ dep_pkgs
 
-        -- Build Haddock documentation
-        -- TODO: Pass the correct way from Rules via Context.
-        dynamicPrograms <- dynamicGhcPrograms =<< flavour
-        let haddockWay = if dynamicPrograms then dynamic else vanilla
         statsFilesDir <- haddockStatsFilesDir
         createDirectory statsFilesDir
         build $ target (context {way = haddockWay}) (Haddock BuildPackage) srcs [file]


=====================================
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/overloadedrecflds/should_compile/T22106_A.hs
=====================================
@@ -0,0 +1,5 @@
+module T22106_A where
+
+import T22106_aux ( foo )
+
+xyzzy = foo


=====================================
testsuite/tests/overloadedrecflds/should_compile/T22106_B.hs
=====================================
@@ -0,0 +1,5 @@
+module T22106_B where
+
+import T22106_aux ( T(foo) )
+
+xyzzy r = r { foo = 3 }


=====================================
testsuite/tests/overloadedrecflds/should_compile/T22106_C.hs
=====================================
@@ -0,0 +1,5 @@
+module T22106_C where
+
+import T22106_aux ( bar )
+
+xyzzy = bar


=====================================
testsuite/tests/overloadedrecflds/should_compile/T22106_C.stderr
=====================================
@@ -0,0 +1,6 @@
+
+T22106_C.hs:5:9: error: [GHC-88464]
+    Variable not in scope: bar
+    Suggested fix:
+      Notice that ‘bar’ is a field selector belonging to the type ‘T22106_aux.T’
+      that has been suppressed by NoFieldSelectors.


=====================================
testsuite/tests/overloadedrecflds/should_compile/T22106_D.hs
=====================================
@@ -0,0 +1,5 @@
+module T22106_D where
+
+import T22106_aux ( T(bar) )
+
+xyzzy r = r { bar = 7 }


=====================================
testsuite/tests/overloadedrecflds/should_compile/T22106_aux.hs
=====================================
@@ -0,0 +1,6 @@
+{-# LANGUAGE NoFieldSelectors #-}
+
+module T22106_aux where
+
+data T = MkT { foo :: Int, bar :: Int }
+foo = ()


=====================================
testsuite/tests/overloadedrecflds/should_compile/all.T
=====================================
@@ -50,3 +50,8 @@ test('BootFldReexport'
 test('T23220'
     , [req_th, extra_files(['T23220_aux.hs'])]
     , multimod_compile, ['T23220_aux.hs T23220.hs', '-v0'])
+
+test('T22106_A', [extra_files(['T22106_aux.hs'])], multimod_compile, ['T22106_A', '-v0'])
+test('T22106_B', [extra_files(['T22106_aux.hs'])], multimod_compile, ['T22106_B', '-v0'])
+test('T22106_C', [extra_files(['T22106_aux.hs'])], multimod_compile_fail, ['T22106_C', '-v0'])
+test('T22106_D', [extra_files(['T22106_aux.hs'])], multimod_compile, ['T22106_D', '-v0'])


=====================================
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/-/compare/42e6a8b057a858c68cb9740301f8126b108ab126...7d4e56eeb5e6b46094ac1d0f4a6c9ea1a9909824

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/42e6a8b057a858c68cb9740301f8126b108ab126...7d4e56eeb5e6b46094ac1d0f4a6c9ea1a9909824
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/5520e56b/attachment-0001.html>


More information about the ghc-commits mailing list