[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 9 commits: User's guide: Improve docs for -Wall

Marge Bot (@marge-bot) gitlab at gitlab.haskell.org
Fri Mar 24 17:42:12 UTC 2023



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


Commits:
46120bb6 by Joachim Breitner at 2023-03-24T13:09:43-04:00
User's guide: Improve docs for -Wall

previously it would list the warnings _not_ enabled by -Wall. That’s
unnecessary round-about and was out of date. So let's just name
the relevant warnings (based on `compiler/GHC/Driver/Flags.hs`).

- - - - -
509d1f11 by Ben Gamari at 2023-03-24T13:10:20-04:00
codeGen/tsan: Disable instrumentation of unaligned stores

There is some disagreement regarding the prototype of
`__tsan_unaligned_write` (specifically whether it takes just the written
address, or the address and the value as an argument). Moreover, I have
observed crashes which appear to be due to it. Disable instrumentation
of unaligned stores as a temporary mitigation.

Fixes #23096.

- - - - -
61e9cd7e by Li-yao Xia at 2023-03-24T13:41:38-04:00
base: Document GHC versions associated with past base versions in the changelog

- - - - -
857e5355 by Teo Camarasu at 2023-03-24T13:41:43-04:00
Add regression test for #17574

This test currently fails in the nonmoving way

- - - - -
bdbaf88a by Teo Camarasu at 2023-03-24T13:41:43-04:00
fix: account for large and compact object stats with nonmoving gc

Make sure that we keep track of the size of large and compact objects that have been moved onto the nonmoving heap.
We keep track of their size and add it to the amount of live bytes in nonmoving segments to get the total size of the live nonmoving heap.

Resolves #17574

- - - - -
7aaf8ade by David Feuer at 2023-03-24T13:41:48-04:00
Modify ThreadId documentation and comments

For a long time, `GHC.Conc.Sync` has said

```haskell
-- ToDo: data ThreadId = ThreadId (Weak ThreadId#)
-- But since ThreadId# is unlifted, the Weak type must use open
-- type variables.
```

We are now actually capable of using `Weak# ThreadId#`, but the
world has moved on. To support the `Show` and `Ord` instances, we'd
need to store the thread ID number in the `ThreadId`. And it seems
very difficult to continue to support `threadStatus` in that regime,
since it needs to be able to explain how threads died. In addition,
garbage collection of weak references can be quite expensive, and it
would be hard to evaluate the cost over he whole ecosystem. As discussed
in
[this CLC issue](https://github.com/haskell/core-libraries-committee/issues/125),
it doesn't seem very likely that we'll actually switch to weak
references here.

- - - - -
99147c37 by Ben Gamari at 2023-03-24T13:41:48-04:00
rts: Fix barriers of IND and IND_STATIC

Previously IND and IND_STATIC lacked the acquire barriers enjoyed by
BLACKHOLE. As noted in the (now updated) Note [Heap memory barriers],
this barrier is critical to ensure that the indirectee is visible to the
entering core.

Fixes #22872.

- - - - -
ab554601 by Krzysztof Gogolewski at 2023-03-24T13:41:49-04:00
Show an error when we cannot default a concrete tyvar

Fixes #23153

- - - - -
08285a6a by sheaf at 2023-03-24T13:41:49-04:00
Handle ConcreteTvs in inferResultToType

This patch fixes two issues.

  1. inferResultToType was discarding the ir_frr information, which meant
     some metavariables ended up being MetaTvs instead of ConcreteTvs.

     This function now creates new ConcreteTvs as necessary, instead of
     always creating MetaTvs.

  2. startSolvingByUnification can make some type variables concrete.
     However, it didn't return an updated type, so callers of this
     function, if they don't zonk, might miss this and accidentally
     perform a double update of a metavariable.

     We now return the updated type from this function, which avoids
     this issue.

Fixes #23154

- - - - -


30 changed files:

- compiler/GHC/Cmm/ThreadSanitizer.hs
- compiler/GHC/Tc/Errors/Ppr.hs
- compiler/GHC/Tc/Errors/Types.hs
- compiler/GHC/Tc/Gen/Head.hs
- compiler/GHC/Tc/Solver/Equality.hs
- compiler/GHC/Tc/Solver/Monad.hs
- compiler/GHC/Tc/Utils/TcMType.hs
- compiler/GHC/Tc/Utils/Unify.hs
- compiler/GHC/Tc/Utils/Zonk.hs
- compiler/GHC/Types/Error/Codes.hs
- docs/users_guide/using-warnings.rst
- libraries/base/GHC/Conc/Sync.hs
- libraries/base/changelog.md
- rts/StgMiscClosures.cmm
- rts/include/stg/SMP.h
- rts/sm/NonMoving.c
- rts/sm/NonMoving.h
- rts/sm/NonMovingMark.c
- rts/sm/NonMovingMark.h
- rts/sm/Storage.c
- testsuite/tests/rep-poly/RepPolyPatBind.stderr
- + testsuite/tests/rep-poly/T23153.hs
- + testsuite/tests/rep-poly/T23153.stderr
- + testsuite/tests/rep-poly/T23154.hs
- + testsuite/tests/rep-poly/T23154.stderr
- testsuite/tests/rep-poly/all.T
- + testsuite/tests/rts/T17574.hs
- + testsuite/tests/rts/T17574.stdout
- testsuite/tests/rts/all.T
- testsuite/tests/typecheck/should_fail/VtaFail.stderr


Changes:

=====================================
compiler/GHC/Cmm/ThreadSanitizer.hs
=====================================
@@ -54,11 +54,13 @@ annotateNode env node =
       CmmTick{}               -> BMiddle node
       CmmUnwind{}             -> BMiddle node
       CmmAssign{}             -> annotateNodeOO env node
-      CmmStore lhs rhs align  ->
+      -- TODO: Track unaligned stores
+      CmmStore _ _ Unaligned  -> annotateNodeOO env node
+      CmmStore lhs rhs NaturallyAligned  ->
           let ty = cmmExprType (platform env) rhs
               rhs_nodes = annotateLoads env (collectExprLoads rhs)
               lhs_nodes = annotateLoads env (collectExprLoads lhs)
-              st        = tsanStore env align ty lhs
+              st        = tsanStore env ty lhs
           in rhs_nodes `blockAppend` lhs_nodes `blockAppend` st `blockSnoc` node
       CmmUnsafeForeignCall (PrimTarget op) formals args ->
           let node' = fromMaybe (BMiddle node) (annotatePrim env op formals args)
@@ -197,17 +199,14 @@ tsanTarget fn formals args =
     lbl = mkForeignLabel fn Nothing ForeignLabelInExternalPackage IsFunction
 
 tsanStore :: Env
-          -> AlignmentSpec -> CmmType -> CmmExpr
+          -> CmmType -> CmmExpr
           -> Block CmmNode O O
-tsanStore env align ty addr =
+tsanStore env ty addr =
     mkUnsafeCall env ftarget [] [addr]
   where
     ftarget = tsanTarget fn [] [AddrHint]
     w = widthInBytes (typeWidth ty)
-    fn = case align of
-           Unaligned
-             | w > 1    -> fsLit $ "__tsan_unaligned_write" ++ show w
-           _            -> fsLit $ "__tsan_write" ++ show w
+    fn = fsLit $ "__tsan_write" ++ show w
 
 tsanLoad :: Env
          -> AlignmentSpec -> CmmType -> CmmExpr


=====================================
compiler/GHC/Tc/Errors/Ppr.hs
=====================================
@@ -1512,6 +1512,11 @@ instance Diagnostic TcRnMessage where
                    <+> quotes (ppr ps_name) <> colon)
                 2 (pprPatSynInvalidRhsReason ps_name lpat args reason)
            , text "RHS pattern:" <+> ppr lpat ]
