[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 2 commits: Make STG rewriter produce updatable closures

[Marge Bot (@marge-bot)]

Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC


Commits:
5a139813 by Jaro Reinders at 2023-09-06T16:22:48-04:00
Make STG rewriter produce updatable closures

- - - - -
b15e4876 by Krzysztof Gogolewski at 2023-09-06T16:22:49-04:00
configure: update message to use hadrian (#22616)

- - - - -


5 changed files:

- compiler/GHC/Stg/InferTags/Rewrite.hs
- configure.ac
- + testsuite/tests/simplStg/should_run/T23783.hs
- + testsuite/tests/simplStg/should_run/T23783a.hs
- testsuite/tests/simplStg/should_run/all.T


Changes:

=====================================
compiler/GHC/Stg/InferTags/Rewrite.hs
=====================================
@@ -368,7 +368,10 @@ rewriteRhs (_id, _tagSig) (StgRhsCon ccs con cn ticks args typ) = {-# SCC rewrit
             fvs <- fvArgs args
             -- lcls <- getFVs
             -- pprTraceM "RhsClosureConversion" (ppr (StgRhsClosure fvs ccs ReEntrant [] $! conExpr) $$ text "lcls:" <> ppr lcls)
-            return $! (StgRhsClosure fvs ccs ReEntrant [] $! conExpr) typ
+
+            -- We mark the closure updatable to retain sharing in the case that
+            -- conExpr is an infinite recursive data type. See #23783.
+            return $! (StgRhsClosure fvs ccs Updatable [] $! conExpr) typ
 rewriteRhs _binding (StgRhsClosure fvs ccs flag args body typ) = do
     withBinders NotTopLevel args $
         withClosureLcls fvs $


=====================================
configure.ac
=====================================
@@ -1313,13 +1313,17 @@ echo "----------------------------------------------------------------------
 "
 
 echo "\
-For a standard build of GHC (fully optimised with profiling), type (g)make.
+For a standard build of GHC (fully optimised with profiling), type
+   ./hadrian/build
 
-To make changes to the default build configuration, copy the file
-mk/build.mk.sample to mk/build.mk, and edit the settings in there.
+You can customise the build with flags such as
+   ./hadrian/build -j --flavour=devel2 [--freeze1]
+
+To make changes to the default build configuration, see the file
+   hadrian/src/UserSettings.hs
 
 For more information on how to configure your GHC build, see
-   https://gitlab.haskell.org/ghc/ghc/wikis/building
+   https://gitlab.haskell.org/ghc/ghc/-/wikis/building/hadrian
 "]
 
 # Currently we don't validate the /host/ GHC toolchain because configure


=====================================
testsuite/tests/simplStg/should_run/T23783.hs
=====================================
@@ -0,0 +1,18 @@
+module Main where
+import T23783a
+import GHC.Conc
+
+expensive :: Int -> Int
+{-# OPAQUE expensive #-}
+expensive x = x
+
+{-# OPAQUE f #-}
+f xs = let ys = expensive xs
+           h zs = let t = wombat t ys in ys `seq` (zs, t, ys)
+        in h
+
+main :: IO ()
+main = do
+  setAllocationCounter 100000
+  enableAllocationLimit
+  case f 0 () of (_, t, _) -> seqT 16 t `seq` pure ()


=====================================
testsuite/tests/simplStg/should_run/T23783a.hs
=====================================
@@ -0,0 +1,8 @@
+module T23783a where
+import Debug.Trace
+data T a = MkT (T a) (T a) !a !Int
+wombat t x = MkT t t x 2
+
+seqT :: Int -> T a -> ()
+seqT 0 _ = ()
+seqT n (MkT x y _ _) = seqT (n - 1) x `seq` seqT (n - 1) y `seq` ()


=====================================
testsuite/tests/simplStg/should_run/all.T
=====================================
@@ -20,3 +20,4 @@ test('T13536a',
 
 test('inferTags001', normal, multimod_compile_and_run, ['inferTags001', 'inferTags001_a'])
 test('T22042', [extra_files(['T22042a.hs']),only_ways('normal'),unless(have_dynamic(), skip)], makefile_test, ['T22042'])
+test('T23783', normal, multimod_compile_and_run, ['T23783', '-O -v0'])
\ No newline at end of file



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a7aaf159d79b9c05e36feb41980dc887ec4a144d...b15e487657f34b93b07316b75627e4db6f840cf2

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a7aaf159d79b9c05e36feb41980dc887ec4a144d...b15e487657f34b93b07316b75627e4db6f840cf2
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/20230906/ad76ffc7/attachment-0001.html>