Make STG rewriter produce updatable closures

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 prevent duplicate work 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 $

testsuite/tests/simplStg/should_run/T23783.hs

+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 ()
\ No newline at end of file

testsuite/tests/simplStg/should_run/T23783a.hs

+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` ()
\ No newline at end of file