+    TcRnCannotDefaultConcrete frr
+      -> mkSimpleDecorated $
+         ppr (frr_context frr) $$
+         text "cannot be assigned a fixed runtime representation," <+>
+         text "not even by defaulting."
 
   diagnosticReason = \case
     TcRnUnknownMessage m
@@ -2006,6 +2011,8 @@ instance Diagnostic TcRnMessage where
       -> ErrorWithoutFlag
     TcRnPatSynInvalidRhs{}
       -> ErrorWithoutFlag
+    TcRnCannotDefaultConcrete{}
+      -> ErrorWithoutFlag
 
   diagnosticHints = \case
     TcRnUnknownMessage m
@@ -2518,6 +2525,8 @@ instance Diagnostic TcRnMessage where
       -> noHints
     TcRnPatSynInvalidRhs{}
       -> noHints
+    TcRnCannotDefaultConcrete{}
+      -> [SuggestAddTypeSignatures UnnamedBinding]
 
   diagnosticCode = constructorCode
 


=====================================
compiler/GHC/Tc/Errors/Types.hs
=====================================
@@ -3356,6 +3356,16 @@ data TcRnMessage where
                        -> !PatSynInvalidRhsReason -- ^ The number of equation arguments
                        -> TcRnMessage
 
+  {- TcRnCannotDefaultConcrete is an error occurring when a concrete
+    type variable cannot be defaulted.
+
+    Test cases:
+      T23153
+  -}
+  TcRnCannotDefaultConcrete
+    :: !FixedRuntimeRepOrigin
+    -> TcRnMessage
+
   deriving Generic
 
 -- | Things forbidden in @type data@ declarations.


=====================================
compiler/GHC/Tc/Gen/Head.hs
=====================================
@@ -908,7 +908,7 @@ tcExprWithSig expr hs_ty
     loc = getLocA (dropWildCards hs_ty)
     ctxt = ExprSigCtxt (lhsSigWcTypeContextSpan hs_ty)
 
-tcExprSig :: UserTypeCtxt -> LHsExpr GhcRn -> TcIdSigInfo -> TcM (LHsExpr GhcTc, TcType)
+tcExprSig :: UserTypeCtxt -> LHsExpr GhcRn -> TcIdSigInfo -> TcM (LHsExpr GhcTc, TcSigmaType)
 tcExprSig ctxt expr (CompleteSig { sig_bndr = poly_id, sig_loc = loc })
   = setSrcSpan loc $   -- Sets the location for the implication constraint
     do { let poly_ty = idType poly_id


=====================================
compiler/GHC/Tc/Solver/Equality.hs
=====================================
@@ -1651,7 +1651,7 @@ canEqTyVarFunEq :: CtEvidence               -- :: lhs ~ (rhs |> mco)
                 -> MCoercion                -- :: kind(rhs) ~N kind(lhs)
                 -> TcS (StopOrContinue Ct)
 canEqTyVarFunEq ev eq_rel swapped tv1 ps_xi1 fun_tc2 fun_args2 ps_xi2 mco
-  = do { is_touchable <- touchabilityTest (ctEvFlavour ev) tv1 rhs
+  = do { (is_touchable, rhs) <- touchabilityTest (ctEvFlavour ev) tv1 rhs
        ; if | case is_touchable of { Untouchable -> False; _ -> True }
             , cterHasNoProblem $
                 checkTyVarEq tv1 rhs `cterRemoveProblem` cteTypeFamily
@@ -2440,7 +2440,7 @@ tryToSolveByUnification tv
        ; dont_unify }
 
   | otherwise
-  = do { is_touchable <- touchabilityTest (ctEvFlavour ev) tv rhs
+  = do { (is_touchable, rhs) <- touchabilityTest (ctEvFlavour ev) tv rhs
        ; traceTcS "tryToSolveByUnification" (vcat [ ppr tv <+> char '~' <+> ppr rhs
                                                   , ppr is_touchable ])
 


=====================================
compiler/GHC/Tc/Solver/Monad.hs
=====================================
@@ -1326,35 +1326,37 @@ instance Outputable TouchabilityTestResult where
   ppr (TouchableOuterLevel tvs lvl) = text "TouchableOuterLevel" <> parens (ppr lvl <+> ppr tvs)
   ppr Untouchable                   = text "Untouchable"
 
-touchabilityTest :: CtFlavour -> TcTyVar -> TcType -> TcS TouchabilityTestResult
--- This is the key test for untouchability:
+touchabilityTest :: CtFlavour -> TcTyVar -> TcType -> TcS (TouchabilityTestResult, TcType)
+-- ^ This is the key test for untouchability:
 -- See Note [Unification preconditions] in GHC.Tc.Utils.Unify
 -- and Note [Solve by unification] in GHC.Tc.Solver.Interact
+--
+-- Returns a new rhs type, as this function can turn make some metavariables concrete.
 touchabilityTest flav tv1 rhs
   | flav /= Given  -- See Note [Do not unify Givens]
   , MetaTv { mtv_tclvl = tv_lvl, mtv_info = info } <- tcTyVarDetails tv1
-  = do { can_continue_solving <- wrapTcS $ startSolvingByUnification info rhs
-       ; if not can_continue_solving
-         then return Untouchable
-         else
-    do { ambient_lvl  <- getTcLevel
+  = do { continue_solving <- wrapTcS $ startSolvingByUnification info rhs
+       ; case continue_solving of
+       { Nothing -> return (Untouchable, rhs)
+       ; Just rhs ->
+    do { let (free_metas, free_skols) = partition isPromotableMetaTyVar $
+                                        nonDetEltsUniqSet               $
+                                        tyCoVarsOfType rhs
+       ; ambient_lvl  <- getTcLevel
        ; given_eq_lvl <- getInnermostGivenEqLevel
 
        ; if | tv_lvl `sameDepthAs` ambient_lvl
-            -> return TouchableSameLevel
+            -> return (TouchableSameLevel, rhs)
 
             | tv_lvl `deeperThanOrSame` given_eq_lvl   -- No intervening given equalities
             , all (does_not_escape tv_lvl) free_skols  -- No skolem escapes
-            -> return (TouchableOuterLevel free_metas tv_lvl)
+            -> return (TouchableOuterLevel free_metas tv_lvl, rhs)
 
             | otherwise
-            -> return Untouchable } }
+            -> return (Untouchable, rhs) } } }
   | otherwise
-  = return Untouchable
+  = return (Untouchable, rhs)
   where
-     (free_metas, free_skols) = partition isPromotableMetaTyVar $
-                                nonDetEltsUniqSet               $
-                                tyCoVarsOfType rhs
 
      does_not_escape tv_lvl fv
        | isTyVar fv = tv_lvl `deeperThanOrSame` tcTyVarLevel fv
@@ -2165,23 +2167,21 @@ breakTyEqCycle_maybe ev cte_result lhs rhs
      -- See Detail (8) of the Note.
 
   = do { should_break <- final_check
-       ; if should_break then do { redn <- go rhs
-                                 ; return (Just redn) }
-                         else return Nothing }
+       ; mapM go should_break }
   where
     flavour = ctEvFlavour ev
     eq_rel  = ctEvEqRel ev
 
     final_check = case flavour of
-      Given  -> return True
+      Given  -> return $ Just rhs
       Wanted    -- Wanteds work only with a touchable tyvar on the left
                 -- See "Wanted" section of the Note.
         | TyVarLHS lhs_tv <- lhs ->
-          do { result <- touchabilityTest Wanted lhs_tv rhs
+          do { (result, rhs) <- touchabilityTest Wanted lhs_tv rhs
              ; return $ case result of
-                          Untouchable -> False
-                          _           -> True }
-        | otherwise -> return False
+                          Untouchable -> Nothing
+                          _           -> Just rhs }
+        | otherwise -> return Nothing
 
     -- This could be considerably more efficient. See Detail (5) of Note.
     go :: TcType -> TcS ReductionN


=====================================
compiler/GHC/Tc/Utils/TcMType.hs
=====================================
@@ -1,4 +1,5 @@
 {-# LANGUAGE MultiWayIf      #-}
+{-# LANGUAGE RecursiveDo     #-}
 {-# LANGUAGE TupleSections   #-}
 
 {-# OPTIONS_GHC -Wno-incomplete-record-updates #-}
@@ -480,7 +481,16 @@ newInferExpType :: TcM ExpType
 newInferExpType = new_inferExpType Nothing
 
 newInferExpTypeFRR :: FixedRuntimeRepContext -> TcM ExpTypeFRR
-newInferExpTypeFRR frr_orig = new_inferExpType (Just frr_orig)
+newInferExpTypeFRR frr_orig
+  = do { th_stage <- getStage
+       ; if
+          -- See [Wrinkle: Typed Template Haskell]
+          -- in Note [hasFixedRuntimeRep] in GHC.Tc.Utils.Concrete.
+          | Brack _ (TcPending {}) <- th_stage
+          -> new_inferExpType Nothing
+
+          | otherwise
+          -> new_inferExpType (Just frr_orig) }
 
 new_inferExpType :: Maybe FixedRuntimeRepContext -> TcM ExpType
 new_inferExpType mb_frr_orig
@@ -536,20 +546,28 @@ expTypeToType (Infer inf_res) = inferResultToType inf_res
 
 inferResultToType :: InferResult -> TcM Type
 inferResultToType (IR { ir_uniq = u, ir_lvl = tc_lvl
-                      , ir_ref = ref })
+                      , ir_ref = ref
+                      , ir_frr = mb_frr })
   = do { mb_inferred_ty <- readTcRef ref
        ; tau <- case mb_inferred_ty of
             Just ty -> do { ensureMonoType ty
                             -- See Note [inferResultToType]
                           ; return ty }
-            Nothing -> do { rr  <- newMetaTyVarTyAtLevel tc_lvl runtimeRepTy
-                          ; tau <- newMetaTyVarTyAtLevel tc_lvl (mkTYPEapp rr)
-                            -- See Note [TcLevel of ExpType]
+            Nothing -> do { tau <- new_meta
                           ; writeMutVar ref (Just tau)
                           ; return tau }
        ; traceTc "Forcing ExpType to be monomorphic:"
                  (ppr u <+> text ":=" <+> ppr tau)
        ; return tau }
+  where
+    -- See Note [TcLevel of ExpType]
+    new_meta = case mb_frr of
+      Nothing  ->  do { rr  <- newMetaTyVarTyAtLevel tc_lvl runtimeRepTy
+                      ; newMetaTyVarTyAtLevel tc_lvl (mkTYPEapp rr) }
+      Just frr -> mdo { rr  <- newConcreteTyVarAtLevel conc_orig tc_lvl runtimeRepTy
+                      ; tau <- newMetaTyVarTyAtLevel tc_lvl (mkTYPEapp rr)
+                      ; let conc_orig = ConcreteFRR $ FixedRuntimeRepOrigin tau frr
+                      ; return tau }
 
 {- Note [inferResultToType]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -872,6 +890,13 @@ newTauTvDetailsAtLevel tclvl
                         , mtv_ref   = ref
                         , mtv_tclvl = tclvl }) }
 
+newConcreteTvDetailsAtLevel :: ConcreteTvOrigin -> TcLevel -> TcM TcTyVarDetails
+newConcreteTvDetailsAtLevel conc_orig tclvl
+  = do { ref <- newMutVar Flexi
+       ; return (MetaTv { mtv_info  = ConcreteTv conc_orig
+                        , mtv_ref   = ref
+                        , mtv_tclvl = tclvl }) }
+
 cloneMetaTyVar :: TcTyVar -> TcM TcTyVar
 cloneMetaTyVar tv
   = assert (isTcTyVar tv) $
@@ -917,7 +942,7 @@ isUnfilledMetaTyVar tv
 
 --------------------
 -- Works with both type and kind variables
-writeMetaTyVar :: TcTyVar -> TcType -> TcM ()
+writeMetaTyVar :: HasDebugCallStack => TcTyVar -> TcType -> TcM ()
 -- Write into a currently-empty MetaTyVar
 
 writeMetaTyVar tyvar ty
@@ -935,7 +960,7 @@ writeMetaTyVar tyvar ty
   = massertPpr False (text "Writing to non-meta tyvar" <+> ppr tyvar)
 
 --------------------
-writeMetaTyVarRef :: TcTyVar -> TcRef MetaDetails -> TcType -> TcM ()
+writeMetaTyVarRef :: HasDebugCallStack => TcTyVar -> TcRef MetaDetails -> TcType -> TcM ()
 -- Here the tyvar is for error checking only;
 -- the ref cell must be for the same tyvar
 writeMetaTyVarRef tyvar ref ty
@@ -1100,6 +1125,13 @@ newMetaTyVarTyAtLevel tc_lvl kind
         ; name    <- newMetaTyVarName (fsLit "p")
         ; return (mkTyVarTy (mkTcTyVar name kind details)) }
 
+newConcreteTyVarAtLevel :: ConcreteTvOrigin -> TcLevel -> TcKind -> TcM TcType
+newConcreteTyVarAtLevel conc_orig tc_lvl kind
+  = do  { details <- newConcreteTvDetailsAtLevel conc_orig tc_lvl
+        ; name    <- newMetaTyVarName (fsLit "c")
+        ; return (mkTyVarTy (mkTcTyVar name kind details)) }
+
+
 {- *********************************************************************
 *                                                                      *
           Finding variables to quantify over
@@ -2235,7 +2267,7 @@ a \/\a in the final result but all the occurrences of a will be zonked to ()
 *                                                                      *
 ********************************************************************* -}
 
-promoteMetaTyVarTo :: TcLevel -> TcTyVar -> TcM Bool
+promoteMetaTyVarTo :: HasDebugCallStack => TcLevel -> TcTyVar -> TcM Bool
 -- When we float a constraint out of an implication we must restore
 -- invariant (WantedInv) in Note [TcLevel invariants] in GHC.Tc.Utils.TcType
 -- Return True <=> we did some promotion
@@ -2253,7 +2285,7 @@ promoteMetaTyVarTo tclvl tv
    = return False
 
 -- Returns whether or not *any* tyvar is defaulted
-promoteTyVarSet :: TcTyVarSet -> TcM Bool
+promoteTyVarSet :: HasDebugCallStack => TcTyVarSet -> TcM Bool
 promoteTyVarSet tvs
   = do { tclvl <- getTcLevel
        ; bools <- mapM (promoteMetaTyVarTo tclvl)  $


=====================================
compiler/GHC/Tc/Utils/Unify.hs
=====================================
@@ -2072,10 +2072,10 @@ uUnfilledVar2 origin t_or_k swapped tv1 ty2
            -- See Note [Unification preconditions], (UNTOUCHABLE) wrinkles
       , cterHasNoProblem (checkTyVarEq tv1 ty2)
            -- See Note [Prevent unification with type families]
-      = do { can_continue_solving <- startSolvingByUnification (metaTyVarInfo tv1) ty2
-           ; if not can_continue_solving
-             then not_ok_so_defer
-             else
+      = do { mb_continue_solving <- startSolvingByUnification (metaTyVarInfo tv1) ty2
+           ; case mb_continue_solving of
+           { Nothing -> not_ok_so_defer
+           ; Just ty2 ->
         do { co_k <- uType KindLevel kind_origin (typeKind ty2) (tyVarKind tv1)
            ; traceTc "uUnfilledVar2 ok" $
              vcat [ ppr tv1 <+> dcolon <+> ppr (tyVarKind tv1)
@@ -2089,9 +2089,9 @@ uUnfilledVar2 origin t_or_k swapped tv1 ty2
              then do { writeMetaTyVar tv1 ty2
                      ; return (mkNomReflCo ty2) }
 
-             else defer }} -- This cannot be solved now.  See GHC.Tc.Solver.Canonical
-                           -- Note [Equalities with incompatible kinds] for how
-                           -- this will be dealt with in the solver
+             else defer }}} -- This cannot be solved now.  See GHC.Tc.Solver.Canonical
+                            -- Note [Equalities with incompatible kinds] for how
+                            -- this will be dealt with in the solver
 
       | otherwise
       = not_ok_so_defer
@@ -2111,39 +2111,38 @@ uUnfilledVar2 origin t_or_k swapped tv1 ty2
 -- | Checks (TYVAR-TV), (COERCION-HOLE) and (CONCRETE) of
 -- Note [Unification preconditions]; returns True if these conditions
 -- are satisfied. But see the Note for other preconditions, too.
-startSolvingByUnification :: MetaInfo -> TcType  -- zonked
-                          -> TcM Bool
+startSolvingByUnification :: MetaInfo -> TcType -- zonked
+                          -> TcM (Maybe TcType)
 startSolvingByUnification _ xi
   | hasCoercionHoleTy xi  -- (COERCION-HOLE) check
-  = return False
+  = return Nothing
 startSolvingByUnification info xi
   = case info of
-      CycleBreakerTv -> return False
+      CycleBreakerTv -> return Nothing
       ConcreteTv conc_orig ->
-        do { (_, not_conc_reasons) <- makeTypeConcrete conc_orig xi
+        do { (xi, not_conc_reasons) <- makeTypeConcrete conc_orig xi
                  -- NB: makeTypeConcrete has the side-effect of turning
                  -- some TauTvs into ConcreteTvs, e.g.
                  -- alpha[conc] ~# TYPE (TupleRep '[ beta[tau], IntRep ])
                  -- will write `beta[tau] := beta[conc]`.
                  --
-                 -- We don't need to track these unifications for the purposes
-                 -- of constraint solving (e.g. updating tcs_unified or tcs_unif_lvl),
-                 -- as they don't unlock any further progress.
+                 -- We return the new type, so that callers of this function
+                 -- aren't required to zonk.
            ; case not_conc_reasons of
-               [] -> return True
-               _  -> return False }
+               [] -> return $ Just xi
+               _  -> return Nothing }
       TyVarTv ->
         case getTyVar_maybe xi of
-           Nothing -> return False
+           Nothing -> return Nothing
            Just tv ->
              case tcTyVarDetails tv of -- (TYVAR-TV) wrinkle
-                SkolemTv {} -> return True
-                RuntimeUnk  -> return True
+                SkolemTv {} -> return $ Just xi
+                RuntimeUnk  -> return $ Just xi
                 MetaTv { mtv_info = info } ->
                   case info of
-                    TyVarTv -> return True
-                    _       -> return False
-      _ -> return True
+                    TyVarTv -> return $ Just xi
+                    _       -> return Nothing
+      _ -> return $ Just xi
 
 swapOverTyVars :: Bool -> TcTyVar -> TcTyVar -> Bool
 swapOverTyVars is_given tv1 tv2


=====================================
compiler/GHC/Tc/Utils/Zonk.hs
=====================================
@@ -56,6 +56,7 @@ import GHC.Tc.Utils.TcType
 import GHC.Tc.Utils.TcMType
 import GHC.Tc.Utils.Env   ( tcLookupGlobalOnly )
 import GHC.Tc.Types.Evidence
+import GHC.Tc.Errors.Types
 
 import GHC.Core.TyCo.Ppr     ( pprTyVar )
 import GHC.Core.TyCon
@@ -1737,7 +1738,7 @@ change.  But in some cases it makes a HUGE difference: see test
 T9198 and #19668.  So yes, it seems worth it.
 -}
 
-zonkTyVarOcc :: ZonkEnv -> TcTyVar -> TcM Type
+zonkTyVarOcc :: HasDebugCallStack => ZonkEnv -> TcTyVar -> TcM Type
 zonkTyVarOcc env@(ZonkEnv { ze_flexi = flexi
                           , ze_tv_env = tv_env
                           , ze_meta_tv_env = mtv_env_ref }) tv
@@ -1810,6 +1811,9 @@ commitFlexi flexi tv zonked_kind
         | isMultiplicityTy zonked_kind
         -> do { traceTc "Defaulting flexi tyvar to Many:" (pprTyVar tv)
               ; return manyDataConTy }
+        | Just (ConcreteFRR origin) <- isConcreteTyVar_maybe tv
+        -> do { addErr $ TcRnCannotDefaultConcrete origin
+              ; return (anyTypeOfKind zonked_kind) }
         | otherwise
         -> do { traceTc "Defaulting flexi tyvar to Any:" (pprTyVar tv)
               ; return (anyTypeOfKind zonked_kind) }


=====================================
compiler/GHC/Types/Error/Codes.hs
=====================================
@@ -548,6 +548,7 @@ type family GhcDiagnosticCode c = n | n -> c where
   GhcDiagnosticCode "TcRnPatSynArityMismatch"                       = 18365
   GhcDiagnosticCode "PatSynNotInvertible"                           = 69317
   GhcDiagnosticCode "PatSynUnboundVar"                              = 28572
+  GhcDiagnosticCode "TcRnCannotDefaultConcrete"                     = 52083
 
   -- IllegalNewtypeReason
   GhcDiagnosticCode "DoesNotHaveSingleField"                        = 23517


=====================================
docs/users_guide/using-warnings.rst
=====================================
@@ -113,32 +113,24 @@ as ``-Wno-...`` for every individual warning in the group.
     :category:
 
     Turns on all warning options that indicate potentially suspicious
-    code. The warnings that are *not* enabled by :ghc-flag:`-Wall` are
+    code. They include all  warnings in :ghc-flag:`-Wextra`, plus:
 
     .. hlist::
         :columns: 3
 
-        * :ghc-flag:`-Wmonomorphism-restriction`
-        * :ghc-flag:`-Wimplicit-prelude`
-        * :ghc-flag:`-Wmissing-local-signatures`
-        * :ghc-flag:`-Wmissing-exported-signatures`
-        * :ghc-flag:`-Wmissing-export-lists`
-        * :ghc-flag:`-Wmissing-import-lists`
-        * :ghc-flag:`-Wmissing-home-modules`
-        * :ghc-flag:`-Widentities`
-        * :ghc-flag:`-Wredundant-constraints`
-        * :ghc-flag:`-Wpartial-fields`
-        * :ghc-flag:`-Wmissed-specialisations`
-        * :ghc-flag:`-Wall-missed-specialisations`
-        * :ghc-flag:`-Wcpp-undef`
-        * :ghc-flag:`-Wduplicate-constraints`
-        * :ghc-flag:`-Wmissing-deriving-strategies`
-        * :ghc-flag:`-Wunused-packages`
-        * :ghc-flag:`-Wunused-type-patterns`
-        * :ghc-flag:`-Wsafe`
-        * :ghc-flag:`-Wimplicit-lift`
-        * :ghc-flag:`-Wmissing-kind-signatures`
-        * :ghc-flag:`-Wunticked-promoted-constructors`
+        * :ghc-flag:`-Whi-shadowing`
+        * :ghc-flag:`-Wincomplete-record-updates`
+        * :ghc-flag:`-Wincomplete-uni-patterns`
+        * :ghc-flag:`-Wmissing-pattern-synonym-signatures`
+        * :ghc-flag:`-Wmissing-signatures`
+        * :ghc-flag:`-Wname-shadowing`
+        * :ghc-flag:`-Worphans`
+        * :ghc-flag:`-Wredundant-record-wildcards`
+        * :ghc-flag:`-Wstar-is-type`
+        * :ghc-flag:`-Wtrustworthy-safe`
+        * :ghc-flag:`-Wtype-defaults`
+        * :ghc-flag:`-Wunused-do-bind`
+        * :ghc-flag:`-Wunused-record-wildcards`
 
 .. ghc-flag:: -Weverything
     :shortdesc: enable all warnings supported by GHC


=====================================
libraries/base/GHC/Conc/Sync.hs
=====================================
@@ -133,9 +133,6 @@ infixr 0 `par`, `pseq`
 -----------------------------------------------------------------------------
 
 data ThreadId = ThreadId ThreadId#
--- ToDo: data ThreadId = ThreadId (Weak ThreadId#)
--- But since ThreadId# is unlifted, the Weak type must use open
--- type variables.
 {- ^
 A 'ThreadId' is an abstract type representing a handle to a thread.
 'ThreadId' is an instance of 'Eq', 'Ord' and 'Show', where
@@ -146,10 +143,9 @@ useful when debugging or diagnosing the behaviour of a concurrent
 program.
 
 /Note/: in GHC, if you have a 'ThreadId', you essentially have
-a pointer to the thread itself.  This means the thread itself can\'t be
-garbage collected until you drop the 'ThreadId'.
-This misfeature will hopefully be corrected at a later date.
-
+a pointer to the thread itself. This means the thread itself can\'t be
+garbage collected until you drop the 'ThreadId'. This misfeature would
+be difficult to correct while continuing to support 'threadStatus'.
 -}
 
 -- | @since 4.2.0.0


=====================================
libraries/base/changelog.md
=====================================
@@ -16,10 +16,11 @@
       ([CLC proposal #57](https://github.com/haskell/core-libraries-committee/issues/57))
 
 ## 4.18.0.0 *TBA*
-
+  * Shipped with GHC 9.6.1
   * `Foreign.C.ConstPtr.ConstrPtr` was added to encode `const`-qualified
     pointer types in foreign declarations when using `CApiFFI` extension. ([CLC proposal #117](https://github.com/haskell/core-libraries-committee/issues/117))
   * Add `forall a. Functor (p a)` superclass for `Bifunctor p` ([CLC proposal #91](https://github.com/haskell/core-libraries-committee/issues/91))
+  * Add `forall a. Functor (p a)` superclass for `Bifunctor p`.
   * Add Functor instances for `(,,,,) a b c d`, `(,,,,,) a b c d e` and
     `(,,,,,) a b c d e f`.
   * Exceptions thrown by weak pointer finalizers can now be reported by setting
@@ -91,6 +92,8 @@
 
 ## 4.17.0.0 *August 2022*
 
+  * Shipped with GHC 9.4.1
+
   * Add explicitly bidirectional `pattern TypeRep` to `Type.Reflection`.
 
   * Add `Generically` and `Generically1` to `GHC.Generics` for deriving generic
@@ -200,6 +203,8 @@
 
 ## 4.16.0.0 *Nov 2021*
 
+  * Shipped with GHC 9.2.1
+
   * The unary tuple type, `Solo`, is now exported by `Data.Tuple`.
 
   * Add a `Typeable` constraint to `fromStaticPtr` in the class `GHC.StaticPtr.IsStatic`.
@@ -260,6 +265,8 @@
 
 ## 4.15.0.0 *Feb 2021*
 
+  * Shipped with GHC 9.0.1
+
   * `openFile` now calls the `open` system call with an `interruptible` FFI
     call, ensuring that the call can be interrupted with `SIGINT` on POSIX
     systems.


=====================================
rts/StgMiscClosures.cmm
=====================================
@@ -521,6 +521,7 @@ INFO_TABLE(stg_IND,1,0,IND,"IND","IND")
     (P_ node)
 {
     TICK_ENT_DYN_IND(); /* tick */
+    ACQUIRE_FENCE;
     node = UNTAG(StgInd_indirectee(node));
     TICK_ENT_VIA_NODE();
     jump %GET_ENTRY(node) (node);
@@ -529,6 +530,7 @@ INFO_TABLE(stg_IND,1,0,IND,"IND","IND")
     /* explicit stack */
 {
     TICK_ENT_DYN_IND(); /* tick */
+    ACQUIRE_FENCE;
     R1 = UNTAG(StgInd_indirectee(R1));
     TICK_ENT_VIA_NODE();
     jump %GET_ENTRY(R1) [R1];
@@ -539,6 +541,7 @@ INFO_TABLE(stg_IND_STATIC,1,0,IND_STATIC,"IND_STATIC","IND_STATIC")
     /* explicit stack */
 {
     TICK_ENT_STATIC_IND(); /* tick */
+    ACQUIRE_FENCE;
     R1 = UNTAG(StgInd_indirectee(R1));
     TICK_ENT_VIA_NODE();
     jump %GET_ENTRY(R1) [R1];


=====================================
rts/include/stg/SMP.h
=====================================
@@ -214,23 +214,22 @@ EXTERN_INLINE void load_load_barrier(void);
  * examining a thunk being updated can see the indirectee. Consequently, a
  * thunk update (see rts/Updates.h) does the following:
  *
- *  1. Use a release-fence to ensure that the indirectee is visible
- *  2. Use a relaxed-store to place the new indirectee into the thunk's
+ *  1. Use a relaxed-store to place the new indirectee into the thunk's
  *     indirectee field
- *  3. use a release-store to set the info table to stg_BLACKHOLE (which
+ *  2. use a release-store to set the info table to stg_BLACKHOLE (which
  *     represents an indirection)
  *
  * Blackholing a thunk (either eagerly, by GHC.StgToCmm.Bind.emitBlackHoleCode,
  * or lazily, by ThreadPaused.c:threadPaused) is done similarly.
  *
- * Conversely, thunk entry (see the entry code of stg_BLACKHOLE in
- * rts/StgMiscClosure) does the following:
+ * Conversely, indirection entry (see the entry code of stg_BLACKHOLE, stg_IND,
+ * and stg_IND_STATIC in rts/StgMiscClosure.cmm) does the following:
  *
- *  1. We jump into the entry code for stg_BLACKHOLE; this of course implies
- *     that we have already read the thunk's info table pointer, which is done
- *     with a relaxed load.
+ *  1. We jump into the entry code for, e.g., stg_BLACKHOLE; this of course
+ *     implies that we have already read the thunk's info table pointer, which
+ *     is done with a relaxed load.
  *  2. use an acquire-fence to ensure that our view on the thunk is
- *     up-to-date. This synchronizes with step (3) in the update
+ *     up-to-date. This synchronizes with step (2) in the update
  *     procedure.
  *  3. relaxed-load the indirectee. Since thunks are updated at most
  *     once we know that the fence in the last step has given us


=====================================
rts/sm/NonMoving.c
=====================================
@@ -395,7 +395,8 @@ Mutex concurrent_coll_finished_lock;
  * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  * The nonmoving collector uses an approximate heuristic for reporting live
  * data quantity. Specifically, during mark we record how much live data we
- * find in nonmoving_live_words. At the end of mark we declare this amount to
+ * find in nonmoving_segment_live_words. At the end of mark this is combined with nonmoving_large_words
+ * and nonmoving_compact_words, and we declare this amount to
  * be how much live data we have on in the nonmoving heap (by setting
  * oldest_gen->live_estimate).
  *
@@ -540,7 +541,7 @@ Mutex concurrent_coll_finished_lock;
  *
  */
 
-memcount nonmoving_live_words = 0;
+memcount nonmoving_segment_live_words = 0;
 
 // See Note [Sync phase marking budget].
 MarkBudget sync_phase_marking_budget = 200000;
@@ -682,10 +683,11 @@ static void nonmovingPrepareMark(void)
         dbl_link_onto(bd, &nonmoving_large_objects);
     }
     n_nonmoving_large_blocks += oldest_gen->n_large_blocks;
+    nonmoving_large_words += oldest_gen->n_large_words;
     oldest_gen->large_objects = NULL;
     oldest_gen->n_large_words = 0;
     oldest_gen->n_large_blocks = 0;
-    nonmoving_live_words = 0;
+    nonmoving_segment_live_words = 0;
 
     // Clear compact object mark bits
     for (bdescr *bd = nonmoving_compact_objects; bd; bd = bd->link) {
@@ -700,6 +702,7 @@ static void nonmovingPrepareMark(void)
         dbl_link_onto(bd, &nonmoving_compact_objects);
     }
     n_nonmoving_compact_blocks += oldest_gen->n_compact_blocks;
+    nonmoving_compact_words += oldest_gen->n_compact_blocks * BLOCK_SIZE_W;
     oldest_gen->n_compact_blocks = 0;
     oldest_gen->compact_objects = NULL;
     // TODO (osa): what about "in import" stuff??
@@ -1053,7 +1056,9 @@ concurrent_marking:
     freeMarkQueue(mark_queue);
     stgFree(mark_queue);
 
-    oldest_gen->live_estimate = nonmoving_live_words;
+    nonmoving_large_words = countOccupied(nonmoving_marked_large_objects);
+    nonmoving_compact_words = n_nonmoving_marked_compact_blocks * BLOCK_SIZE_W;
+    oldest_gen->live_estimate = nonmoving_segment_live_words + nonmoving_large_words + nonmoving_compact_words;
     oldest_gen->n_old_blocks = 0;
     resizeGenerations();
 


=====================================
rts/sm/NonMoving.h
=====================================
@@ -122,7 +122,7 @@ struct NonmovingHeap {
 
 extern struct NonmovingHeap nonmovingHeap;
 
-extern memcount nonmoving_live_words;
+extern memcount nonmoving_segment_live_words;
 
 #if defined(THREADED_RTS)
 extern bool concurrent_coll_running;


=====================================
rts/sm/NonMovingMark.c
=====================================
@@ -76,6 +76,10 @@ static bool is_nonmoving_weak(StgWeak *weak);
  * consequently will trace the pointers of only one object per block. However,
  * this is okay since the only type of pinned object supported by GHC is the
  * pinned ByteArray#, which has no pointers.
+ *
+ * We need to take care that the stats department is made aware of the amount of
+ * live large (and compact) objects, since they no longer live on gen[i]->large_objects.
+ * Failing to do so caused #17574.
  */
 
 bdescr *nonmoving_large_objects = NULL;
@@ -83,6 +87,9 @@ bdescr *nonmoving_marked_large_objects = NULL;
 memcount n_nonmoving_large_blocks = 0;
 memcount n_nonmoving_marked_large_blocks = 0;
 
+memcount nonmoving_large_words = 0;
+memcount nonmoving_compact_words = 0;
+
 bdescr *nonmoving_compact_objects = NULL;
 bdescr *nonmoving_marked_compact_objects = NULL;
 memcount n_nonmoving_compact_blocks = 0;
@@ -1745,7 +1752,7 @@ mark_closure (MarkQueue *queue, const StgClosure *p0, StgClosure **origin)
         struct NonmovingSegment *seg = nonmovingGetSegment((StgPtr) p);
         nonmoving_block_idx block_idx = nonmovingGetBlockIdx((StgPtr) p);
         nonmovingSetMark(seg, block_idx);
-        nonmoving_live_words += nonmovingSegmentBlockSize(seg) / sizeof(W_);
+        nonmoving_segment_live_words += nonmovingSegmentBlockSize(seg) / sizeof(W_);
     }
 
     // If we found a indirection to shortcut keep going.


=====================================
rts/sm/NonMovingMark.h
=====================================
@@ -127,6 +127,11 @@ extern bdescr *nonmoving_large_objects, *nonmoving_marked_large_objects,
 extern memcount n_nonmoving_large_blocks, n_nonmoving_marked_large_blocks,
                 n_nonmoving_compact_blocks, n_nonmoving_marked_compact_blocks;
 
+// The size of live large/compact objects in words.
+// Only updated at the end of nonmoving GC.
+extern memcount nonmoving_large_words,
+                nonmoving_compact_words;
+
 extern StgTSO *nonmoving_old_threads;
 extern StgWeak *nonmoving_old_weak_ptr_list;
 extern StgTSO *nonmoving_threads;


=====================================
rts/sm/Storage.c
=====================================
@@ -42,6 +42,7 @@
 #include "GC.h"
 #include "Evac.h"
 #include "NonMovingAllocate.h"
+#include "sm/NonMovingMark.h"
 #if defined(ios_HOST_OS) || defined(darwin_HOST_OS)
 #include "Hash.h"
 #endif
@@ -1615,7 +1616,12 @@ W_ genLiveWords (generation *gen)
 
 W_ genLiveBlocks (generation *gen)
 {
-    return gen->n_blocks + gen->n_large_blocks + gen->n_compact_blocks;
+  W_ nonmoving_blocks = 0;
+  // The nonmoving heap contains some blocks that live outside the regular generation structure.
+  if (gen == oldest_gen && RtsFlags.GcFlags.useNonmoving){
+    nonmoving_blocks = n_nonmoving_large_blocks + n_nonmoving_marked_large_blocks + n_nonmoving_compact_blocks + n_nonmoving_marked_compact_blocks;
+  }
+  return gen->n_blocks + gen->n_large_blocks + gen->n_compact_blocks + nonmoving_blocks;
 }
 
 W_ gcThreadLiveWords (uint32_t i, uint32_t g)
@@ -1711,6 +1717,9 @@ StgWord calcTotalLargeObjectsW (void)
     for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
         totalW += generations[g].n_large_words;
     }
+
+    totalW += nonmoving_large_words;
+
     return totalW;
 }
 
@@ -1722,6 +1731,9 @@ StgWord calcTotalCompactW (void)
     for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
         totalW += generations[g].n_compact_blocks * BLOCK_SIZE_W;
     }
+
+    totalW += nonmoving_compact_words;
+
     return totalW;
 }
 


=====================================
testsuite/tests/rep-poly/RepPolyPatBind.stderr
=====================================
@@ -17,3 +17,36 @@ RepPolyPatBind.hs:18:5: error: [GHC-55287]
                 x, y :: a
                 (# x, y #) = undefined
               in x
+
+RepPolyPatBind.hs:18:8: error: [GHC-55287]
+    • The pattern binding does not have a fixed runtime representation.
+      Its type is:
+        (# a0, b0 #) :: TYPE (TupleRep [k00, k10])
+      Cannot unify ‘rep’ with the type variable ‘k00’
+      because it is not a concrete ‘RuntimeRep’.
+    • In the pattern: (# x, y #)
+      In a pattern binding: (# x, y #) = undefined
+      In the expression:
+        let
+          x, y :: a
+          (# x, y #) = undefined
+        in x
+    • Relevant bindings include
+        foo :: () -> a (bound at RepPolyPatBind.hs:15:1)
+
+RepPolyPatBind.hs:18:11: error: [GHC-55287]
+    • The pattern binding does not have a fixed runtime representation.
+      Its type is:
+        (# a0, b0 #) :: TYPE (TupleRep [k00, k10])
+      Cannot unify ‘rep’ with the type variable ‘k10’
+      because it is not a concrete ‘RuntimeRep’.
+    • In the pattern: (# x, y #)
+      In a pattern binding: (# x, y #) = undefined
+      In the expression:
+        let
+          x, y :: a
+          (# x, y #) = undefined
+        in x
+    • Relevant bindings include
+        x :: a (bound at RepPolyPatBind.hs:18:8)
+        foo :: () -> a (bound at RepPolyPatBind.hs:15:1)


=====================================
testsuite/tests/rep-poly/T23153.hs
=====================================
@@ -0,0 +1,8 @@
+module T23153 where
+
+import GHC.Exts
+
+f :: forall r s (a :: TYPE (r s)). a -> ()
+f = f
+
+g h = f (h ())


=====================================
testsuite/tests/rep-poly/T23153.stderr
=====================================
@@ -0,0 +1,15 @@
+
+T23153.hs:8:1: error: [GHC-52083]
+    The argument ‘(h ())’ of ‘f’
+    cannot be assigned a fixed runtime representation, not even by defaulting.
+    Suggested fix: Add a type signature.
+
+T23153.hs:8:1: error: [GHC-52083]
+    The argument ‘(h ())’ of ‘f’
+    cannot be assigned a fixed runtime representation, not even by defaulting.
+    Suggested fix: Add a type signature.
+
+T23153.hs:8:1: error: [GHC-52083]
+    The argument ‘(h ())’ of ‘f’
+    cannot be assigned a fixed runtime representation, not even by defaulting.
+    Suggested fix: Add a type signature.


=====================================
testsuite/tests/rep-poly/T23154.hs
=====================================
@@ -0,0 +1,7 @@
+{-# LANGUAGE PartialTypeSignatures #-}
+
+module T23154 where
+
+import GHC.Exts
+
+f x = x :: (_ :: (TYPE (_ _)))


=====================================
testsuite/tests/rep-poly/T23154.stderr
=====================================
@@ -0,0 +1,15 @@
+
+T23154.hs:7:1: error: [GHC-52083]
+    The first pattern in the equation for ‘f’
+    cannot be assigned a fixed runtime representation, not even by defaulting.
+    Suggested fix: Add a type signature.
+
+T23154.hs:7:1: error: [GHC-52083]
+    The first pattern in the equation for ‘f’
+    cannot be assigned a fixed runtime representation, not even by defaulting.
+    Suggested fix: Add a type signature.
+
+T23154.hs:7:1: error: [GHC-52083]
+    The first pattern in the equation for ‘f’
+    cannot be assigned a fixed runtime representation, not even by defaulting.
+    Suggested fix: Add a type signature.


=====================================
testsuite/tests/rep-poly/all.T
=====================================
@@ -116,3 +116,5 @@ test('T21650_b', normal, compile_fail, ['-Wno-deprecated-flags'])            ##
 
 
 test('T23051', normal, compile_fail, [''])
+test('T23153', normal, compile_fail, [''])
+test('T23154', normal, compile_fail, [''])


=====================================
testsuite/tests/rts/T17574.hs
=====================================
@@ -0,0 +1,40 @@
+-- | Check that large objects are properly accounted for by GHC.Stats
+module Main (main) where
+
+import Control.Monad
+import Control.Exception
+import Control.Concurrent
+import System.Mem
+import System.Exit
+import GHC.Stats
+import GHC.Compact
+import Data.List (replicate)
+
+import qualified Data.ByteString.Char8 as BS
+
+doGC :: IO ()
+doGC = do
+  performMajorGC
+  threadDelay 1000 -- small delay to allow GC to run when using concurrent gc
+
+main :: IO ()
+main = do
+  let size = 4096*2
+  largeString <- evaluate $ BS.replicate size 'A'
+  compactString <- compact $ replicate size 'A'
+  doGC
+  doGC -- run GC twice to make sure the objects end up in the oldest gen
+  stats <- getRTSStats
+  let large_obj_bytes = gcdetails_large_objects_bytes $ gc stats
+  let compact_obj_bytes = gcdetails_compact_bytes $ gc stats
+  -- assert that large_obj_bytes is at least as big as size
+  -- this indicates that `largeString` is being accounted for by the stats department
+  when (large_obj_bytes < fromIntegral size) $ do
+    putStrLn $ "large_obj_bytes is: " <> show large_obj_bytes <> " but expected at least: " <> show size
+    exitFailure
+  when (compact_obj_bytes < fromIntegral size) $ do
+    putStrLn $ "compact_obj_bytes is: " <> show large_obj_bytes <> " but expected at least: " <> show size
+    exitFailure
+  -- keep them alive
+  print $ BS.length largeString
+  print $ length $ getCompact compactString


=====================================
testsuite/tests/rts/T17574.stdout
=====================================
@@ -0,0 +1,2 @@
+8192
+8192


=====================================
testsuite/tests/rts/all.T
=====================================
@@ -573,3 +573,5 @@ test('decodeMyStack_emptyListForMissingFlag',
 test('T22795a', [only_ways(['normal']), js_skip], compile_and_run, ['-threaded'])
 test('T22795b', [only_ways(['normal']), js_skip], compile_and_run, ['-single-threaded'])
 test('T22795c', [only_ways(['normal']), js_skip], compile_and_run, ['-threaded -single-threaded'])
+
+test('T17574', [js_skip], compile_and_run, ['-with-rtsopts -T'])


=====================================
testsuite/tests/typecheck/should_fail/VtaFail.stderr
=====================================
@@ -7,7 +7,7 @@ VtaFail.hs:7:16: error: [GHC-95781]
           answer_nosig = pairup_nosig @Int @Bool 5 True
 
 VtaFail.hs:14:17: error: [GHC-95781]
-    • Cannot apply expression of type ‘p1 -> p1’
+    • Cannot apply expression of type ‘p0 -> p0’
       to a visible type argument ‘Int’
     • In the expression: (\ x -> x) @Int 12
       In an equation for ‘answer_lambda’:



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/14d989e89d71a2d9bd02a6ca753a0ec80115a789...08285a6a2f84613b1ec439cd47a9cc6ed4427aac

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/14d989e89d71a2d9bd02a6ca753a0ec80115a789...08285a6a2f84613b1ec439cd47a9cc6ed4427aac
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/20230324/af9db51a/attachment-0001.html>


More information about the ghc-commits mailing list