[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 7 commits: ghc-internal: Move STM utilities out of GHC.Internal.Conc.Sync

9 Jan 2026

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


Commits:
00e17eee by Ben Gamari at 2026-01-09T08:45:52-05:00
ghc-internal: Move STM utilities out of GHC.Internal.Conc.Sync

This is necessary to avoid an import cycle on Windows when importing
`GHC.Internal.Exception.Context` in `GHC.Internal.Conc.Sync`.

On the road to address #25365.

- - - - -
f8c0aa39 by Ben Gamari at 2026-01-09T08:45:52-05:00
base: Capture backtrace from throwSTM

Implements core-libraries-committee#297.

Fixes #25365.

- - - - -
a43f07b2 by Ben Gamari at 2026-01-09T08:45:52-05:00
base: Annotate rethrown exceptions in catchSTM with WhileHandling

Implements core-libraries-committee#298

- - - - -
fe7f0b67 by Cheng Shao at 2026-01-09T08:45:53-05:00
compiler: make getPrim eagerly evaluate its result

This commit makes `GHC.Utils.Binary.getPrim` eagerly evaluate its
result, to avoid accidental laziness when future patches build other
binary parsers using `getPrim`.

- - - - -
5cbb00db by Cheng Shao at 2026-01-09T08:45:53-05:00
compiler: implement fast get/put for Word16/Word32/Word64

Previously, `GHC.Utils.Binary` contains `get`/`put` functions for
`Word16`/`Word32`/`Word64` which always loads and stores them as
big-endian words at a potentially unaligned address. The previous
implementation is based on loads/stores of individual bytes and
concatenating bytes with bitwise operations, which currently cannot be
fused to a single load/store operation by GHC.

This patch implements fast `get`/`put` functions for
`Word16`/`Word32`/`Word64` based on a single memory load/store, with
an additional `byteSwap` operation on little-endian hosts. It is based
on unaligned load/store primops added since GHC 9.10, and we already
require booting with at least 9.10, so it's about time to switch to
this faster path.

- - - - -
b46639e3 by Simon Peyton Jones at 2026-01-09T08:45:54-05:00
Fix scoping errors in specialisation

Using -fspecialise-aggressively in #26682 showed up a couple of
subtle errors in the type-class specialiser.

* dumpBindUDs failed to call `deleteCallsMentioning`, resulting in a
  call that mentioned a dictionary that was not in scope.  This call
  has been missing since 2009!
    commit c43c981705ec33da92a9ce91eb90f2ecf00be9fe
    Author: Simon Peyton Jones <simonpj@microsoft.com>
    Date:   Fri Oct 23 16:15:51 2009 +0000

  Fixed by re-combining `dumpBindUDs` and `dumpUDs`.

* I think there was another bug involving the quantified type
  variables in polymorphic specialisation. In any case I refactored
  `specHeader` and `spec_call` so that the former looks for the
  extra quantified type variables rather than the latter.  This
  is quite a worthwhile simplification: less code, easier to grok.

Test case in simplCore/should_compile/T26682,
brilliantly minimised by @sheaf.

- - - - -
c7354cc1 by Matthew Craven at 2026-01-09T08:45:55-05:00
Account for "stupid theta" in demand sig for DataCon wrappers

Fixes #26748.

- - - - -


25 changed files:

- compiler/GHC/Core/Opt/Specialise.hs
- compiler/GHC/Types/Id/Make.hs
- compiler/GHC/Utils/Binary.hs
- libraries/base/changelog.md
- libraries/base/src/GHC/Conc.hs
- libraries/base/src/GHC/Conc/Sync.hs
- libraries/ghc-internal/ghc-internal.cabal.in
- libraries/ghc-internal/src/GHC/Internal/Conc/IO.hs
- libraries/ghc-internal/src/GHC/Internal/Conc/POSIX.hs
- libraries/ghc-internal/src/GHC/Internal/Conc/Sync.hs
- libraries/ghc-internal/src/GHC/Internal/Conc/Sync.hs-boot
- libraries/ghc-internal/src/GHC/Internal/Conc/Windows.hs
- libraries/ghc-internal/src/GHC/Internal/Event/Thread.hs
- libraries/ghc-internal/src/GHC/Internal/Event/Windows/Thread.hs
- + libraries/ghc-internal/src/GHC/Internal/STM.hs
- + testsuite/tests/dmdanal/should_run/T26748.hs
- + testsuite/tests/dmdanal/should_run/T26748.stdout
- testsuite/tests/dmdanal/should_run/all.T
- testsuite/tests/interface-stability/base-exports.stdout
- testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs
- testsuite/tests/interface-stability/base-exports.stdout-mingw32
- testsuite/tests/interface-stability/base-exports.stdout-ws-32
- + testsuite/tests/simplCore/should_compile/T26682.hs
- + testsuite/tests/simplCore/should_compile/T26682a.hs
- testsuite/tests/simplCore/should_compile/all.T


Changes:

=====================================
compiler/GHC/Core/Opt/Specialise.hs
=====================================
@@ -654,9 +654,7 @@ specProgram guts@(ModGuts { mg_module = this_mod
               -- Easiest thing is to do it all at once, as if all the top-level
               -- decls were mutually recursive
        ; let top_env = SE { se_subst = Core.mkEmptySubst $
-                                        mkInScopeSetBndrs binds
-                                      --    mkInScopeSetList $
-                                      --  bindersOfBinds binds
+                                       mkInScopeSetBndrs binds
                           , se_module = this_mod
                           , se_rules  = rule_env
                           , se_dflags = dflags }
@@ -816,9 +814,12 @@ spec_imports env callers dict_binds calls
     go :: SpecEnv -> [CallInfoSet] -> CoreM (SpecEnv, [CoreRule], [CoreBind])
     go env [] = return (env, [], [])
     go env (cis : other_calls)
-      = do { -- debugTraceMsg (text "specImport {" <+> ppr cis)
+      = do {
+--             debugTraceMsg (text "specImport {" <+> vcat [ ppr cis
+--                                                         , text "callers" <+> ppr callers
+--                                                         , text "dict_binds" <+> ppr dict_binds ])
            ; (env, rules1, spec_binds1) <- spec_import env callers dict_binds cis
-           ; -- debugTraceMsg (text "specImport }" <+> ppr cis)
+--           ; debugTraceMsg (text "specImport }" <+> ppr cis)
 
            ; (env, rules2, spec_binds2) <- go env other_calls
            ; return (env, rules1 ++ rules2, spec_binds1 ++ spec_binds2) }
@@ -835,13 +836,18 @@ spec_import :: SpecEnv               -- Passed in so that all top-level Ids are
                      , [CoreBind] )  -- Specialised bindings
 spec_import env callers dict_binds cis@(CIS fn _)
   | isIn "specImport" fn callers
-  = return (env, [], [])  -- No warning.  This actually happens all the time
-                          -- when specialising a recursive function, because
-                          -- the RHS of the specialised function contains a recursive
-                          -- call to the original function
+  = do {
+--         debugTraceMsg (text "specImport1-bad" <+> (ppr fn $$ text "callers" <+> ppr callers))
+       ; return (env, [], []) }
+    -- No warning.  This actually happens all the time
+    -- when specialising a recursive function, because
+    -- the RHS of the specialised function contains a recursive
+    -- call to the original function
 
   | null good_calls
-  = return (env, [], [])
+  = do {
+--        debugTraceMsg (text "specImport1-no-good" <+> (ppr cis $$ text "dict_binds" <+> ppr dict_binds))
+       ; return (env, [], []) }
 
   | Just rhs <- canSpecImport dflags fn
   = do {     -- Get rules from the external package state
@@ -890,7 +896,10 @@ spec_import env callers dict_binds cis@(CIS fn _)
        ; return (env, rules2 ++ rules1, final_binds) }
 
   | otherwise
-  = do { tryWarnMissingSpecs dflags callers fn good_calls
+  = do {
+--         debugTraceMsg (hang (text "specImport1-missed")
+--                          2 (vcat [ppr cis, text "can-spec" <+> ppr (canSpecImport dflags fn)]))
+       ; tryWarnMissingSpecs dflags callers fn good_calls
        ; return (env, [], [])}
 
   where
@@ -1455,7 +1464,9 @@ specBind top_lvl env (NonRec fn rhs) do_body
 
        ; (fn4, spec_defns, body_uds1) <- specDefn env body_uds fn3 rhs
 
-       ; let (free_uds, dump_dbs, float_all) = dumpBindUDs [fn4] body_uds1
+       ; let can_float_this_one = exprIsTopLevelBindable rhs (idType fn)
+                 -- exprIsTopLevelBindable: see Note [Care with unlifted bindings]
+             (free_uds, dump_dbs, float_all) = dumpBindUDs can_float_this_one [fn4] body_uds1
              all_free_uds                    = free_uds `thenUDs` rhs_uds
 
              pairs = spec_defns ++ [(fn4, rhs')]
@@ -1471,10 +1482,8 @@ specBind top_lvl env (NonRec fn rhs) do_body
                          = [mkDB $ NonRec b r | (b,r) <- pairs]
                            ++ fromOL dump_dbs
 
-             can_float_this_one = exprIsTopLevelBindable rhs (idType fn)
-             -- exprIsTopLevelBindable: see Note [Care with unlifted bindings]
 
-       ; if float_all && can_float_this_one then
+       ; if float_all then
              -- Rather than discard the calls mentioning the bound variables
              -- we float this (dictionary) binding along with the others
               return ([], body', all_free_uds `snocDictBinds` final_binds)
@@ -1509,7 +1518,7 @@ specBind top_lvl env (Rec pairs) do_body
                               <- specDefns rec_env uds2 (bndrs2 `zip` rhss)
                         ; return (bndrs3, spec_defns3 ++ spec_defns2, uds3) }
 
-       ; let (final_uds, dumped_dbs, float_all) = dumpBindUDs bndrs1 uds3
+       ; let (final_uds, dumped_dbs, float_all) = dumpBindUDs True bndrs1 uds3
              final_bind = recWithDumpedDicts (spec_defns3 ++ zip bndrs3 rhss')
                                              dumped_dbs
 
@@ -1630,7 +1639,6 @@ specCalls spec_imp env existing_rules calls_for_me fn rhs
     dflags    = se_dflags env
     this_mod  = se_module env
     subst     = se_subst env
-    in_scope  = Core.substInScopeSet subst
         -- Figure out whether the function has an INLINE pragma
         -- See Note [Inline specialisations]
 
@@ -1646,9 +1654,6 @@ specCalls spec_imp env existing_rules calls_for_me fn rhs
       | otherwise
       = inl_prag
 
-    not_in_scope :: InterestingVarFun
-    not_in_scope v = isLocalVar v && not (v `elemInScopeSet` in_scope)
-
     ----------------------------------------------------------
         -- Specialise to one particular call pattern
     spec_call :: SpecInfo                         -- Accumulating parameter
@@ -1662,47 +1667,34 @@ specCalls spec_imp env existing_rules calls_for_me fn rhs
                  mk_extra_dfun_arg bndr | isTyVar bndr = UnspecType
                                         | otherwise    = UnspecArg
 
-             -- Find qvars, the type variables to add to the binders for the rule
-             -- Namely those free in `ty` that aren't in scope
-             -- See (MP2) in Note [Specialising polymorphic dictionaries]
-           ; let poly_qvars = scopedSort $ fvVarList $ specArgsFVs not_in_scope call_args
-                 subst'     = subst `Core.extendSubstInScopeList` poly_qvars
-                              -- Maybe we should clone the poly_qvars telescope?
-
-             -- Any free Ids will have caused the call to be dropped
-           ; massertPpr (all isTyCoVar poly_qvars)
-                        (ppr fn $$ ppr all_call_args $$ ppr poly_qvars)
-
-           ; (useful, subst'', rule_bndrs, rule_lhs_args, spec_bndrs, dx_binds, spec_args)
-                 <- specHeader subst' rhs_bndrs all_call_args
-           ; let all_rule_bndrs = poly_qvars ++ rule_bndrs
-                 env' = env { se_subst = subst'' }
+           ; (useful, subst', rule_bndrs, rule_lhs_args, spec_bndrs, dx_binds, spec_args)
+                 <- specHeader subst rhs_bndrs all_call_args
+           ; let env' = env { se_subst = subst' }
 
            -- Check for (a) usefulness and (b) not already covered
            -- See (SC1) in Note [Specialisations already covered]
            ; let all_rules = rules_acc ++ existing_rules
                  -- all_rules: we look both in the rules_acc (generated by this invocation
                  --   of specCalls), and in existing_rules (passed in to specCalls)
-                 already_covered = alreadyCovered env' all_rule_bndrs fn
+                 already_covered = alreadyCovered env' rule_bndrs fn
                                                   rule_lhs_args is_active all_rules
 
-{-         ; pprTrace "spec_call" (vcat
-                [ text "fun:       "  <+> ppr fn
-                , text "call info: "  <+> ppr _ci
-                , text "useful:    "  <+> ppr useful
-                , text "already_covered:"  <+> ppr already_covered
-                , text "poly_qvars: " <+> ppr poly_qvars
-                , text "useful:    "  <+> ppr useful
-                , text "all_rule_bndrs:"  <+> ppr all_rule_bndrs
-                , text "rule_lhs_args:"  <+> ppr rule_lhs_args
-                , text "spec_bndrs:" <+> ppr spec_bndrs
-                , text "dx_binds:"   <+> ppr dx_binds
-                , text "spec_args: "  <+> ppr spec_args
-                , text "rhs_bndrs"    <+> ppr rhs_bndrs
-                , text "rhs_body"     <+> ppr rhs_body
-                , text "subst''" <+> ppr subst'' ]) $
-             return ()
--}
+--         ; pprTrace "spec_call" (vcat
+--                [ text "fun:       "  <+> ppr fn
+--                , text "call info: "  <+> ppr _ci
+--                , text "useful:    "  <+> ppr useful
+--                , text "already_covered:"  <+> ppr already_covered
+--                , text "useful:    "  <+> ppr useful
+--                , text "rule_bndrs:"  <+> ppr (sep (map (pprBndr LambdaBind) rule_bndrs))
+--                , text "rule_lhs_args:"  <+> ppr rule_lhs_args
+--                , text "spec_bndrs:" <+> ppr (sep (map (pprBndr LambdaBind) spec_bndrs))
+--                , text "dx_binds:"   <+> ppr dx_binds
+--                , text "spec_args: "  <+> ppr spec_args
+--                , text "rhs_bndrs"    <+> ppr (sep (map (pprBndr LambdaBind) rhs_bndrs))
+--                , text "rhs_body"     <+> ppr rhs_body
+--                , text "subst'" <+> ppr subst'
+--                ]) $ return ()
+
 
            ; if not useful          -- No useful specialisation
                 || already_covered  -- Useful, but done already
@@ -1716,23 +1708,15 @@ specCalls spec_imp env existing_rules calls_for_me fn rhs
              -- Run the specialiser on the specialised RHS
            ; (rhs_body', rhs_uds) <- specExpr env'' rhs_body
 
-{-         ; pprTrace "spec_call2" (vcat
-                 [ text "fun:" <+> ppr fn
-                 , text "rhs_body':" <+> ppr rhs_body' ]) $
-             return ()
--}
-
            -- Make the RHS of the specialised function
            ; let spec_rhs_bndrs = spec_bndrs ++ inner_rhs_bndrs'
-                 (rhs_uds1, inner_dumped_dbs) = dumpUDs spec_rhs_bndrs rhs_uds
-                 (rhs_uds2, outer_dumped_dbs) = dumpUDs poly_qvars (dx_binds `consDictBinds` rhs_uds1)
-                 -- dx_binds comes from the arguments to the call, and so can mention
-                 -- poly_qvars but no other local binders
-                 spec_rhs = mkLams poly_qvars               $
-                            wrapDictBindsE outer_dumped_dbs $
-                            mkLams spec_rhs_bndrs           $
+                 (rhs_uds2, inner_dumped_dbs) = dumpUDs spec_rhs_bndrs $
+                                                dx_binds `consDictBinds` rhs_uds
+                 -- dx_binds comes from the arguments to the call,
+                 -- and so can mention poly_qvars but no other local binders
+                 spec_rhs = mkLams spec_rhs_bndrs           $
                             wrapDictBindsE inner_dumped_dbs rhs_body'
-                 rule_rhs_args = poly_qvars ++ spec_bndrs
+                 rule_rhs_args = spec_bndrs
 
                  -- Maybe add a void arg to the specialised function,
                  -- to avoid unlifted bindings
@@ -1787,7 +1771,7 @@ specCalls spec_imp env existing_rules calls_for_me fn rhs
                                      text "SPEC"
 
                 spec_rule = mkSpecRule dflags this_mod True inl_act
-                                    herald fn all_rule_bndrs rule_lhs_args
+                                    herald fn rule_bndrs rule_lhs_args
                                     (mkVarApps (Var spec_fn) rule_rhs_args1)
 
                 _rule_trace_doc = vcat [ ppr fn <+> dcolon <+> ppr fn_type
@@ -1798,8 +1782,12 @@ specCalls spec_imp env existing_rules calls_for_me fn rhs
                                        , text "existing" <+> ppr existing_rules
                                        ]
 
-           ; -- pprTrace "spec_call: rule" _rule_trace_doc
-             return ( spec_rule            : rules_acc
+--           ; pprTrace "spec_call: rule" (vcat [ -- text "poly_qvars" <+> ppr poly_qvars
+--                                                text "rule_bndrs" <+> ppr rule_bndrs
+--                                              , text "rule_lhs_args" <+> ppr rule_lhs_args
+--                                              , text "all_call_args" <+> ppr all_call_args
+--                                              , ppr spec_rule ]) $
+           ; return ( spec_rule            : rules_acc
                     , (spec_fn, spec_rhs1) : pairs_acc
                     , rhs_uds2 `thenUDs` uds_acc
                     ) } }
@@ -1946,6 +1934,16 @@ floating to top level anyway; but that is hard to spot (since we don't know what
 the non-top-level in-scope binders are) and rare (since the binding must satisfy
 Note [Core let-can-float invariant] in GHC.Core).
 
+Arguably we'd be better off if we had left that `x` in the RHS of `n`, thus
+    f x = let n::Natural = let x::ByteArray# = <some literal> in
+                           NB x
+          in wombat @192827 (n |> co)
+Now we could float `n` happily.  But that's in conflict with exposing the `NB`
+data constructor in the body of the `let`, so I'm leaving this unresolved.
+
+Another case came up in #26682, where the binding had an unlifted sum type
+(# Word# | ByteArray# #), itself arising from an UNPACK pragma.  Test case
+T26682.
 
 Note [Specialising Calls]
 ~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -2593,12 +2591,22 @@ specHeader subst _  [] = pure (False, subst, [], [], [], [], [])
 -- 'a->T1', as well as a LHS argument for the resulting RULE and unfolding
 -- details.
 specHeader subst (bndr:bndrs) (SpecType ty : args)
-  = do { let subst1 = Core.extendTvSubst subst bndr ty
-       ; (useful, subst2, rule_bs, rule_args, spec_bs, dx, spec_args)
-             <- specHeader subst1 bndrs args
-       ; pure ( useful, subst2
-              , rule_bs,     Type ty : rule_args
-              , spec_bs, dx, Type ty : spec_args ) }
+  = do { -- Find free_tvs, the type variables to add to the binders for the rule
+         -- Namely those free in `ty` that aren't in scope
+         -- See (MP2) in Note [Specialising polymorphic dictionaries]
+         let in_scope = Core.substInScopeSet subst
+             not_in_scope tv = not (tv `elemInScopeSet` in_scope)
+             free_tvs = scopedSort $ fvVarList $
+                        filterFV not_in_scope  $
+                        tyCoFVsOfType ty
+             subst1 = subst `Core.extendSubstInScopeList` free_tvs
+
+       ; let subst2 = Core.extendTvSubst subst1 bndr ty
+       ; (useful, subst3, rule_bs, rule_args, spec_bs, dx, spec_args)
+             <- specHeader subst2 bndrs args
+       ; pure ( useful, subst3
+              , free_tvs ++ rule_bs,     Type ty : rule_args
+              , free_tvs ++ spec_bs, dx, Type ty : spec_args ) }
 
 -- Next we have a type that we don't want to specialise. We need to perform
 -- a substitution on it (in case the type refers to 'a'). Additionally, we need
@@ -2682,7 +2690,7 @@ bindAuxiliaryDict subst orig_dict_id fresh_dict_id dict_arg
   -- don’t bother creating a new dict binding; just substitute
   | exprIsTrivial dict_arg
   , let subst' = Core.extendSubst subst orig_dict_id dict_arg
-  = -- pprTrace "bindAuxiliaryDict:trivial" (ppr orig_dict_id <+> ppr dict_id) $
+  = -- pprTrace "bindAuxiliaryDict:trivial" (ppr orig_dict_id <+> ppr dict_arg) $
     (subst', Nothing, dict_arg)
 
   | otherwise  -- Non-trivial dictionary arg; make an auxiliary binding
@@ -2978,7 +2986,8 @@ pprCallInfo fn (CI { ci_key = key })
 
 instance Outputable CallInfo where
   ppr (CI { ci_key = key, ci_fvs = _fvs })
-    = text "CI" <> braces (sep (map ppr key))
+    = text "CI" <> braces (text "fvs" <+> ppr _fvs
+                           $$ sep (map ppr key))
 
 unionCalls :: CallDetails -> CallDetails -> CallDetails
 unionCalls c1 c2 = plusDVarEnv_C unionCallInfoSet c1 c2
@@ -3394,38 +3403,49 @@ wrapDictBindsE dbs expr
 
 ----------------------
 dumpUDs :: [CoreBndr] -> UsageDetails -> (UsageDetails, OrdList DictBind)

--- Used at a lambda or case binder; just dump anything mentioning the binder
+-- Used at binder; just dump anything mentioning the binder
 dumpUDs bndrs uds@(MkUD { ud_binds = orig_dbs, ud_calls = orig_calls })
   | null bndrs = (uds, nilOL)  -- Common in case alternatives
   | otherwise  = -- pprTrace "dumpUDs" (vcat
-                 --    [ text "bndrs" <+> ppr bndrs
-                 --    , text "uds" <+> ppr uds
-                 --    , text "free_uds" <+> ppr free_uds
-                 --    , text "dump-dbs" <+> ppr dump_dbs ]) $
+                 --   [ text "bndrs" <+> ppr bndrs
+                 --   , text "uds" <+> ppr uds
+                 --   , text "free_uds" <+> ppr free_uds
+                 --   , text "dump_dbs" <+> ppr dump_dbs ]) $
                  (free_uds, dump_dbs)
   where
     free_uds = uds { ud_binds = free_dbs, ud_calls = free_calls }
     bndr_set = mkVarSet bndrs
     (free_dbs, dump_dbs, dump_set) = splitDictBinds orig_dbs bndr_set
-    free_calls = deleteCallsMentioning dump_set $   -- Drop calls mentioning bndr_set on the floor
-                 deleteCallsFor bndrs orig_calls    -- Discard calls for bndr_set; there should be
-                                                    -- no calls for any of the dicts in dump_dbs
 
-dumpBindUDs :: [CoreBndr] -> UsageDetails -> (UsageDetails, OrdList DictBind, Bool)
+    -- Delete calls:
+    --   * For any binder in `bndrs`
+    --   * That mention a dictionary bound in `dump_set`
+    -- These variables aren't in scope "above" the binding and the `dump_dbs`,
+    -- so no call should mention them.  (See #26682.)
+    free_calls = deleteCallsMentioning dump_set $
+                 deleteCallsFor bndrs orig_calls
+
+dumpBindUDs :: Bool   -- Main binding can float to top
+            -> [CoreBndr] -> UsageDetails
+            -> (UsageDetails, OrdList DictBind, Bool)
 -- Used at a let(rec) binding.
--- We return a boolean indicating whether the binding itself is mentioned,
--- directly or indirectly, by any of the ud_calls; in that case we want to
--- float the binding itself;
--- See Note [Floated dictionary bindings]
-dumpBindUDs bndrs (MkUD { ud_binds = orig_dbs, ud_calls = orig_calls })
-  = -- pprTrace "dumpBindUDs" (ppr bndrs $$ ppr free_uds $$ ppr dump_dbs $$ ppr float_all) $
-    (free_uds, dump_dbs, float_all)
+-- We return a boolean indicating whether the binding itself
+--    is mentioned, directly or indirectly, by any of the ud_calls;
+--    in that case we want to float the binding itself.
+--    See Note [Floated dictionary bindings]
+-- If the boolean is True, then the returned ud_calls can mention `bndrs`;
+-- if False, then returned ud_calls must not mention `bndrs`
+dumpBindUDs can_float_bind bndrs (MkUD { ud_binds = orig_dbs, ud_calls = orig_calls })
+  = ( MkUD { ud_binds = free_dbs, ud_calls = free_calls2 }
+    , dump_dbs
+    , can_float_bind && calls_mention_bndrs )
   where
-    free_uds = MkUD { ud_binds = free_dbs, ud_calls = free_calls }
     bndr_set = mkVarSet bndrs
     (free_dbs, dump_dbs, dump_set) = splitDictBinds orig_dbs bndr_set
-    free_calls = deleteCallsFor bndrs orig_calls
-    float_all = dump_set `intersectsVarSet` callDetailsFVs free_calls
+    free_calls1 = deleteCallsFor bndrs orig_calls
+    calls_mention_bndrs = dump_set `intersectsVarSet` callDetailsFVs free_calls1
+    free_calls2 | can_float_bind = free_calls1
+                | otherwise      = deleteCallsMentioning dump_set free_calls1
 
 callsForMe :: Id -> UsageDetails -> (UsageDetails, [CallInfo])
 callsForMe fn uds@MkUD { ud_binds = orig_dbs, ud_calls = orig_calls }


=====================================
compiler/GHC/Types/Id/Make.hs
=====================================
@@ -825,9 +825,10 @@ mkDataConRep dc_bang_opts fam_envs wrap_name data_con
                                                       -- LFInfo stores post-unarisation arity
 
              wrap_arg_dmds =
-               replicate (length theta) topDmd ++ map mk_dmd arg_ibangs
+               replicate (length stupid_theta + length theta) topDmd
+                 ++ map mk_dmd arg_ibangs
                -- Don't forget the dictionary arguments when building
-               -- the strictness signature (#14290).
+               -- the strictness signature (#14290, #26748).
 
              mk_dmd str | isBanged str = evalDmd
                         | otherwise    = topDmd


=====================================
compiler/GHC/Utils/Binary.hs
=====================================
@@ -1,4 +1,5 @@
 {-# LANGUAGE CPP #-}
+{-# LANGUAGE MagicHash #-}
 {-# LANGUAGE UnboxedTuples #-}
 {-# LANGUAGE DerivingVia #-}
 
@@ -160,14 +161,17 @@ import qualified Data.Set as Set
 import Data.Time
 import Data.List (unfoldr)
 import System.IO as IO
-import System.IO.Unsafe         ( unsafeInterleaveIO )
 import System.IO.Error          ( mkIOError, eofErrorType )
 import Type.Reflection          ( Typeable, SomeTypeRep(..) )
 import qualified Type.Reflection as Refl
 import GHC.Real                 ( Ratio(..) )
 import Data.IntMap (IntMap)
 import qualified Data.IntMap as IntMap
+import GHC.ByteOrder
 import GHC.ForeignPtr           ( unsafeWithForeignPtr )
+import GHC.Exts
+import GHC.IO
+import GHC.Word
 
 import Unsafe.Coerce (unsafeCoerce)
 
@@ -638,7 +642,7 @@ getPrim (ReadBinMem _ ix_r sz_r arr_r) size f = do
   ix <- readFastMutInt ix_r
   when (ix + size > sz_r) $
       ioError (mkIOError eofErrorType "Data.Binary.getPrim" Nothing Nothing)
-  w <- unsafeWithForeignPtr arr_r $ \p -> f (p `plusPtr` ix)
+  !w <- unsafeWithForeignPtr arr_r $ \p -> f (p `plusPtr` ix)
     -- This is safe WRT #17760 as we we guarantee that the above line doesn't
     -- diverge
   writeFastMutInt ix_r (ix + size)
@@ -651,71 +655,52 @@ getWord8 :: ReadBinHandle -> IO Word8
 getWord8 h = getPrim h 1 peek
 
 putWord16 :: WriteBinHandle -> Word16 -> IO ()
-putWord16 h w = putPrim h 2 (\op -> do
-  pokeElemOff op 0 (fromIntegral (w `shiftR` 8))
-  pokeElemOff op 1 (fromIntegral (w .&. 0xFF))
-  )
+putWord16 h w = putPrim h 2 $ \(Ptr p#) ->
+  IO $ \s -> (# writeWord8OffAddrAsWord16# p# 0# x# s, () #)
+  where
+    !(W16# x#) = case targetByteOrder of
+      BigEndian -> w
+      LittleEndian -> byteSwap16 w
 
 getWord16 :: ReadBinHandle -> IO Word16
-getWord16 h = getPrim h 2 (\op -> do
-  w0 <- fromIntegral <$> peekElemOff op 0
-  w1 <- fromIntegral <$> peekElemOff op 1
-  return $! w0 `shiftL` 8 .|. w1
-  )
+getWord16 h = getPrim h 2 $ \(Ptr p#) ->
+  IO $ \s -> case readWord8OffAddrAsWord16# p# 0# s of
+    (# s', w16# #) -> case targetByteOrder of
+      BigEndian -> (# s', W16# w16# #)
+      LittleEndian -> case byteSwap16 $ W16# w16# of
+        !w16 -> (# s', w16 #)
 
 putWord32 :: WriteBinHandle -> Word32 -> IO ()
-putWord32 h w = putPrim h 4 (\op -> do
-  pokeElemOff op 0 (fromIntegral (w `shiftR` 24))
-  pokeElemOff op 1 (fromIntegral ((w `shiftR` 16) .&. 0xFF))
-  pokeElemOff op 2 (fromIntegral ((w `shiftR` 8) .&. 0xFF))
-  pokeElemOff op 3 (fromIntegral (w .&. 0xFF))
-  )
+putWord32 h w = putPrim h 4 $ \(Ptr p#) ->
+  IO $ \s -> (# writeWord8OffAddrAsWord32# p# 0# x# s, () #)
+  where
+    !(W32# x#) = case targetByteOrder of
+      BigEndian -> w
+      LittleEndian -> byteSwap32 w
 
 getWord32 :: ReadBinHandle -> IO Word32
-getWord32 h = getPrim h 4 (\op -> do
-  w0 <- fromIntegral <$> peekElemOff op 0
-  w1 <- fromIntegral <$> peekElemOff op 1
-  w2 <- fromIntegral <$> peekElemOff op 2
-  w3 <- fromIntegral <$> peekElemOff op 3
-
-  return $! (w0 `shiftL` 24) .|.
-            (w1 `shiftL` 16) .|.
-            (w2 `shiftL` 8)  .|.
-            w3
-  )
+getWord32 h = getPrim h 4 $ \(Ptr p#) ->
+  IO $ \s -> case readWord8OffAddrAsWord32# p# 0# s of
+    (# s', w32# #) -> case targetByteOrder of
+      BigEndian -> (# s', W32# w32# #)
+      LittleEndian -> case byteSwap32 $ W32# w32# of
+        !w32 -> (# s', w32 #)
 
 putWord64 :: WriteBinHandle -> Word64 -> IO ()
-putWord64 h w = putPrim h 8 (\op -> do
-  pokeElemOff op 0 (fromIntegral (w `shiftR` 56))
-  pokeElemOff op 1 (fromIntegral ((w `shiftR` 48) .&. 0xFF))
-  pokeElemOff op 2 (fromIntegral ((w `shiftR` 40) .&. 0xFF))
-  pokeElemOff op 3 (fromIntegral ((w `shiftR` 32) .&. 0xFF))
-  pokeElemOff op 4 (fromIntegral ((w `shiftR` 24) .&. 0xFF))
-  pokeElemOff op 5 (fromIntegral ((w `shiftR` 16) .&. 0xFF))
-  pokeElemOff op 6 (fromIntegral ((w `shiftR` 8) .&. 0xFF))
-  pokeElemOff op 7 (fromIntegral (w .&. 0xFF))
-  )
+putWord64 h w = putPrim h 8 $ \(Ptr p#) ->
+  IO $ \s -> (# writeWord8OffAddrAsWord64# p# 0# x# s, () #)
+  where
+    !(W64# x#) = case targetByteOrder of
+      BigEndian -> w
+      LittleEndian -> byteSwap64 w
 
 getWord64 :: ReadBinHandle -> IO Word64
-getWord64 h = getPrim h 8 (\op -> do
-  w0 <- fromIntegral <$> peekElemOff op 0
-  w1 <- fromIntegral <$> peekElemOff op 1
-  w2 <- fromIntegral <$> peekElemOff op 2
-  w3 <- fromIntegral <$> peekElemOff op 3
-  w4 <- fromIntegral <$> peekElemOff op 4
-  w5 <- fromIntegral <$> peekElemOff op 5
-  w6 <- fromIntegral <$> peekElemOff op 6
-  w7 <- fromIntegral <$> peekElemOff op 7
-
-  return $! (w0 `shiftL` 56) .|.
-            (w1 `shiftL` 48) .|.
-            (w2 `shiftL` 40) .|.
-            (w3 `shiftL` 32) .|.
-            (w4 `shiftL` 24) .|.
-            (w5 `shiftL` 16) .|.
-            (w6 `shiftL` 8)  .|.
-            w7
-  )
+getWord64 h = getPrim h 8 $ \(Ptr p#) ->
+  IO $ \s -> case readWord8OffAddrAsWord64# p# 0# s of
+    (# s', w64# #) -> case targetByteOrder of
+      BigEndian -> (# s', W64# w64# #)
+      LittleEndian -> case byteSwap64 $ W64# w64# of
+        !w64 -> (# s', w64 #)
 
 putByte :: WriteBinHandle -> Word8 -> IO ()
 putByte bh !w = putWord8 bh w


=====================================
libraries/base/changelog.md
=====================================
@@ -17,6 +17,8 @@
   * Adjust the strictness of `Data.List.iterate'` to be more reasonable: every element of the output list is forced to WHNF when the `(:)` containing it is forced. ([CLC proposal #335)](https://github.com/haskell/core-libraries-committee/issues/335)
   * Add `nubOrd` / `nubOrdBy` to `Data.List` and `Data.List.NonEmpty`. ([CLC proposal #336](https://github.com/haskell/core-libraries-committee/issues/336))
   * Add `Semigroup` and `Monoid` instances for `Control.Monad.ST.Lazy`. ([CLC proposal #374](https://github.com/haskell/core-libraries-committee/issues/374))
+  * `GHC.Conc.throwSTM` and `GHC.Conc.Sync.throwSTM` now carry a `HasCallStack` constraint and attach a `Backtrace` annotation to the thrown exception. ([GHC #25365](https://gitlab.haskell.org/ghc/ghc/-/issues/25365))
+  * `GHC.Conc.catchSTM` and `GHC.Conc.Sync.catchSTM` now attach `WhileHandling` annotation to exceptions thrown from the handler. ([GHC #25365](https://gitlab.haskell.org/ghc/ghc/-/issues/25365))
 
 ## 4.22.0.0 *TBA*
   * Shipped with GHC 9.14.1


=====================================
libraries/base/src/GHC/Conc.hs
=====================================
@@ -119,6 +119,7 @@ module GHC.Conc
 
 import GHC.Internal.Conc.IO
 import GHC.Internal.Conc.Sync
+import GHC.Internal.STM
 
 #if !defined(mingw32_HOST_OS)
 import GHC.Internal.Conc.Signal


=====================================
libraries/base/src/GHC/Conc/Sync.hs
=====================================
@@ -89,3 +89,4 @@ module GHC.Conc.Sync
         ) where
 
 import GHC.Internal.Conc.Sync
+import GHC.Internal.STM


=====================================
libraries/ghc-internal/ghc-internal.cabal.in
=====================================
@@ -293,6 +293,7 @@ Library
         GHC.Internal.StaticPtr
         GHC.Internal.STRef
         GHC.Internal.Show
+        GHC.Internal.STM
         GHC.Internal.Stable
         GHC.Internal.StableName
         GHC.Internal.Stack


=====================================
libraries/ghc-internal/src/GHC/Internal/Conc/IO.hs
=====================================
@@ -60,6 +60,7 @@ module GHC.Internal.Conc.IO
 
 import GHC.Internal.Base
 import GHC.Internal.Conc.Sync as Sync
+import GHC.Internal.STM as STM
 import GHC.Internal.Real ( fromIntegral )
 import GHC.Internal.System.Posix.Types
 
@@ -142,17 +143,17 @@ threadWaitWrite fd
 -- to read from a file descriptor. The second returned value
 -- is an IO action that can be used to deregister interest
 -- in the file descriptor.
-threadWaitReadSTM :: Fd -> IO (Sync.STM (), IO ())
+threadWaitReadSTM :: Fd -> IO (STM.STM (), IO ())
 threadWaitReadSTM fd
 #if !defined(mingw32_HOST_OS) && !defined(javascript_HOST_ARCH)
   | threaded  = Event.threadWaitReadSTM fd
 #endif
   | otherwise = do
-      m <- Sync.newTVarIO False
+      m <- STM.newTVarIO False
       t <- Sync.forkIO $ do
         threadWaitRead fd
-        Sync.atomically $ Sync.writeTVar m True
-      let waitAction = do b <- Sync.readTVar m
+        STM.atomically $ STM.writeTVar m True
+      let waitAction = do b <- STM.readTVar m
                           if b then return () else retry
       let killAction = Sync.killThread t
       return (waitAction, killAction)
@@ -161,17 +162,17 @@ threadWaitReadSTM fd
 -- can be written to a file descriptor. The second returned value
 -- is an IO action that can be used to deregister interest
 -- in the file descriptor.
-threadWaitWriteSTM :: Fd -> IO (Sync.STM (), IO ())
+threadWaitWriteSTM :: Fd -> IO (STM.STM (), IO ())
 threadWaitWriteSTM fd
 #if !defined(mingw32_HOST_OS) && !defined(javascript_HOST_ARCH)
   | threaded  = Event.threadWaitWriteSTM fd
 #endif
   | otherwise = do
-      m <- Sync.newTVarIO False
+      m <- STM.newTVarIO False
       t <- Sync.forkIO $ do
         threadWaitWrite fd
-        Sync.atomically $ Sync.writeTVar m True
-      let waitAction = do b <- Sync.readTVar m
+        STM.atomically $ STM.writeTVar m True
+      let waitAction = do b <- STM.readTVar m
                           if b then return () else retry
       let killAction = Sync.killThread t
       return (waitAction, killAction)


=====================================
libraries/ghc-internal/src/GHC/Internal/Conc/POSIX.hs
=====================================
@@ -56,6 +56,7 @@ import GHC.Internal.MVar
 import GHC.Internal.Num (Num(..))
 import GHC.Internal.Ptr
 import GHC.Internal.Real (div, fromIntegral)
+import GHC.Internal.STM (TVar, atomically, newTVar, writeTVar)
 import GHC.Internal.Word (Word32, Word64)
 import GHC.Internal.Windows
 


=====================================
libraries/ghc-internal/src/GHC/Internal/Conc/Sync.hs
=====================================
@@ -76,21 +76,6 @@ module GHC.Internal.Conc.Sync
         , enableAllocationLimit
         , disableAllocationLimit
 
-        -- * TVars
-        , STM(..)
-        , atomically
-        , retry
-        , orElse
-        , throwSTM
-        , catchSTM
-        , TVar(..)
-        , newTVar
-        , newTVarIO
-        , readTVar
-        , readTVarIO
-        , writeTVar
-        , unsafeIOToSTM
-
         -- * Miscellaneous
         , withMVar
         , modifyMVar_
@@ -665,220 +650,6 @@ mkWeakThreadId t@(ThreadId t#) = IO $ \s ->
       (# s1, w #) -> (# s1, Weak w #)
 
 
------------------------------------------------------------------------------
--- Transactional heap operations
------------------------------------------------------------------------------
-
--- TVars are shared memory locations which support atomic memory
--- transactions.
-
--- |A monad supporting atomic memory transactions.
-newtype STM a = STM (State# RealWorld -> (# State# RealWorld, a #))
-
-unSTM :: STM a -> (State# RealWorld -> (# State# RealWorld, a #))
-unSTM (STM a) = a
-
--- | @since base-4.3.0.0
-instance  Functor STM where
-   fmap f x = x >>= (pure . f)
-
--- | @since base-4.8.0.0
-instance Applicative STM where
-  {-# INLINE pure #-}
-  {-# INLINE (*>) #-}
-  {-# INLINE liftA2 #-}
-  pure x = returnSTM x
-  (<*>) = ap
-  liftA2 = liftM2
-  m *> k = thenSTM m k
-
--- | @since base-4.3.0.0
-instance  Monad STM  where
-    {-# INLINE (>>=)  #-}
-    m >>= k     = bindSTM m k
-    (>>) = (*>)
-
--- | @since base-4.17.0.0
-instance Semigroup a => Semigroup (STM a) where
-    (<>) = liftA2 (<>)
-
--- | @since base-4.17.0.0
-instance Monoid a => Monoid (STM a) where
-    mempty = pure mempty
-
-bindSTM :: STM a -> (a -> STM b) -> STM b
-bindSTM (STM m) k = STM ( \s ->
-  case m s of
-    (# new_s, a #) -> unSTM (k a) new_s
-  )
-
-thenSTM :: STM a -> STM b -> STM b
-thenSTM (STM m) k = STM ( \s ->
-  case m s of
-    (# new_s, _ #) -> unSTM k new_s
-  )
-
-returnSTM :: a -> STM a
-returnSTM x = STM (\s -> (# s, x #))
-
--- | Takes the first non-'retry'ing 'STM' action.
---
--- @since base-4.8.0.0
-instance Alternative STM where
-  empty = retry
-  (<|>) = orElse
-
--- | Takes the first non-'retry'ing 'STM' action.
---
--- @since base-4.3.0.0
-instance MonadPlus STM
-
--- | Unsafely performs IO in the STM monad.  Beware: this is a highly
--- dangerous thing to do.
---
---   * The STM implementation will often run transactions multiple
---     times, so you need to be prepared for this if your IO has any
---     side effects.
---
---   * The STM implementation will abort transactions that are known to
---     be invalid and need to be restarted.  This may happen in the middle
---     of `unsafeIOToSTM`, so make sure you don't acquire any resources
---     that need releasing (exception handlers are ignored when aborting
---     the transaction).  That includes doing any IO using Handles, for
---     example.  Getting this wrong will probably lead to random deadlocks.
---
---   * The transaction may have seen an inconsistent view of memory when
---     the IO runs.  Invariants that you expect to be true throughout
---     your program may not be true inside a transaction, due to the
---     way transactions are implemented.  Normally this wouldn't be visible
---     to the programmer, but using `unsafeIOToSTM` can expose it.
---
-unsafeIOToSTM :: IO a -> STM a
-unsafeIOToSTM (IO m) = STM m
-
--- | Perform a series of STM actions atomically.
---
--- Using 'atomically' inside an 'unsafePerformIO' or 'unsafeInterleaveIO'
--- subverts some of guarantees that STM provides. It makes it possible to
--- run a transaction inside of another transaction, depending on when the
--- thunk is evaluated. If a nested transaction is attempted, an exception
--- is thrown by the runtime. It is possible to safely use 'atomically' inside
--- 'unsafePerformIO' or 'unsafeInterleaveIO', but the typechecker does not
--- rule out programs that may attempt nested transactions, meaning that
--- the programmer must take special care to prevent these.
---
--- However, there are functions for creating transactional variables that
--- can always be safely called in 'unsafePerformIO'. See: 'newTVarIO',
--- 'Control.Concurrent.STM.TChan.newTChanIO',
--- 'Control.Concurrent.STM.TChan.newBroadcastTChanIO',
--- 'Control.Concurrent.STM.TQueue.newTQueueIO',
--- 'Control.Concurrent.STM.TBQueue.newTBQueueIO', and
--- 'Control.Concurrent.STM.TMVar.newTMVarIO'.
---
--- Using 'unsafePerformIO' inside of 'atomically' is also dangerous but for
--- different reasons. See 'unsafeIOToSTM' for more on this.
-
-atomically :: STM a -> IO a
-atomically (STM m) = IO (\s -> (atomically# m) s )
-
--- | Retry execution of the current memory transaction because it has seen
--- values in 'TVar's which mean that it should not continue (e.g. the 'TVar's
--- represent a shared buffer that is now empty).  The implementation may
--- block the thread until one of the 'TVar's that it has read from has been
--- updated. (GHC only)
-retry :: STM a
-retry = STM $ \s# -> retry# s#
-
--- | Compose two alternative STM actions (GHC only).
---
--- If the first action completes without retrying then it forms the result of
--- the 'orElse'. Otherwise, if the first action retries, then the second action
--- is tried in its place. If both actions retry then the 'orElse' as a whole
--- retries.
-orElse :: STM a -> STM a -> STM a
-orElse (STM m) e = STM $ \s -> catchRetry# m (unSTM e) s
-
--- | A variant of 'throw' that can only be used within the 'STM' monad.
---
--- Throwing an exception in @STM@ aborts the transaction and propagates the
--- exception. If the exception is caught via 'catchSTM', only the changes
--- enclosed by the catch are rolled back; changes made outside of 'catchSTM'
--- persist.
---
--- If the exception is not caught inside of the 'STM', it is re-thrown by
--- 'atomically', and the entire 'STM' is rolled back.
---
--- Although 'throwSTM' has a type that is an instance of the type of 'throw', the
--- two functions are subtly different:
---
--- > throw e    `seq` x  ===> throw e
--- > throwSTM e `seq` x  ===> x
---
--- The first example will cause the exception @e@ to be raised,
--- whereas the second one won\'t.  In fact, 'throwSTM' will only cause
--- an exception to be raised when it is used within the 'STM' monad.
--- The 'throwSTM' variant should be used in preference to 'throw' to
--- raise an exception within the 'STM' monad because it guarantees
--- ordering with respect to other 'STM' operations, whereas 'throw'
--- does not.
-throwSTM :: Exception e => e -> STM a
-throwSTM e = STM $ raiseIO# (toException e)
-
--- | Exception handling within STM actions.
---
--- @'catchSTM' m f@ catches any exception thrown by @m@ using 'throwSTM',
--- using the function @f@ to handle the exception. If an exception is
--- thrown, any changes made by @m@ are rolled back, but changes prior to
--- @m@ persist.
-catchSTM :: Exception e => STM a -> (e -> STM a) -> STM a
-catchSTM (STM m) handler = STM $ catchSTM# m handler'
-    where
-      handler' e = case fromException e of
-                     Just e' -> unSTM (handler e')
-                     Nothing -> raiseIO# e
-
--- |Shared memory locations that support atomic memory transactions.
-data TVar a = TVar (TVar# RealWorld a)
-
--- | @since base-4.8.0.0
-instance Eq (TVar a) where
-        (TVar tvar1#) == (TVar tvar2#) = isTrue# (sameTVar# tvar1# tvar2#)
-
--- | Create a new 'TVar' holding a value supplied
-newTVar :: a -> STM (TVar a)
-newTVar val = STM $ \s1# ->
-    case newTVar# val s1# of
-         (# s2#, tvar# #) -> (# s2#, TVar tvar# #)
-
--- | @IO@ version of 'newTVar'.  This is useful for creating top-level
--- 'TVar's using 'System.IO.Unsafe.unsafePerformIO', because using
--- 'atomically' inside 'System.IO.Unsafe.unsafePerformIO' isn't
--- possible.
-newTVarIO :: a -> IO (TVar a)
-newTVarIO val = IO $ \s1# ->
-    case newTVar# val s1# of
-         (# s2#, tvar# #) -> (# s2#, TVar tvar# #)
-
--- | Return the current value stored in a 'TVar'.
--- This is equivalent to
---
--- >  readTVarIO = atomically . readTVar
---
--- but works much faster, because it doesn't perform a complete
--- transaction, it just reads the current value of the 'TVar'.
-readTVarIO :: TVar a -> IO a
-readTVarIO (TVar tvar#) = IO $ \s# -> readTVarIO# tvar# s#
-
--- |Return the current value stored in a 'TVar'.
-readTVar :: TVar a -> STM a
-readTVar (TVar tvar#) = STM $ \s# -> readTVar# tvar# s#
-
--- |Write the supplied value into a 'TVar'.
-writeTVar :: TVar a -> a -> STM ()
-writeTVar (TVar tvar#) val = STM $ \s1# ->
-    case writeTVar# tvar# val s1# of
-         s2# -> (# s2#, () #)
-
 -----------------------------------------------------------------------------
 -- MVar utilities
 -----------------------------------------------------------------------------


=====================================
libraries/ghc-internal/src/GHC/Internal/Conc/Sync.hs-boot
=====================================
@@ -17,7 +17,6 @@
 
 module GHC.Internal.Conc.Sync
         ( forkIO,
-          TVar(..),
           ThreadId(..),
           myThreadId,
           showThreadId,
@@ -33,7 +32,6 @@ import GHC.Internal.Ptr
 forkIO :: IO () -> IO ThreadId
 
 data ThreadId = ThreadId ThreadId#
-data TVar a = TVar (TVar# RealWorld a)
 
 data BlockReason
         = BlockedOnMVar


=====================================
libraries/ghc-internal/src/GHC/Internal/Conc/Windows.hs
=====================================
@@ -42,12 +42,12 @@ module GHC.Internal.Conc.Windows
        ) where
 
 import GHC.Internal.Base
-import GHC.Internal.Conc.Sync
 import qualified GHC.Internal.Conc.POSIX as POSIX
 import qualified GHC.Internal.Event.Windows.Thread as WINIO
 import GHC.Internal.Event.Windows.ConsoleEvent
 import GHC.Internal.IO.SubSystem ((<!>))
 import GHC.Internal.Ptr
+import GHC.Internal.STM
 
 -- ----------------------------------------------------------------------------
 -- Thread waiting


=====================================
libraries/ghc-internal/src/GHC/Internal/Event/Thread.hs
=====================================
@@ -38,11 +38,11 @@ import GHC.Internal.Foreign.C.Types (CInt(..), CUInt(..))
 import GHC.Internal.Foreign.Ptr (Ptr)
 import GHC.Internal.Base
 import GHC.Internal.List (zipWith, zipWith3)
-import GHC.Internal.Conc.Sync (TVar, ThreadId, ThreadStatus(..), atomically, forkIO,
-                      labelThread, modifyMVar_, withMVar, newTVar, sharedCAF,
+import GHC.Internal.STM (TVar, atomically, newTVar, writeTVar, newTVarIO, readTVar, retry, throwSTM, STM)
+import GHC.Internal.Conc.Sync (ThreadId, ThreadStatus(..), forkIO,
+                      labelThread, modifyMVar_, withMVar, sharedCAF,
                       getNumCapabilities, threadCapability, myThreadId, forkOn,
-                      threadStatus, writeTVar, newTVarIO, readTVar, retry,
-                      throwSTM, STM, yield)
+                      threadStatus, yield)
 import GHC.Internal.IO (mask_, uninterruptibleMask_, onException)
 import GHC.Internal.IO.Exception (ioError)
 import GHC.Internal.IOArray (IOArray, newIOArray, readIOArray, writeIOArray,


=====================================
libraries/ghc-internal/src/GHC/Internal/Event/Windows/Thread.hs
=====================================
@@ -7,11 +7,11 @@ module GHC.Internal.Event.Windows.Thread (
     registerDelay,
 ) where
 
-import GHC.Internal.Conc.Sync
 import GHC.Internal.Base
 import GHC.Internal.Event.Windows
 import GHC.Internal.IO
 import GHC.Internal.MVar
+import GHC.Internal.STM
 
 ensureIOManagerIsRunning :: IO ()
 ensureIOManagerIsRunning = wakeupIOManager
@@ -36,4 +36,3 @@ registerDelay usecs = do
     mgr <- getSystemManager
     _ <- registerTimeout mgr usecs $ atomically $ writeTVar t True
     return t
-


=====================================
libraries/ghc-internal/src/GHC/Internal/STM.hs
=====================================
@@ -0,0 +1,254 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE UnboxedTuples #-}
+{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE RankNTypes #-}
+{-# OPTIONS_HADDOCK not-home #-}
+
+module GHC.Internal.STM
+        (
+          -- * the 'STM' monad
+          STM(..)
+        , atomically
+        , retry
+        , orElse
+        , throwSTM
+        , catchSTM
+        , unsafeIOToSTM
+          -- * TVars
+        , TVar(..)
+        , newTVar
+        , newTVarIO
+        , readTVar
+        , readTVarIO
+        , writeTVar
+        ) where
+
+import GHC.Internal.Base
+import GHC.Internal.Exception (Exception, toExceptionWithBacktrace, fromException, addExceptionContext)
+import GHC.Internal.Exception.Context (ExceptionAnnotation)
+import GHC.Internal.Exception.Type (WhileHandling(..))
+import GHC.Internal.Stack (HasCallStack)
+
+-- TVars are shared memory locations which support atomic memory
+-- transactions.
+
+-- |A monad supporting atomic memory transactions.
+newtype STM a = STM (State# RealWorld -> (# State# RealWorld, a #))
+
+unSTM :: STM a -> (State# RealWorld -> (# State# RealWorld, a #))
+unSTM (STM a) = a
+
+-- | @since base-4.3.0.0
+instance  Functor STM where
+   fmap f x = x >>= (pure . f)
+
+-- | @since base-4.8.0.0
+instance Applicative STM where
+  {-# INLINE pure #-}
+  {-# INLINE (*>) #-}
+  {-# INLINE liftA2 #-}
+  pure x = returnSTM x
+  (<*>) = ap
+  liftA2 = liftM2
+  m *> k = thenSTM m k
+
+-- | @since base-4.3.0.0
+instance  Monad STM  where
+    {-# INLINE (>>=)  #-}
+    m >>= k     = bindSTM m k
+    (>>) = (*>)
+
+-- | @since base-4.17.0.0
+instance Semigroup a => Semigroup (STM a) where
+    (<>) = liftA2 (<>)
+
+-- | @since base-4.17.0.0
+instance Monoid a => Monoid (STM a) where
+    mempty = pure mempty
+
+bindSTM :: STM a -> (a -> STM b) -> STM b
+bindSTM (STM m) k = STM ( \s ->
+  case m s of
+    (# new_s, a #) -> unSTM (k a) new_s
+  )
+
+thenSTM :: STM a -> STM b -> STM b
+thenSTM (STM m) k = STM ( \s ->
+  case m s of
+    (# new_s, _ #) -> unSTM k new_s
+  )
+
+returnSTM :: a -> STM a
+returnSTM x = STM (\s -> (# s, x #))
+
+-- | Takes the first non-'retry'ing 'STM' action.
+--
+-- @since base-4.8.0.0
+instance Alternative STM where
+  empty = retry
+  (<|>) = orElse
+
+-- | Takes the first non-'retry'ing 'STM' action.
+--
+-- @since base-4.3.0.0
+instance MonadPlus STM
+
+-- | Unsafely performs IO in the STM monad.  Beware: this is a highly
+-- dangerous thing to do.
+--
+--   * The STM implementation will often run transactions multiple
+--     times, so you need to be prepared for this if your IO has any
+--     side effects.
+--
+--   * The STM implementation will abort transactions that are known to
+--     be invalid and need to be restarted.  This may happen in the middle
+--     of `unsafeIOToSTM`, so make sure you don't acquire any resources
+--     that need releasing (exception handlers are ignored when aborting
+--     the transaction).  That includes doing any IO using Handles, for
+--     example.  Getting this wrong will probably lead to random deadlocks.
+--
+--   * The transaction may have seen an inconsistent view of memory when
+--     the IO runs.  Invariants that you expect to be true throughout
+--     your program may not be true inside a transaction, due to the
+--     way transactions are implemented.  Normally this wouldn't be visible
+--     to the programmer, but using `unsafeIOToSTM` can expose it.
+--
+unsafeIOToSTM :: IO a -> STM a
+unsafeIOToSTM (IO m) = STM m
+
+-- | Perform a series of STM actions atomically.
+--
+-- Using 'atomically' inside an 'unsafePerformIO' or 'unsafeInterleaveIO'
+-- subverts some of guarantees that STM provides. It makes it possible to
+-- run a transaction inside of another transaction, depending on when the
+-- thunk is evaluated. If a nested transaction is attempted, an exception
+-- is thrown by the runtime. It is possible to safely use 'atomically' inside
+-- 'unsafePerformIO' or 'unsafeInterleaveIO', but the typechecker does not
+-- rule out programs that may attempt nested transactions, meaning that
+-- the programmer must take special care to prevent these.
+--
+-- However, there are functions for creating transactional variables that
+-- can always be safely called in 'unsafePerformIO'. See: 'newTVarIO',
+-- 'Control.Concurrent.STM.TChan.newTChanIO',
+-- 'Control.Concurrent.STM.TChan.newBroadcastTChanIO',
+-- 'Control.Concurrent.STM.TQueue.newTQueueIO',
+-- 'Control.Concurrent.STM.TBQueue.newTBQueueIO', and
+-- 'Control.Concurrent.STM.TMVar.newTMVarIO'.
+--
+-- Using 'unsafePerformIO' inside of 'atomically' is also dangerous but for
+-- different reasons. See 'unsafeIOToSTM' for more on this.
+
+atomically :: STM a -> IO a
+atomically (STM m) = IO (\s -> (atomically# m) s )
+
+-- | Retry execution of the current memory transaction because it has seen
+-- values in 'TVar's which mean that it should not continue (e.g. the 'TVar's
+-- represent a shared buffer that is now empty).  The implementation may
+-- block the thread until one of the 'TVar's that it has read from has been
+-- updated. (GHC only)
+retry :: STM a
+retry = STM $ \s# -> retry# s#
+
+-- | Compose two alternative STM actions (GHC only).
+--
+-- If the first action completes without retrying then it forms the result of
+-- the 'orElse'. Otherwise, if the first action retries, then the second action
+-- is tried in its place. If both actions retry then the 'orElse' as a whole
+-- retries.
+orElse :: STM a -> STM a -> STM a
+orElse (STM m) e = STM $ \s -> catchRetry# m (unSTM e) s
+
+-- | A variant of 'throw' that can only be used within the 'STM' monad.
+--
+-- Throwing an exception in @STM@ aborts the transaction and propagates the
+-- exception. If the exception is caught via 'catchSTM', only the changes
+-- enclosed by the catch are rolled back; changes made outside of 'catchSTM'
+-- persist.
+--
+-- If the exception is not caught inside of the 'STM', it is re-thrown by
+-- 'atomically', and the entire 'STM' is rolled back.
+--
+-- Although 'throwSTM' has a type that is an instance of the type of 'throw', the
+-- two functions are subtly different:
+--
+-- > throw e    `seq` x  ===> throw e
+-- > throwSTM e `seq` x  ===> x
+--
+-- The first example will cause the exception @e@ to be raised,
+-- whereas the second one won\'t.  In fact, 'throwSTM' will only cause
+-- an exception to be raised when it is used within the 'STM' monad.
+-- The 'throwSTM' variant should be used in preference to 'throw' to
+-- raise an exception within the 'STM' monad because it guarantees
+-- ordering with respect to other 'STM' operations, whereas 'throw'
+-- does not.
+throwSTM :: (HasCallStack, Exception e) => e -> STM a
+throwSTM e = do
+    -- N.B. Typically use of unsafeIOToSTM is very much frowned upon as this
+    -- is an easy way to end up with nested transactions. However, we can be
+    -- certain that toExceptionWithBacktrace will not initiate a transaction.
+    se <- unsafeIOToSTM (toExceptionWithBacktrace e)
+    STM $ raiseIO# se
+
+-- | Exception handling within STM actions.
+--
+-- @'catchSTM' m f@ catches any exception thrown by @m@ using 'throwSTM',
+-- using the function @f@ to handle the exception. If an exception is
+-- thrown, any changes made by @m@ are rolled back, but changes prior to
+-- @m@ persist.
+catchSTM :: Exception e => STM a -> (e -> STM a) -> STM a
+catchSTM (STM m) handler = STM $ catchSTM# m handler'
+    where
+      handler' e = case fromException e of
+                     Just e' -> unSTM (annotateSTM (WhileHandling e) (handler e'))
+                     Nothing -> raiseIO# e
+
+-- | Execute an 'STM' action, adding the given 'ExceptionContext'
+-- to any thrown synchronous exceptions.
+annotateSTM :: forall e a. ExceptionAnnotation e => e -> STM a -> STM a
+annotateSTM ann (STM io) = STM (catch# io handler)
+  where
+    handler se = raiseIO# (addExceptionContext ann se)
+
+-- |Shared memory locations that support atomic memory transactions.
+data TVar a = TVar (TVar# RealWorld a)
+
+-- | @since base-4.8.0.0
+instance Eq (TVar a) where
+        (TVar tvar1#) == (TVar tvar2#) = isTrue# (sameTVar# tvar1# tvar2#)
+
+-- | Create a new 'TVar' holding a value supplied
+newTVar :: a -> STM (TVar a)
+newTVar val = STM $ \s1# ->
+    case newTVar# val s1# of
+         (# s2#, tvar# #) -> (# s2#, TVar tvar# #)
+
+-- | @IO@ version of 'newTVar'.  This is useful for creating top-level
+-- 'TVar's using 'System.IO.Unsafe.unsafePerformIO', because using
+-- 'atomically' inside 'System.IO.Unsafe.unsafePerformIO' isn't
+-- possible.
+newTVarIO :: a -> IO (TVar a)
+newTVarIO val = IO $ \s1# ->
+    case newTVar# val s1# of
+         (# s2#, tvar# #) -> (# s2#, TVar tvar# #)
+
+-- | Return the current value stored in a 'TVar'.
+-- This is equivalent to
+--
+-- >  readTVarIO = atomically . readTVar
+--
+-- but works much faster, because it doesn't perform a complete
+-- transaction, it just reads the current value of the 'TVar'.
+readTVarIO :: TVar a -> IO a
+readTVarIO (TVar tvar#) = IO $ \s# -> readTVarIO# tvar# s#
+
+-- |Return the current value stored in a 'TVar'.
+readTVar :: TVar a -> STM a
+readTVar (TVar tvar#) = STM $ \s# -> readTVar# tvar# s#
+
+-- |Write the supplied value into a 'TVar'.
+writeTVar :: TVar a -> a -> STM ()
+writeTVar (TVar tvar#) val = STM $ \s1# ->
+    case writeTVar# tvar# val s1# of
+         s2# -> (# s2#, () #)
+


=====================================
testsuite/tests/dmdanal/should_run/T26748.hs
=====================================
@@ -0,0 +1,11 @@
+{-# LANGUAGE Haskell98 #-}
+module Main (main, x) where
+
+data Eq a => D a = MkD { lazy_field :: a, strict_field :: !a }
+
+x :: D ()
+{-# INLINABLE x #-}
+x = MkD { lazy_field = error "urk", strict_field = () }
+
+main :: IO ()
+main = print (strict_field x)


=====================================
testsuite/tests/dmdanal/should_run/T26748.stdout
=====================================
@@ -0,0 +1 @@
+()


=====================================
testsuite/tests/dmdanal/should_run/all.T
=====================================
@@ -34,3 +34,4 @@ test('T22475b', normal, compile_and_run, [''])
 test('T22549', normal, compile_and_run, ['-fdicts-strict -fno-specialise'])
 test('T23208', exit_code(1), multimod_compile_and_run, ['T23208_Lib', 'T23208'])
 test('T25439', normal, compile_and_run, [''])
+test('T26748', normal, compile_and_run, [''])


=====================================
testsuite/tests/interface-stability/base-exports.stdout
=====================================
@@ -146,9 +146,9 @@ module Control.Concurrent where
   threadCapability :: ThreadId -> GHC.Internal.Types.IO (GHC.Internal.Types.Int, GHC.Internal.Types.Bool)
   threadDelay :: GHC.Internal.Types.Int -> GHC.Internal.Types.IO ()
   threadWaitRead :: GHC.Internal.System.Posix.Types.Fd -> GHC.Internal.Types.IO ()
-  threadWaitReadSTM :: GHC.Internal.System.Posix.Types.Fd -> GHC.Internal.Types.IO (GHC.Internal.Conc.Sync.STM (), GHC.Internal.Types.IO ())
+  threadWaitReadSTM :: GHC.Internal.System.Posix.Types.Fd -> GHC.Internal.Types.IO (GHC.Internal.STM.STM (), GHC.Internal.Types.IO ())
   threadWaitWrite :: GHC.Internal.System.Posix.Types.Fd -> GHC.Internal.Types.IO ()
-  threadWaitWriteSTM :: GHC.Internal.System.Posix.Types.Fd -> GHC.Internal.Types.IO (GHC.Internal.Conc.Sync.STM (), GHC.Internal.Types.IO ())
+  threadWaitWriteSTM :: GHC.Internal.System.Posix.Types.Fd -> GHC.Internal.Types.IO (GHC.Internal.STM.STM (), GHC.Internal.Types.IO ())
   throwTo :: forall e. GHC.Internal.Exception.Type.Exception e => ThreadId -> e -> GHC.Internal.Types.IO ()
   tryPutMVar :: forall a. MVar a -> a -> GHC.Internal.Types.IO GHC.Internal.Types.Bool
   tryReadMVar :: forall a. MVar a -> GHC.Internal.Types.IO (GHC.Internal.Maybe.Maybe a)
@@ -5117,7 +5117,7 @@ module GHC.Conc where
   threadWaitReadSTM :: GHC.Internal.System.Posix.Types.Fd -> GHC.Internal.Types.IO (STM (), GHC.Internal.Types.IO ())
   threadWaitWrite :: GHC.Internal.System.Posix.Types.Fd -> GHC.Internal.Types.IO ()
   threadWaitWriteSTM :: GHC.Internal.System.Posix.Types.Fd -> GHC.Internal.Types.IO (STM (), GHC.Internal.Types.IO ())
-  throwSTM :: forall e a. GHC.Internal.Exception.Type.Exception e => e -> STM a
+  throwSTM :: forall e a. (GHC.Internal.Stack.Types.HasCallStack, GHC.Internal.Exception.Type.Exception e) => e -> STM a
   throwTo :: forall e. GHC.Internal.Exception.Type.Exception e => ThreadId -> e -> GHC.Internal.Types.IO ()
   unsafeIOToSTM :: forall a. GHC.Internal.Types.IO a -> STM a
   withMVar :: forall a b. GHC.Internal.MVar.MVar a -> (a -> GHC.Internal.Types.IO b) -> GHC.Internal.Types.IO b
@@ -5197,7 +5197,7 @@ module GHC.Conc.Sync where
   threadCapability :: ThreadId -> GHC.Internal.Types.IO (GHC.Internal.Types.Int, GHC.Internal.Types.Bool)
   threadLabel :: ThreadId -> GHC.Internal.Types.IO (GHC.Internal.Maybe.Maybe GHC.Internal.Base.String)
   threadStatus :: ThreadId -> GHC.Internal.Types.IO ThreadStatus
-  throwSTM :: forall e a. GHC.Internal.Exception.Type.Exception e => e -> STM a
+  throwSTM :: forall e a. (GHC.Internal.Stack.Types.HasCallStack, GHC.Internal.Exception.Type.Exception e) => e -> STM a
   throwTo :: forall e. GHC.Internal.Exception.Type.Exception e => ThreadId -> e -> GHC.Internal.Types.IO ()
   unsafeIOToSTM :: forall a. GHC.Internal.Types.IO a -> STM a
   withMVar :: forall a b. GHC.Internal.MVar.MVar a -> (a -> GHC.Internal.Types.IO b) -> GHC.Internal.Types.IO b
@@ -11117,12 +11117,12 @@ instance GHC.Internal.Base.Alternative GHC.Internal.Maybe.Maybe -- Defined in 
 instance GHC.Internal.Base.Alternative GHC.Internal.Functor.ZipList.ZipList -- Defined in ‘GHC.Internal.Functor.ZipList’
 instance forall (a :: * -> * -> *). GHC.Internal.Control.Arrow.ArrowPlus a => GHC.Internal.Base.Alternative (GHC.Internal.Control.Arrow.ArrowMonad a) -- Defined in ‘GHC.Internal.Control.Arrow’
 instance forall (m :: * -> *) a. GHC.Internal.Base.Alternative m => GHC.Internal.Base.Alternative (GHC.Internal.Control.Arrow.Kleisli m a) -- Defined in ‘GHC.Internal.Control.Arrow’
-instance GHC.Internal.Base.Alternative GHC.Internal.Conc.Sync.STM -- Defined in ‘GHC.Internal.Conc.Sync’
 instance GHC.Internal.Base.Alternative GHC.Internal.Data.Proxy.Proxy -- Defined in ‘GHC.Internal.Data.Proxy’
 instance forall (f :: * -> *) (g :: * -> *). (GHC.Internal.Base.Alternative f, GHC.Internal.Base.Applicative g) => GHC.Internal.Base.Alternative (Data.Functor.Compose.Compose f g) -- Defined in ‘Data.Functor.Compose’
 instance [safe] forall (f :: * -> *) (g :: * -> *). (GHC.Internal.Base.Alternative f, GHC.Internal.Base.Alternative g) => GHC.Internal.Base.Alternative (Data.Functor.Product.Product f g) -- Defined in ‘Data.Functor.Product’
 instance forall (f :: * -> *). GHC.Internal.Base.Alternative f => GHC.Internal.Base.Alternative (GHC.Internal.Data.Semigroup.Internal.Alt f) -- Defined in ‘GHC.Internal.Data.Semigroup.Internal’
 instance forall (f :: * -> *). GHC.Internal.Base.Alternative f => GHC.Internal.Base.Alternative (GHC.Internal.Data.Monoid.Ap f) -- Defined in ‘GHC.Internal.Data.Monoid’
+instance GHC.Internal.Base.Alternative GHC.Internal.STM.STM -- Defined in ‘GHC.Internal.STM’
 instance forall (f :: * -> *) (g :: * -> *). (GHC.Internal.Base.Alternative f, GHC.Internal.Base.Alternative g) => GHC.Internal.Base.Alternative (f GHC.Internal.Generics.:*: g) -- Defined in ‘GHC.Internal.Generics’
 instance forall (f :: * -> *) (g :: * -> *). (GHC.Internal.Base.Alternative f, GHC.Internal.Base.Applicative g) => GHC.Internal.Base.Alternative (f GHC.Internal.Generics.:.: g) -- Defined in ‘GHC.Internal.Generics’
 instance forall (f :: * -> *). (GHC.Internal.Generics.Generic1 f, GHC.Internal.Base.Alternative (GHC.Internal.Generics.Rep1 f)) => GHC.Internal.Base.Alternative (GHC.Internal.Generics.Generically1 f) -- Defined in ‘GHC.Internal.Generics’
@@ -11146,7 +11146,6 @@ instance forall m. GHC.Internal.Base.Monoid m => GHC.Internal.Base.Applicative (
 instance GHC.Internal.Base.Applicative GHC.Internal.Functor.ZipList.ZipList -- Defined in ‘GHC.Internal.Functor.ZipList’
 instance forall (a :: * -> * -> *). GHC.Internal.Control.Arrow.Arrow a => GHC.Internal.Base.Applicative (GHC.Internal.Control.Arrow.ArrowMonad a) -- Defined in ‘GHC.Internal.Control.Arrow’
 instance forall (m :: * -> *) a. GHC.Internal.Base.Applicative m => GHC.Internal.Base.Applicative (GHC.Internal.Control.Arrow.Kleisli m a) -- Defined in ‘GHC.Internal.Control.Arrow’
-instance GHC.Internal.Base.Applicative GHC.Internal.Conc.Sync.STM -- Defined in ‘GHC.Internal.Conc.Sync’
 instance forall s. GHC.Internal.Base.Applicative (GHC.Internal.ST.ST s) -- Defined in ‘GHC.Internal.ST’
 instance forall s. GHC.Internal.Base.Applicative (GHC.Internal.Control.Monad.ST.Lazy.Imp.ST s) -- Defined in ‘GHC.Internal.Control.Monad.ST.Lazy.Imp’
 instance GHC.Internal.Base.Applicative Data.Complex.Complex -- Defined in ‘Data.Complex’
@@ -11168,6 +11167,7 @@ instance GHC.Internal.Base.Applicative Data.Semigroup.First -- Defined in ‘Dat
 instance GHC.Internal.Base.Applicative Data.Semigroup.Last -- Defined in ‘Data.Semigroup’
 instance GHC.Internal.Base.Applicative Data.Semigroup.Max -- Defined in ‘Data.Semigroup’
 instance GHC.Internal.Base.Applicative Data.Semigroup.Min -- Defined in ‘Data.Semigroup’
+instance GHC.Internal.Base.Applicative GHC.Internal.STM.STM -- Defined in ‘GHC.Internal.STM’
 instance GHC.Internal.Base.Applicative GHC.Internal.GHCi.NoIO -- Defined in ‘GHC.Internal.GHCi’
 instance forall (f :: * -> *) (g :: * -> *). (GHC.Internal.Base.Applicative f, GHC.Internal.Base.Applicative g) => GHC.Internal.Base.Applicative (f GHC.Internal.Generics.:*: g) -- Defined in ‘GHC.Internal.Generics’
 instance forall (f :: * -> *) (g :: * -> *). (GHC.Internal.Base.Applicative f, GHC.Internal.Base.Applicative g) => GHC.Internal.Base.Applicative (f GHC.Internal.Generics.:.: g) -- Defined in ‘GHC.Internal.Generics’
@@ -11197,7 +11197,6 @@ instance forall m. GHC.Internal.Base.Functor (GHC.Internal.Data.Functor.Const.Co
 instance GHC.Internal.Base.Functor GHC.Internal.Functor.ZipList.ZipList -- Defined in ‘GHC.Internal.Functor.ZipList’
 instance forall (a :: * -> * -> *). GHC.Internal.Control.Arrow.Arrow a => GHC.Internal.Base.Functor (GHC.Internal.Control.Arrow.ArrowMonad a) -- Defined in ‘GHC.Internal.Control.Arrow’
 instance forall (m :: * -> *) a. GHC.Internal.Base.Functor m => GHC.Internal.Base.Functor (GHC.Internal.Control.Arrow.Kleisli m a) -- Defined in ‘GHC.Internal.Control.Arrow’
-instance GHC.Internal.Base.Functor GHC.Internal.Conc.Sync.STM -- Defined in ‘GHC.Internal.Conc.Sync’
 instance GHC.Internal.Base.Functor GHC.Internal.Control.Exception.Handler -- Defined in ‘GHC.Internal.Control.Exception’
 instance forall s. GHC.Internal.Base.Functor (GHC.Internal.ST.ST s) -- Defined in ‘GHC.Internal.ST’
 instance forall s. GHC.Internal.Base.Functor (GHC.Internal.Control.Monad.ST.Lazy.Imp.ST s) -- Defined in ‘GHC.Internal.Control.Monad.ST.Lazy.Imp’
@@ -11223,6 +11222,7 @@ instance GHC.Internal.Base.Functor Data.Semigroup.Last -- Defined in ‘Data.Sem
 instance GHC.Internal.Base.Functor Data.Semigroup.Max -- Defined in ‘Data.Semigroup’
 instance GHC.Internal.Base.Functor Data.Semigroup.Min -- Defined in ‘Data.Semigroup’
 instance forall i. GHC.Internal.Base.Functor (GHC.Internal.Arr.Array i) -- Defined in ‘GHC.Internal.Arr’
+instance GHC.Internal.Base.Functor GHC.Internal.STM.STM -- Defined in ‘GHC.Internal.STM’
 instance GHC.Internal.Base.Functor GHC.Internal.GHCi.NoIO -- Defined in ‘GHC.Internal.GHCi’
 instance forall (f :: * -> *) (g :: * -> *). (GHC.Internal.Base.Functor f, GHC.Internal.Base.Functor g) => GHC.Internal.Base.Functor (f GHC.Internal.Generics.:*: g) -- Defined in ‘GHC.Internal.Generics’
 instance forall (f :: * -> *) (g :: * -> *). (GHC.Internal.Base.Functor f, GHC.Internal.Base.Functor g) => GHC.Internal.Base.Functor (f GHC.Internal.Generics.:+: g) -- Defined in ‘GHC.Internal.Generics’
@@ -11257,7 +11257,6 @@ instance forall a b. (GHC.Internal.Base.Monoid a, GHC.Internal.Base.Monoid b) =>
 instance forall a b c. (GHC.Internal.Base.Monoid a, GHC.Internal.Base.Monoid b, GHC.Internal.Base.Monoid c) => GHC.Internal.Base.Monad ((,,,) a b c) -- Defined in ‘GHC.Internal.Base’
 instance forall (a :: * -> * -> *). GHC.Internal.Control.Arrow.ArrowApply a => GHC.Internal.Base.Monad (GHC.Internal.Control.Arrow.ArrowMonad a) -- Defined in ‘GHC.Internal.Control.Arrow’
 instance forall (m :: * -> *) a. GHC.Internal.Base.Monad m => GHC.Internal.Base.Monad (GHC.Internal.Control.Arrow.Kleisli m a) -- Defined in ‘GHC.Internal.Control.Arrow’
-instance GHC.Internal.Base.Monad GHC.Internal.Conc.Sync.STM -- Defined in ‘GHC.Internal.Conc.Sync’
 instance forall s. GHC.Internal.Base.Monad (GHC.Internal.ST.ST s) -- Defined in ‘GHC.Internal.ST’
 instance forall s. GHC.Internal.Base.Monad (GHC.Internal.Control.Monad.ST.Lazy.Imp.ST s) -- Defined in ‘GHC.Internal.Control.Monad.ST.Lazy.Imp’
 instance GHC.Internal.Base.Monad Data.Complex.Complex -- Defined in ‘Data.Complex’
@@ -11278,6 +11277,7 @@ instance GHC.Internal.Base.Monad Data.Semigroup.First -- Defined in ‘Data.Semi
 instance GHC.Internal.Base.Monad Data.Semigroup.Last -- Defined in ‘Data.Semigroup’
 instance GHC.Internal.Base.Monad Data.Semigroup.Max -- Defined in ‘Data.Semigroup’
 instance GHC.Internal.Base.Monad Data.Semigroup.Min -- Defined in ‘Data.Semigroup’
+instance GHC.Internal.Base.Monad GHC.Internal.STM.STM -- Defined in ‘GHC.Internal.STM’
 instance GHC.Internal.Base.Monad GHC.Internal.GHCi.NoIO -- Defined in ‘GHC.Internal.GHCi’
 instance forall (f :: * -> *) (g :: * -> *). (GHC.Internal.Base.Monad f, GHC.Internal.Base.Monad g) => GHC.Internal.Base.Monad (f GHC.Internal.Generics.:*: g) -- Defined in ‘GHC.Internal.Generics’
 instance forall (f :: * -> *) i (c :: GHC.Internal.Generics.Meta). GHC.Internal.Base.Monad f => GHC.Internal.Base.Monad (GHC.Internal.Generics.M1 i c f) -- Defined in ‘GHC.Internal.Generics’
@@ -11292,11 +11292,11 @@ instance GHC.Internal.Base.MonadPlus [] -- Defined in ‘GHC.Internal.Base’
 instance GHC.Internal.Base.MonadPlus GHC.Internal.Maybe.Maybe -- Defined in ‘GHC.Internal.Base’
 instance forall (a :: * -> * -> *). (GHC.Internal.Control.Arrow.ArrowApply a, GHC.Internal.Control.Arrow.ArrowPlus a) => GHC.Internal.Base.MonadPlus (GHC.Internal.Control.Arrow.ArrowMonad a) -- Defined in ‘GHC.Internal.Control.Arrow’
 instance forall (m :: * -> *) a. GHC.Internal.Base.MonadPlus m => GHC.Internal.Base.MonadPlus (GHC.Internal.Control.Arrow.Kleisli m a) -- Defined in ‘GHC.Internal.Control.Arrow’
-instance GHC.Internal.Base.MonadPlus GHC.Internal.Conc.Sync.STM -- Defined in ‘GHC.Internal.Conc.Sync’
 instance GHC.Internal.Base.MonadPlus GHC.Internal.Data.Proxy.Proxy -- Defined in ‘GHC.Internal.Data.Proxy’
 instance [safe] forall (f :: * -> *) (g :: * -> *). (GHC.Internal.Base.MonadPlus f, GHC.Internal.Base.MonadPlus g) => GHC.Internal.Base.MonadPlus (Data.Functor.Product.Product f g) -- Defined in ‘Data.Functor.Product’
 instance forall (f :: * -> *). GHC.Internal.Base.MonadPlus f => GHC.Internal.Base.MonadPlus (GHC.Internal.Data.Semigroup.Internal.Alt f) -- Defined in ‘GHC.Internal.Data.Semigroup.Internal’
 instance forall (f :: * -> *). GHC.Internal.Base.MonadPlus f => GHC.Internal.Base.MonadPlus (GHC.Internal.Data.Monoid.Ap f) -- Defined in ‘GHC.Internal.Data.Monoid’
+instance GHC.Internal.Base.MonadPlus GHC.Internal.STM.STM -- Defined in ‘GHC.Internal.STM’
 instance forall (f :: * -> *) (g :: * -> *). (GHC.Internal.Base.MonadPlus f, GHC.Internal.Base.MonadPlus g) => GHC.Internal.Base.MonadPlus (f GHC.Internal.Generics.:*: g) -- Defined in ‘GHC.Internal.Generics’
 instance forall (f :: * -> *) i (c :: GHC.Internal.Generics.Meta). GHC.Internal.Base.MonadPlus f => GHC.Internal.Base.MonadPlus (GHC.Internal.Generics.M1 i c f) -- Defined in ‘GHC.Internal.Generics’
 instance forall (f :: * -> *). GHC.Internal.Base.MonadPlus f => GHC.Internal.Base.MonadPlus (GHC.Internal.Generics.Rec1 f) -- Defined in ‘GHC.Internal.Generics’
@@ -11316,7 +11316,6 @@ instance forall a b c d. (GHC.Internal.Base.Monoid a, GHC.Internal.Base.Monoid b
 instance forall a b c d e. (GHC.Internal.Base.Monoid a, GHC.Internal.Base.Monoid b, GHC.Internal.Base.Monoid c, GHC.Internal.Base.Monoid d, GHC.Internal.Base.Monoid e) => GHC.Internal.Base.Monoid (a, b, c, d, e) -- Defined in ‘GHC.Internal.Base’
 instance GHC.Internal.Base.Monoid () -- Defined in ‘GHC.Internal.Base’
 instance forall a k (b :: k). GHC.Internal.Base.Monoid a => GHC.Internal.Base.Monoid (GHC.Internal.Data.Functor.Const.Const a b) -- Defined in ‘GHC.Internal.Data.Functor.Const’
-instance forall a. GHC.Internal.Base.Monoid a => GHC.Internal.Base.Monoid (GHC.Internal.Conc.Sync.STM a) -- Defined in ‘GHC.Internal.Conc.Sync’
 instance GHC.Internal.Base.Monoid GHC.Internal.Exception.Context.ExceptionContext -- Defined in ‘GHC.Internal.Exception.Context’
 instance forall a s. GHC.Internal.Base.Monoid a => GHC.Internal.Base.Monoid (GHC.Internal.ST.ST s a) -- Defined in ‘GHC.Internal.ST’
 instance forall a s. GHC.Internal.Base.Monoid a => GHC.Internal.Base.Monoid (GHC.Internal.Control.Monad.ST.Lazy.Imp.ST s a) -- Defined in ‘GHC.Internal.Control.Monad.ST.Lazy.Imp’
@@ -11347,6 +11346,7 @@ instance forall a. GHC.Internal.Base.Monoid a => GHC.Internal.Base.Monoid (GHC.I
 instance forall a. (GHC.Internal.Classes.Ord a, GHC.Internal.Enum.Bounded a) => GHC.Internal.Base.Monoid (Data.Semigroup.Max a) -- Defined in ‘Data.Semigroup’
 instance forall a. (GHC.Internal.Classes.Ord a, GHC.Internal.Enum.Bounded a) => GHC.Internal.Base.Monoid (Data.Semigroup.Min a) -- Defined in ‘Data.Semigroup’
 instance forall m. GHC.Internal.Base.Monoid m => GHC.Internal.Base.Monoid (Data.Semigroup.WrappedMonoid m) -- Defined in ‘Data.Semigroup’
+instance forall a. GHC.Internal.Base.Monoid a => GHC.Internal.Base.Monoid (GHC.Internal.STM.STM a) -- Defined in ‘GHC.Internal.STM’
 instance GHC.Internal.Base.Monoid ghc-internal-9.1500.0:GHC.Internal.Event.Internal.Types.Event -- Defined in ‘ghc-internal-9.1500.0:GHC.Internal.Event.Internal.Types’
 instance GHC.Internal.Base.Monoid ghc-internal-9.1500.0:GHC.Internal.Event.Internal.Types.EventLifetime -- Defined in ‘ghc-internal-9.1500.0:GHC.Internal.Event.Internal.Types’
 instance GHC.Internal.Base.Monoid ghc-internal-9.1500.0:GHC.Internal.Event.Internal.Types.Lifetime -- Defined in ‘ghc-internal-9.1500.0:GHC.Internal.Event.Internal.Types’
@@ -11371,7 +11371,6 @@ instance forall a b c d e. (GHC.Internal.Base.Semigroup a, GHC.Internal.Base.Sem
 instance GHC.Internal.Base.Semigroup () -- Defined in ‘GHC.Internal.Base’
 instance GHC.Internal.Base.Semigroup GHC.Internal.Base.Void -- Defined in ‘GHC.Internal.Base’
 instance forall a k (b :: k). GHC.Internal.Base.Semigroup a => GHC.Internal.Base.Semigroup (GHC.Internal.Data.Functor.Const.Const a b) -- Defined in ‘GHC.Internal.Data.Functor.Const’
-instance forall a. GHC.Internal.Base.Semigroup a => GHC.Internal.Base.Semigroup (GHC.Internal.Conc.Sync.STM a) -- Defined in ‘GHC.Internal.Conc.Sync’
 instance GHC.Internal.Base.Semigroup GHC.Internal.Exception.Context.ExceptionContext -- Defined in ‘GHC.Internal.Exception.Context’
 instance forall a s. GHC.Internal.Base.Semigroup a => GHC.Internal.Base.Semigroup (GHC.Internal.ST.ST s a) -- Defined in ‘GHC.Internal.ST’
 instance forall a s. GHC.Internal.Base.Semigroup a => GHC.Internal.Base.Semigroup (GHC.Internal.Control.Monad.ST.Lazy.Imp.ST s a) -- Defined in ‘GHC.Internal.Control.Monad.ST.Lazy.Imp’
@@ -11409,6 +11408,7 @@ instance forall a. GHC.Internal.Base.Semigroup (Data.Semigroup.Last a) -- Define
 instance forall a. GHC.Internal.Classes.Ord a => GHC.Internal.Base.Semigroup (Data.Semigroup.Max a) -- Defined in ‘Data.Semigroup’
 instance forall a. GHC.Internal.Classes.Ord a => GHC.Internal.Base.Semigroup (Data.Semigroup.Min a) -- Defined in ‘Data.Semigroup’
 instance forall m. GHC.Internal.Base.Monoid m => GHC.Internal.Base.Semigroup (Data.Semigroup.WrappedMonoid m) -- Defined in ‘Data.Semigroup’
+instance forall a. GHC.Internal.Base.Semigroup a => GHC.Internal.Base.Semigroup (GHC.Internal.STM.STM a) -- Defined in ‘GHC.Internal.STM’
 instance GHC.Internal.Base.Semigroup ghc-internal-9.1500.0:GHC.Internal.Event.Internal.Types.Event -- Defined in ‘ghc-internal-9.1500.0:GHC.Internal.Event.Internal.Types’
 instance GHC.Internal.Base.Semigroup ghc-internal-9.1500.0:GHC.Internal.Event.Internal.Types.EventLifetime -- Defined in ‘ghc-internal-9.1500.0:GHC.Internal.Event.Internal.Types’
 instance GHC.Internal.Base.Semigroup ghc-internal-9.1500.0:GHC.Internal.Event.Internal.Types.Lifetime -- Defined in ‘ghc-internal-9.1500.0:GHC.Internal.Event.Internal.Types’
@@ -11510,7 +11510,6 @@ instance forall a. GHC.Internal.Classes.Eq a => GHC.Internal.Classes.Eq (GHC.Int
 instance forall a. GHC.Internal.Classes.Eq (Control.Concurrent.Chan.Chan a) -- Defined in ‘Control.Concurrent.Chan’
 instance forall a. GHC.Internal.Classes.Eq (GHC.Internal.MVar.MVar a) -- Defined in ‘GHC.Internal.MVar’
 instance GHC.Internal.Classes.Eq GHC.Internal.Conc.Sync.BlockReason -- Defined in ‘GHC.Internal.Conc.Sync’
-instance forall a. GHC.Internal.Classes.Eq (GHC.Internal.Conc.Sync.TVar a) -- Defined in ‘GHC.Internal.Conc.Sync’
 instance GHC.Internal.Classes.Eq GHC.Internal.Conc.Sync.ThreadId -- Defined in ‘GHC.Internal.Conc.Sync’
 instance GHC.Internal.Classes.Eq GHC.Internal.Conc.Sync.ThreadStatus -- Defined in ‘GHC.Internal.Conc.Sync’
 instance GHC.Internal.Classes.Eq GHC.Internal.IO.Exception.ArrayException -- Defined in ‘GHC.Internal.IO.Exception’
@@ -11640,6 +11639,7 @@ instance forall a. GHC.Internal.Classes.Eq (GHC.Internal.Foreign.C.ConstPtr.Cons
 instance forall i e. (GHC.Internal.Ix.Ix i, GHC.Internal.Classes.Eq e) => GHC.Internal.Classes.Eq (GHC.Internal.Arr.Array i e) -- Defined in ‘GHC.Internal.Arr’
 instance forall s i e. GHC.Internal.Classes.Eq (GHC.Internal.Arr.STArray s i e) -- Defined in ‘GHC.Internal.Arr’
 instance GHC.Internal.Classes.Eq GHC.Internal.ByteOrder.ByteOrder -- Defined in ‘GHC.Internal.ByteOrder’
+instance forall a. GHC.Internal.Classes.Eq (GHC.Internal.STM.TVar a) -- Defined in ‘GHC.Internal.STM’
 instance GHC.Internal.Classes.Eq ghc-internal-9.1500.0:GHC.Internal.Event.Internal.Types.Event -- Defined in ‘ghc-internal-9.1500.0:GHC.Internal.Event.Internal.Types’
 instance GHC.Internal.Classes.Eq ghc-internal-9.1500.0:GHC.Internal.Event.Internal.Types.EventLifetime -- Defined in ‘ghc-internal-9.1500.0:GHC.Internal.Event.Internal.Types’
 instance GHC.Internal.Classes.Eq ghc-internal-9.1500.0:GHC.Internal.Event.Internal.Types.Lifetime -- Defined in ‘ghc-internal-9.1500.0:GHC.Internal.Event.Internal.Types’


=====================================
testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs
=====================================
@@ -146,9 +146,9 @@ module Control.Concurrent where
   threadCapability :: ThreadId -> GHC.Internal.Types.IO (GHC.Internal.Types.Int, GHC.Internal.Types.Bool)
   threadDelay :: GHC.Internal.Types.Int -> GHC.Internal.Types.IO ()
   threadWaitRead :: GHC.Internal.System.Posix.Types.Fd -> GHC.Internal.Types.IO ()
-  threadWaitReadSTM :: GHC.Internal.System.Posix.Types.Fd -> GHC.Internal.Types.IO (GHC.Internal.Conc.Sync.STM (), GHC.Internal.Types.IO ())
+  threadWaitReadSTM :: GHC.Internal.System.Posix.Types.Fd -> GHC.Internal.Types.IO (GHC.Internal.STM.STM (), GHC.Internal.Types.IO ())
   threadWaitWrite :: GHC.Internal.System.Posix.Types.Fd -> GHC.Internal.Types.IO ()
-  threadWaitWriteSTM :: GHC.Internal.System.Posix.Types.Fd -> GHC.Internal.Types.IO (GHC.Internal.Conc.Sync.STM (), GHC.Internal.Types.IO ())
+  threadWaitWriteSTM :: GHC.Internal.System.Posix.Types.Fd -> GHC.Internal.Types.IO (GHC.Internal.STM.STM (), GHC.Internal.Types.IO ())
   throwTo :: forall e. GHC.Internal.Exception.Type.Exception e => ThreadId -> e -> GHC.Internal.Types.IO ()
   tryPutMVar :: forall a. MVar a -> a -> GHC.Internal.Types.IO GHC.Internal.Types.Bool
   tryReadMVar :: forall a. MVar a -> GHC.Internal.Types.IO (GHC.Internal.Maybe.Maybe a)
@@ -5117,7 +5117,7 @@ module GHC.Conc where
   threadWaitReadSTM :: GHC.Internal.System.Posix.Types.Fd -> GHC.Internal.Types.IO (STM (), GHC.Internal.Types.IO ())
   threadWaitWrite :: GHC.Internal.System.Posix.Types.Fd -> GHC.Internal.Types.IO ()
   threadWaitWriteSTM :: GHC.Internal.System.Posix.Types.Fd -> GHC.Internal.Types.IO (STM (), GHC.Internal.Types.IO ())
-  throwSTM :: forall e a. GHC.Internal.Exception.Type.Exception e => e -> STM a
+  throwSTM :: forall e a. (GHC.Internal.Stack.Types.HasCallStack, GHC.Internal.Exception.Type.Exception e) => e -> STM a
   throwTo :: forall e. GHC.Internal.Exception.Type.Exception e => ThreadId -> e -> GHC.Internal.Types.IO ()
   unsafeIOToSTM :: forall a. GHC.Internal.Types.IO a -> STM a
   withMVar :: forall a b. GHC.Internal.MVar.MVar a -> (a -> GHC.Internal.Types.IO b) -> GHC.Internal.Types.IO b
@@ -5197,7 +5197,7 @@ module GHC.Conc.Sync where
   threadCapability :: ThreadId -> GHC.Internal.Types.IO (GHC.Internal.Types.Int, GHC.Internal.Types.Bool)
   threadLabel :: ThreadId -> GHC.Internal.Types.IO (GHC.Internal.Maybe.Maybe GHC.Internal.Base.String)
   threadStatus :: ThreadId -> GHC.Internal.Types.IO ThreadStatus
-  throwSTM :: forall e a. GHC.Internal.Exception.Type.Exception e => e -> STM a
+  throwSTM :: forall e a. (GHC.Internal.Stack.Types.HasCallStack, GHC.Internal.Exception.Type.Exception e) => e -> STM a
   throwTo :: forall e. GHC.Internal.Exception.Type.Exception e => ThreadId -> e -> GHC.Internal.Types.IO ()
   unsafeIOToSTM :: forall a. GHC.Internal.Types.IO a -> STM a
   withMVar :: forall a b. GHC.Internal.MVar.MVar a -> (a -> GHC.Internal.Types.IO b) -> GHC.Internal.Types.IO b
@@ -14163,12 +14163,12 @@ instance GHC.Internal.Base.Alternative GHC.Internal.Maybe.Maybe -- Defined in 
 instance GHC.Internal.Base.Alternative GHC.Internal.Functor.ZipList.ZipList -- Defined in ‘GHC.Internal.Functor.ZipList’
 instance forall (a :: * -> * -> *). GHC.Internal.Control.Arrow.ArrowPlus a => GHC.Internal.Base.Alternative (GHC.Internal.Control.Arrow.ArrowMonad a) -- Defined in ‘GHC.Internal.Control.Arrow’
 instance forall (m :: * -> *) a. GHC.Internal.Base.Alternative m => GHC.Internal.Base.Alternative (GHC.Internal.Control.Arrow.Kleisli m a) -- Defined in ‘GHC.Internal.Control.Arrow’
-instance GHC.Internal.Base.Alternative GHC.Internal.Conc.Sync.STM -- Defined in ‘GHC.Internal.Conc.Sync’
 instance GHC.Internal.Base.Alternative GHC.Internal.Data.Proxy.Proxy -- Defined in ‘GHC.Internal.Data.Proxy’
 instance forall (f :: * -> *) (g :: * -> *). (GHC.Internal.Base.Alternative f, GHC.Internal.Base.Applicative g) => GHC.Internal.Base.Alternative (Data.Functor.Compose.Compose f g) -- Defined in ‘Data.Functor.Compose’
 instance [safe] forall (f :: * -> *) (g :: * -> *). (GHC.Internal.Base.Alternative f, GHC.Internal.Base.Alternative g) => GHC.Internal.Base.Alternative (Data.Functor.Product.Product f g) -- Defined in ‘Data.Functor.Product’
 instance forall (f :: * -> *). GHC.Internal.Base.Alternative f => GHC.Internal.Base.Alternative (GHC.Internal.Data.Semigroup.Internal.Alt f) -- Defined in ‘GHC.Internal.Data.Semigroup.Internal’
 instance forall (f :: * -> *). GHC.Internal.Base.Alternative f => GHC.Internal.Base.Alternative (GHC.Internal.Data.Monoid.Ap f) -- Defined in ‘GHC.Internal.Data.Monoid’
+instance GHC.Internal.Base.Alternative GHC.Internal.STM.STM -- Defined in ‘GHC.Internal.STM’
 instance forall (f :: * -> *) (g :: * -> *). (GHC.Internal.Base.Alternative f, GHC.Internal.Base.Alternative g) => GHC.Internal.Base.Alternative (f GHC.Internal.Generics.:*: g) -- Defined in ‘GHC.Internal.Generics’
 instance forall (f :: * -> *) (g :: * -> *). (GHC.Internal.Base.Alternative f, GHC.Internal.Base.Applicative g) => GHC.Internal.Base.Alternative (f GHC.Internal.Generics.:.: g) -- Defined in ‘GHC.Internal.Generics’
 instance forall (f :: * -> *). (GHC.Internal.Generics.Generic1 f, GHC.Internal.Base.Alternative (GHC.Internal.Generics.Rep1 f)) => GHC.Internal.Base.Alternative (GHC.Internal.Generics.Generically1 f) -- Defined in ‘GHC.Internal.Generics’
@@ -14192,7 +14192,6 @@ instance forall m. GHC.Internal.Base.Monoid m => GHC.Internal.Base.Applicative (
 instance GHC.Internal.Base.Applicative GHC.Internal.Functor.ZipList.ZipList -- Defined in ‘GHC.Internal.Functor.ZipList’
 instance forall (a :: * -> * -> *). GHC.Internal.Control.Arrow.Arrow a => GHC.Internal.Base.Applicative (GHC.Internal.Control.Arrow.ArrowMonad a) -- Defined in ‘GHC.Internal.Control.Arrow’
 instance forall (m :: * -> *) a. GHC.Internal.Base.Applicative m => GHC.Internal.Base.Applicative (GHC.Internal.Control.Arrow.Kleisli m a) -- Defined in ‘GHC.Internal.Control.Arrow’
-instance GHC.Internal.Base.Applicative GHC.Internal.Conc.Sync.STM -- Defined in ‘GHC.Internal.Conc.Sync’
 instance forall s. GHC.Internal.Base.Applicative (GHC.Internal.ST.ST s) -- Defined in ‘GHC.Internal.ST’
 instance forall s. GHC.Internal.Base.Applicative (GHC.Internal.Control.Monad.ST.Lazy.Imp.ST s) -- Defined in ‘GHC.Internal.Control.Monad.ST.Lazy.Imp’
 instance GHC.Internal.Base.Applicative Data.Complex.Complex -- Defined in ‘Data.Complex’
@@ -14214,6 +14213,7 @@ instance GHC.Internal.Base.Applicative Data.Semigroup.First -- Defined in ‘Dat
 instance GHC.Internal.Base.Applicative Data.Semigroup.Last -- Defined in ‘Data.Semigroup’
 instance GHC.Internal.Base.Applicative Data.Semigroup.Max -- Defined in ‘Data.Semigroup’
 instance GHC.Internal.Base.Applicative Data.Semigroup.Min -- Defined in ‘Data.Semigroup’
+instance GHC.Internal.Base.Applicative GHC.Internal.STM.STM -- Defined in ‘GHC.Internal.STM’
 instance GHC.Internal.Base.Applicative GHC.Internal.GHCi.NoIO -- Defined in ‘GHC.Internal.GHCi’
 instance forall (f :: * -> *) (g :: * -> *). (GHC.Internal.Base.Applicative f, GHC.Internal.Base.Applicative g) => GHC.Internal.Base.Applicative (f GHC.Internal.Generics.:*: g) -- Defined in ‘GHC.Internal.Generics’
 instance forall (f :: * -> *) (g :: * -> *). (GHC.Internal.Base.Applicative f, GHC.Internal.Base.Applicative g) => GHC.Internal.Base.Applicative (f GHC.Internal.Generics.:.: g) -- Defined in ‘GHC.Internal.Generics’
@@ -14243,7 +14243,6 @@ instance forall m. GHC.Internal.Base.Functor (GHC.Internal.Data.Functor.Const.Co
 instance GHC.Internal.Base.Functor GHC.Internal.Functor.ZipList.ZipList -- Defined in ‘GHC.Internal.Functor.ZipList’
 instance forall (a :: * -> * -> *). GHC.Internal.Control.Arrow.Arrow a => GHC.Internal.Base.Functor (GHC.Internal.Control.Arrow.ArrowMonad a) -- Defined in ‘GHC.Internal.Control.Arrow’
 instance forall (m :: * -> *) a. GHC.Internal.Base.Functor m => GHC.Internal.Base.Functor (GHC.Internal.Control.Arrow.Kleisli m a) -- Defined in ‘GHC.Internal.Control.Arrow’
-instance GHC.Internal.Base.Functor GHC.Internal.Conc.Sync.STM -- Defined in ‘GHC.Internal.Conc.Sync’
 instance GHC.Internal.Base.Functor GHC.Internal.Control.Exception.Handler -- Defined in ‘GHC.Internal.Control.Exception’
 instance forall s. GHC.Internal.Base.Functor (GHC.Internal.ST.ST s) -- Defined in ‘GHC.Internal.ST’
 instance forall s. GHC.Internal.Base.Functor (GHC.Internal.Control.Monad.ST.Lazy.Imp.ST s) -- Defined in ‘GHC.Internal.Control.Monad.ST.Lazy.Imp’
@@ -14269,6 +14268,7 @@ instance GHC.Internal.Base.Functor Data.Semigroup.Last -- Defined in ‘Data.Sem
 instance GHC.Internal.Base.Functor Data.Semigroup.Max -- Defined in ‘Data.Semigroup’
 instance GHC.Internal.Base.Functor Data.Semigroup.Min -- Defined in ‘Data.Semigroup’
 instance forall i. GHC.Internal.Base.Functor (GHC.Internal.Arr.Array i) -- Defined in ‘GHC.Internal.Arr’
+instance GHC.Internal.Base.Functor GHC.Internal.STM.STM -- Defined in ‘GHC.Internal.STM’
 instance GHC.Internal.Base.Functor GHC.Internal.GHCi.NoIO -- Defined in ‘GHC.Internal.GHCi’
 instance forall (f :: * -> *) (g :: * -> *). (GHC.Internal.Base.Functor f, GHC.Internal.Base.Functor g) => GHC.Internal.Base.Functor (f GHC.Internal.Generics.:*: g) -- Defined in ‘GHC.Internal.Generics’
 instance forall (f :: * -> *) (g :: * -> *). (GHC.Internal.Base.Functor f, GHC.Internal.Base.Functor g) => GHC.Internal.Base.Functor (f GHC.Internal.Generics.:+: g) -- Defined in ‘GHC.Internal.Generics’
@@ -14303,7 +14303,6 @@ instance forall a b. (GHC.Internal.Base.Monoid a, GHC.Internal.Base.Monoid b) =>
 instance forall a b c. (GHC.Internal.Base.Monoid a, GHC.Internal.Base.Monoid b, GHC.Internal.Base.Monoid c) => GHC.Internal.Base.Monad ((,,,) a b c) -- Defined in ‘GHC.Internal.Base’
 instance forall (a :: * -> * -> *). GHC.Internal.Control.Arrow.ArrowApply a => GHC.Internal.Base.Monad (GHC.Internal.Control.Arrow.ArrowMonad a) -- Defined in ‘GHC.Internal.Control.Arrow’
 instance forall (m :: * -> *) a. GHC.Internal.Base.Monad m => GHC.Internal.Base.Monad (GHC.Internal.Control.Arrow.Kleisli m a) -- Defined in ‘GHC.Internal.Control.Arrow’
-instance GHC.Internal.Base.Monad GHC.Internal.Conc.Sync.STM -- Defined in ‘GHC.Internal.Conc.Sync’
 instance forall s. GHC.Internal.Base.Monad (GHC.Internal.ST.ST s) -- Defined in ‘GHC.Internal.ST’
 instance forall s. GHC.Internal.Base.Monad (GHC.Internal.Control.Monad.ST.Lazy.Imp.ST s) -- Defined in ‘GHC.Internal.Control.Monad.ST.Lazy.Imp’
 instance GHC.Internal.Base.Monad Data.Complex.Complex -- Defined in ‘Data.Complex’
@@ -14324,6 +14323,7 @@ instance GHC.Internal.Base.Monad Data.Semigroup.First -- Defined in ‘Data.Semi
 instance GHC.Internal.Base.Monad Data.Semigroup.Last -- Defined in ‘Data.Semigroup’
 instance GHC.Internal.Base.Monad Data.Semigroup.Max -- Defined in ‘Data.Semigroup’
 instance GHC.Internal.Base.Monad Data.Semigroup.Min -- Defined in ‘Data.Semigroup’
+instance GHC.Internal.Base.Monad GHC.Internal.STM.STM -- Defined in ‘GHC.Internal.STM’
 instance GHC.Internal.Base.Monad GHC.Internal.GHCi.NoIO -- Defined in ‘GHC.Internal.GHCi’
 instance forall (f :: * -> *) (g :: * -> *). (GHC.Internal.Base.Monad f, GHC.Internal.Base.Monad g) => GHC.Internal.Base.Monad (f GHC.Internal.Generics.:*: g) -- Defined in ‘GHC.Internal.Generics’
 instance forall (f :: * -> *) i (c :: GHC.Internal.Generics.Meta). GHC.Internal.Base.Monad f => GHC.Internal.Base.Monad (GHC.Internal.Generics.M1 i c f) -- Defined in ‘GHC.Internal.Generics’
@@ -14338,11 +14338,11 @@ instance GHC.Internal.Base.MonadPlus [] -- Defined in ‘GHC.Internal.Base’
 instance GHC.Internal.Base.MonadPlus GHC.Internal.Maybe.Maybe -- Defined in ‘GHC.Internal.Base’
 instance forall (a :: * -> * -> *). (GHC.Internal.Control.Arrow.ArrowApply a, GHC.Internal.Control.Arrow.ArrowPlus a) => GHC.Internal.Base.MonadPlus (GHC.Internal.Control.Arrow.ArrowMonad a) -- Defined in ‘GHC.Internal.Control.Arrow’
 instance forall (m :: * -> *) a. GHC.Internal.Base.MonadPlus m => GHC.Internal.Base.MonadPlus (GHC.Internal.Control.Arrow.Kleisli m a) -- Defined in ‘GHC.Internal.Control.Arrow’
-instance GHC.Internal.Base.MonadPlus GHC.Internal.Conc.Sync.STM -- Defined in ‘GHC.Internal.Conc.Sync’
 instance GHC.Internal.Base.MonadPlus GHC.Internal.Data.Proxy.Proxy -- Defined in ‘GHC.Internal.Data.Proxy’
 instance [safe] forall (f :: * -> *) (g :: * -> *). (GHC.Internal.Base.MonadPlus f, GHC.Internal.Base.MonadPlus g) => GHC.Internal.Base.MonadPlus (Data.Functor.Product.Product f g) -- Defined in ‘Data.Functor.Product’
 instance forall (f :: * -> *). GHC.Internal.Base.MonadPlus f => GHC.Internal.Base.MonadPlus (GHC.Internal.Data.Semigroup.Internal.Alt f) -- Defined in ‘GHC.Internal.Data.Semigroup.Internal’
 instance forall (f :: * -> *). GHC.Internal.Base.MonadPlus f => GHC.Internal.Base.MonadPlus (GHC.Internal.Data.Monoid.Ap f) -- Defined in ‘GHC.Internal.Data.Monoid’
+instance GHC.Internal.Base.MonadPlus GHC.Internal.STM.STM -- Defined in ‘GHC.Internal.STM’
 instance forall (f :: * -> *) (g :: * -> *). (GHC.Internal.Base.MonadPlus f, GHC.Internal.Base.MonadPlus g) => GHC.Internal.Base.MonadPlus (f GHC.Internal.Generics.:*: g) -- Defined in ‘GHC.Internal.Generics’
 instance forall (f :: * -> *) i (c :: GHC.Internal.Generics.Meta). GHC.Internal.Base.MonadPlus f => GHC.Internal.Base.MonadPlus (GHC.Internal.Generics.M1 i c f) -- Defined in ‘GHC.Internal.Generics’
 instance forall (f :: * -> *). GHC.Internal.Base.MonadPlus f => GHC.Internal.Base.MonadPlus (GHC.Internal.Generics.Rec1 f) -- Defined in ‘GHC.Internal.Generics’
@@ -14362,7 +14362,6 @@ instance forall a b c d. (GHC.Internal.Base.Monoid a, GHC.Internal.Base.Monoid b
 instance forall a b c d e. (GHC.Internal.Base.Monoid a, GHC.Internal.Base.Monoid b, GHC.Internal.Base.Monoid c, GHC.Internal.Base.Monoid d, GHC.Internal.Base.Monoid e) => GHC.Internal.Base.Monoid (a, b, c, d, e) -- Defined in ‘GHC.Internal.Base’
 instance GHC.Internal.Base.Monoid () -- Defined in ‘GHC.Internal.Base’
 instance forall a k (b :: k). GHC.Internal.Base.Monoid a => GHC.Internal.Base.Monoid (GHC.Internal.Data.Functor.Const.Const a b) -- Defined in ‘GHC.Internal.Data.Functor.Const’
-instance forall a. GHC.Internal.Base.Monoid a => GHC.Internal.Base.Monoid (GHC.Internal.Conc.Sync.STM a) -- Defined in ‘GHC.Internal.Conc.Sync’
 instance GHC.Internal.Base.Monoid GHC.Internal.Exception.Context.ExceptionContext -- Defined in ‘GHC.Internal.Exception.Context’
 instance forall a s. GHC.Internal.Base.Monoid a => GHC.Internal.Base.Monoid (GHC.Internal.ST.ST s a) -- Defined in ‘GHC.Internal.ST’
 instance forall a s. GHC.Internal.Base.Monoid a => GHC.Internal.Base.Monoid (GHC.Internal.Control.Monad.ST.Lazy.Imp.ST s a) -- Defined in ‘GHC.Internal.Control.Monad.ST.Lazy.Imp’
@@ -14393,6 +14392,7 @@ instance forall a. GHC.Internal.Base.Monoid a => GHC.Internal.Base.Monoid (GHC.I
 instance forall a. (GHC.Internal.Classes.Ord a, GHC.Internal.Enum.Bounded a) => GHC.Internal.Base.Monoid (Data.Semigroup.Max a) -- Defined in ‘Data.Semigroup’
 instance forall a. (GHC.Internal.Classes.Ord a, GHC.Internal.Enum.Bounded a) => GHC.Internal.Base.Monoid (Data.Semigroup.Min a) -- Defined in ‘Data.Semigroup’
 instance forall m. GHC.Internal.Base.Monoid m => GHC.Internal.Base.Monoid (Data.Semigroup.WrappedMonoid m) -- Defined in ‘Data.Semigroup’
+instance forall a. GHC.Internal.Base.Monoid a => GHC.Internal.Base.Monoid (GHC.Internal.STM.STM a) -- Defined in ‘GHC.Internal.STM’
 instance forall k (f :: k -> *) (p :: k) (g :: k -> *). (GHC.Internal.Base.Monoid (f p), GHC.Internal.Base.Monoid (g p)) => GHC.Internal.Base.Monoid ((GHC.Internal.Generics.:*:) f g p) -- Defined in ‘GHC.Internal.Generics’
 instance forall k2 k1 (f :: k2 -> *) (g :: k1 -> k2) (p :: k1). GHC.Internal.Base.Monoid (f (g p)) => GHC.Internal.Base.Monoid ((GHC.Internal.Generics.:.:) f g p) -- Defined in ‘GHC.Internal.Generics’
 instance forall a. (GHC.Internal.Generics.Generic a, GHC.Internal.Base.Monoid (GHC.Internal.Generics.Rep a ())) => GHC.Internal.Base.Monoid (GHC.Internal.Generics.Generically a) -- Defined in ‘GHC.Internal.Generics’
@@ -14414,7 +14414,6 @@ instance forall a b c d e. (GHC.Internal.Base.Semigroup a, GHC.Internal.Base.Sem
 instance GHC.Internal.Base.Semigroup () -- Defined in ‘GHC.Internal.Base’
 instance GHC.Internal.Base.Semigroup GHC.Internal.Base.Void -- Defined in ‘GHC.Internal.Base’
 instance forall a k (b :: k). GHC.Internal.Base.Semigroup a => GHC.Internal.Base.Semigroup (GHC.Internal.Data.Functor.Const.Const a b) -- Defined in ‘GHC.Internal.Data.Functor.Const’
-instance forall a. GHC.Internal.Base.Semigroup a => GHC.Internal.Base.Semigroup (GHC.Internal.Conc.Sync.STM a) -- Defined in ‘GHC.Internal.Conc.Sync’
 instance GHC.Internal.Base.Semigroup GHC.Internal.Exception.Context.ExceptionContext -- Defined in ‘GHC.Internal.Exception.Context’
 instance forall a s. GHC.Internal.Base.Semigroup a => GHC.Internal.Base.Semigroup (GHC.Internal.ST.ST s a) -- Defined in ‘GHC.Internal.ST’
 instance forall a s. GHC.Internal.Base.Semigroup a => GHC.Internal.Base.Semigroup (GHC.Internal.Control.Monad.ST.Lazy.Imp.ST s a) -- Defined in ‘GHC.Internal.Control.Monad.ST.Lazy.Imp’
@@ -14452,6 +14451,7 @@ instance forall a. GHC.Internal.Base.Semigroup (Data.Semigroup.Last a) -- Define
 instance forall a. GHC.Internal.Classes.Ord a => GHC.Internal.Base.Semigroup (Data.Semigroup.Max a) -- Defined in ‘Data.Semigroup’
 instance forall a. GHC.Internal.Classes.Ord a => GHC.Internal.Base.Semigroup (Data.Semigroup.Min a) -- Defined in ‘Data.Semigroup’
 instance forall m. GHC.Internal.Base.Monoid m => GHC.Internal.Base.Semigroup (Data.Semigroup.WrappedMonoid m) -- Defined in ‘Data.Semigroup’
+instance forall a. GHC.Internal.Base.Semigroup a => GHC.Internal.Base.Semigroup (GHC.Internal.STM.STM a) -- Defined in ‘GHC.Internal.STM’
 instance forall k (f :: k -> *) (p :: k) (g :: k -> *). (GHC.Internal.Base.Semigroup (f p), GHC.Internal.Base.Semigroup (g p)) => GHC.Internal.Base.Semigroup ((GHC.Internal.Generics.:*:) f g p) -- Defined in ‘GHC.Internal.Generics’
 instance forall k2 k1 (f :: k2 -> *) (g :: k1 -> k2) (p :: k1). GHC.Internal.Base.Semigroup (f (g p)) => GHC.Internal.Base.Semigroup ((GHC.Internal.Generics.:.:) f g p) -- Defined in ‘GHC.Internal.Generics’
 instance forall a. (GHC.Internal.Generics.Generic a, GHC.Internal.Base.Semigroup (GHC.Internal.Generics.Rep a ())) => GHC.Internal.Base.Semigroup (GHC.Internal.Generics.Generically a) -- Defined in ‘GHC.Internal.Generics’
@@ -14550,7 +14550,6 @@ instance forall a. GHC.Internal.Classes.Eq a => GHC.Internal.Classes.Eq (GHC.Int
 instance forall a. GHC.Internal.Classes.Eq (Control.Concurrent.Chan.Chan a) -- Defined in ‘Control.Concurrent.Chan’
 instance forall a. GHC.Internal.Classes.Eq (GHC.Internal.MVar.MVar a) -- Defined in ‘GHC.Internal.MVar’
 instance GHC.Internal.Classes.Eq GHC.Internal.Conc.Sync.BlockReason -- Defined in ‘GHC.Internal.Conc.Sync’
-instance forall a. GHC.Internal.Classes.Eq (GHC.Internal.Conc.Sync.TVar a) -- Defined in ‘GHC.Internal.Conc.Sync’
 instance GHC.Internal.Classes.Eq GHC.Internal.Conc.Sync.ThreadId -- Defined in ‘GHC.Internal.Conc.Sync’
 instance GHC.Internal.Classes.Eq GHC.Internal.Conc.Sync.ThreadStatus -- Defined in ‘GHC.Internal.Conc.Sync’
 instance GHC.Internal.Classes.Eq GHC.Internal.IO.Exception.ArrayException -- Defined in ‘GHC.Internal.IO.Exception’
@@ -14680,6 +14679,7 @@ instance forall a. GHC.Internal.Classes.Eq (GHC.Internal.Foreign.C.ConstPtr.Cons
 instance forall i e. (GHC.Internal.Ix.Ix i, GHC.Internal.Classes.Eq e) => GHC.Internal.Classes.Eq (GHC.Internal.Arr.Array i e) -- Defined in ‘GHC.Internal.Arr’
 instance forall s i e. GHC.Internal.Classes.Eq (GHC.Internal.Arr.STArray s i e) -- Defined in ‘GHC.Internal.Arr’
 instance GHC.Internal.Classes.Eq GHC.Internal.ByteOrder.ByteOrder -- Defined in ‘GHC.Internal.ByteOrder’
+instance forall a. GHC.Internal.Classes.Eq (GHC.Internal.STM.TVar a) -- Defined in ‘GHC.Internal.STM’
 instance GHC.Internal.Classes.Eq GHC.Internal.Event.TimeOut.TimeoutKey -- Defined in ‘GHC.Internal.Event.TimeOut’
 instance GHC.Internal.Classes.Eq GHC.Internal.Stack.Types.SrcLoc -- Defined in ‘GHC.Internal.Stack.Types’
 instance GHC.Internal.Classes.Eq GHC.Internal.Exts.SpecConstrAnnotation -- Defined in ‘GHC.Internal.Exts’


=====================================
testsuite/tests/interface-stability/base-exports.stdout-mingw32
=====================================
@@ -146,9 +146,9 @@ module Control.Concurrent where
   threadCapability :: ThreadId -> GHC.Internal.Types.IO (GHC.Internal.Types.Int, GHC.Internal.Types.Bool)
   threadDelay :: GHC.Internal.Types.Int -> GHC.Internal.Types.IO ()
   threadWaitRead :: GHC.Internal.System.Posix.Types.Fd -> GHC.Internal.Types.IO ()
-  threadWaitReadSTM :: GHC.Internal.System.Posix.Types.Fd -> GHC.Internal.Types.IO (GHC.Internal.Conc.Sync.STM (), GHC.Internal.Types.IO ())
+  threadWaitReadSTM :: GHC.Internal.System.Posix.Types.Fd -> GHC.Internal.Types.IO (GHC.Internal.STM.STM (), GHC.Internal.Types.IO ())
   threadWaitWrite :: GHC.Internal.System.Posix.Types.Fd -> GHC.Internal.Types.IO ()
-  threadWaitWriteSTM :: GHC.Internal.System.Posix.Types.Fd -> GHC.Internal.Types.IO (GHC.Internal.Conc.Sync.STM (), GHC.Internal.Types.IO ())
+  threadWaitWriteSTM :: GHC.Internal.System.Posix.Types.Fd -> GHC.Internal.Types.IO (GHC.Internal.STM.STM (), GHC.Internal.Types.IO ())
   throwTo :: forall e. GHC.Internal.Exception.Type.Exception e => ThreadId -> e -> GHC.Internal.Types.IO ()
   tryPutMVar :: forall a. MVar a -> a -> GHC.Internal.Types.IO GHC.Internal.Types.Bool
   tryReadMVar :: forall a. MVar a -> GHC.Internal.Types.IO (GHC.Internal.Maybe.Maybe a)
@@ -5121,7 +5121,7 @@ module GHC.Conc where
   threadWaitReadSTM :: GHC.Internal.System.Posix.Types.Fd -> GHC.Internal.Types.IO (STM (), GHC.Internal.Types.IO ())
   threadWaitWrite :: GHC.Internal.System.Posix.Types.Fd -> GHC.Internal.Types.IO ()
   threadWaitWriteSTM :: GHC.Internal.System.Posix.Types.Fd -> GHC.Internal.Types.IO (STM (), GHC.Internal.Types.IO ())
-  throwSTM :: forall e a. GHC.Internal.Exception.Type.Exception e => e -> STM a
+  throwSTM :: forall e a. (GHC.Internal.Stack.Types.HasCallStack, GHC.Internal.Exception.Type.Exception e) => e -> STM a
   throwTo :: forall e. GHC.Internal.Exception.Type.Exception e => ThreadId -> e -> GHC.Internal.Types.IO ()
   toWin32ConsoleEvent :: forall a. (GHC.Internal.Classes.Eq a, GHC.Internal.Num.Num a) => a -> GHC.Internal.Maybe.Maybe ConsoleEvent
   unsafeIOToSTM :: forall a. GHC.Internal.Types.IO a -> STM a
@@ -5213,7 +5213,7 @@ module GHC.Conc.Sync where
   threadCapability :: ThreadId -> GHC.Internal.Types.IO (GHC.Internal.Types.Int, GHC.Internal.Types.Bool)
   threadLabel :: ThreadId -> GHC.Internal.Types.IO (GHC.Internal.Maybe.Maybe GHC.Internal.Base.String)
   threadStatus :: ThreadId -> GHC.Internal.Types.IO ThreadStatus
-  throwSTM :: forall e a. GHC.Internal.Exception.Type.Exception e => e -> STM a
+  throwSTM :: forall e a. (GHC.Internal.Stack.Types.HasCallStack, GHC.Internal.Exception.Type.Exception e) => e -> STM a
   throwTo :: forall e. GHC.Internal.Exception.Type.Exception e => ThreadId -> e -> GHC.Internal.Types.IO ()
   unsafeIOToSTM :: forall a. GHC.Internal.Types.IO a -> STM a
   withMVar :: forall a b. GHC.Internal.MVar.MVar a -> (a -> GHC.Internal.Types.IO b) -> GHC.Internal.Types.IO b
@@ -5224,7 +5224,7 @@ module GHC.Conc.WinIO where
   -- Safety: None
   ensureIOManagerIsRunning :: GHC.Internal.Types.IO ()
   interruptIOManager :: GHC.Internal.Types.IO ()
-  registerDelay :: GHC.Internal.Types.Int -> GHC.Internal.Types.IO (GHC.Internal.Conc.Sync.TVar GHC.Internal.Types.Bool)
+  registerDelay :: GHC.Internal.Types.Int -> GHC.Internal.Types.IO (GHC.Internal.STM.TVar GHC.Internal.Types.Bool)
   threadDelay :: GHC.Internal.Types.Int -> GHC.Internal.Types.IO ()
 
 module GHC.Conc.Windows where
@@ -5238,7 +5238,7 @@ module GHC.Conc.Windows where
   asyncWriteBA :: GHC.Internal.Types.Int -> GHC.Internal.Types.Int -> GHC.Internal.Types.Int -> GHC.Internal.Types.Int -> GHC.Internal.Prim.MutableByteArray# GHC.Internal.Prim.RealWorld -> GHC.Internal.Types.IO (GHC.Internal.Types.Int, GHC.Internal.Types.Int)
   ensureIOManagerIsRunning :: GHC.Internal.Types.IO ()
   interruptIOManager :: GHC.Internal.Types.IO ()
-  registerDelay :: GHC.Internal.Types.Int -> GHC.Internal.Types.IO (GHC.Internal.Conc.Sync.TVar GHC.Internal.Types.Bool)
+  registerDelay :: GHC.Internal.Types.Int -> GHC.Internal.Types.IO (GHC.Internal.STM.TVar GHC.Internal.Types.Bool)
   start_console_handler :: GHC.Internal.Word.Word32 -> GHC.Internal.Types.IO ()
   threadDelay :: GHC.Internal.Types.Int -> GHC.Internal.Types.IO ()
   toWin32ConsoleEvent :: forall a. (GHC.Internal.Classes.Eq a, GHC.Internal.Num.Num a) => a -> GHC.Internal.Maybe.Maybe ConsoleEvent
@@ -5445,7 +5445,7 @@ module GHC.Event.Windows.Thread where
   -- Safety: None
   ensureIOManagerIsRunning :: GHC.Internal.Types.IO ()
   interruptIOManager :: GHC.Internal.Types.IO ()
-  registerDelay :: GHC.Internal.Types.Int -> GHC.Internal.Types.IO (GHC.Internal.Conc.Sync.TVar GHC.Internal.Types.Bool)
+  registerDelay :: GHC.Internal.Types.Int -> GHC.Internal.Types.IO (GHC.Internal.STM.TVar GHC.Internal.Types.Bool)
   threadDelay :: GHC.Internal.Types.Int -> GHC.Internal.Types.IO ()
 
 module GHC.Exception where
@@ -11379,12 +11379,12 @@ instance GHC.Internal.Base.Alternative GHC.Internal.Maybe.Maybe -- Defined in 
 instance GHC.Internal.Base.Alternative GHC.Internal.Functor.ZipList.ZipList -- Defined in ‘GHC.Internal.Functor.ZipList’
 instance forall (a :: * -> * -> *). GHC.Internal.Control.Arrow.ArrowPlus a => GHC.Internal.Base.Alternative (GHC.Internal.Control.Arrow.ArrowMonad a) -- Defined in ‘GHC.Internal.Control.Arrow’
 instance forall (m :: * -> *) a. GHC.Internal.Base.Alternative m => GHC.Internal.Base.Alternative (GHC.Internal.Control.Arrow.Kleisli m a) -- Defined in ‘GHC.Internal.Control.Arrow’
-instance GHC.Internal.Base.Alternative GHC.Internal.Conc.Sync.STM -- Defined in ‘GHC.Internal.Conc.Sync’
 instance GHC.Internal.Base.Alternative GHC.Internal.Data.Proxy.Proxy -- Defined in ‘GHC.Internal.Data.Proxy’
 instance forall (f :: * -> *) (g :: * -> *). (GHC.Internal.Base.Alternative f, GHC.Internal.Base.Applicative g) => GHC.Internal.Base.Alternative (Data.Functor.Compose.Compose f g) -- Defined in ‘Data.Functor.Compose’
 instance [safe] forall (f :: * -> *) (g :: * -> *). (GHC.Internal.Base.Alternative f, GHC.Internal.Base.Alternative g) => GHC.Internal.Base.Alternative (Data.Functor.Product.Product f g) -- Defined in ‘Data.Functor.Product’
 instance forall (f :: * -> *). GHC.Internal.Base.Alternative f => GHC.Internal.Base.Alternative (GHC.Internal.Data.Semigroup.Internal.Alt f) -- Defined in ‘GHC.Internal.Data.Semigroup.Internal’
 instance forall (f :: * -> *). GHC.Internal.Base.Alternative f => GHC.Internal.Base.Alternative (GHC.Internal.Data.Monoid.Ap f) -- Defined in ‘GHC.Internal.Data.Monoid’
+instance GHC.Internal.Base.Alternative GHC.Internal.STM.STM -- Defined in ‘GHC.Internal.STM’
 instance forall (f :: * -> *) (g :: * -> *). (GHC.Internal.Base.Alternative f, GHC.Internal.Base.Alternative g) => GHC.Internal.Base.Alternative (f GHC.Internal.Generics.:*: g) -- Defined in ‘GHC.Internal.Generics’
 instance forall (f :: * -> *) (g :: * -> *). (GHC.Internal.Base.Alternative f, GHC.Internal.Base.Applicative g) => GHC.Internal.Base.Alternative (f GHC.Internal.Generics.:.: g) -- Defined in ‘GHC.Internal.Generics’
 instance forall (f :: * -> *). (GHC.Internal.Generics.Generic1 f, GHC.Internal.Base.Alternative (GHC.Internal.Generics.Rep1 f)) => GHC.Internal.Base.Alternative (GHC.Internal.Generics.Generically1 f) -- Defined in ‘GHC.Internal.Generics’
@@ -11408,7 +11408,6 @@ instance forall m. GHC.Internal.Base.Monoid m => GHC.Internal.Base.Applicative (
 instance GHC.Internal.Base.Applicative GHC.Internal.Functor.ZipList.ZipList -- Defined in ‘GHC.Internal.Functor.ZipList’
 instance forall (a :: * -> * -> *). GHC.Internal.Control.Arrow.Arrow a => GHC.Internal.Base.Applicative (GHC.Internal.Control.Arrow.ArrowMonad a) -- Defined in ‘GHC.Internal.Control.Arrow’
 instance forall (m :: * -> *) a. GHC.Internal.Base.Applicative m => GHC.Internal.Base.Applicative (GHC.Internal.Control.Arrow.Kleisli m a) -- Defined in ‘GHC.Internal.Control.Arrow’
-instance GHC.Internal.Base.Applicative GHC.Internal.Conc.Sync.STM -- Defined in ‘GHC.Internal.Conc.Sync’
 instance forall s. GHC.Internal.Base.Applicative (GHC.Internal.ST.ST s) -- Defined in ‘GHC.Internal.ST’
 instance forall s. GHC.Internal.Base.Applicative (GHC.Internal.Control.Monad.ST.Lazy.Imp.ST s) -- Defined in ‘GHC.Internal.Control.Monad.ST.Lazy.Imp’
 instance GHC.Internal.Base.Applicative Data.Complex.Complex -- Defined in ‘Data.Complex’
@@ -11430,6 +11429,7 @@ instance GHC.Internal.Base.Applicative Data.Semigroup.First -- Defined in ‘Dat
 instance GHC.Internal.Base.Applicative Data.Semigroup.Last -- Defined in ‘Data.Semigroup’
 instance GHC.Internal.Base.Applicative Data.Semigroup.Max -- Defined in ‘Data.Semigroup’
 instance GHC.Internal.Base.Applicative Data.Semigroup.Min -- Defined in ‘Data.Semigroup’
+instance GHC.Internal.Base.Applicative GHC.Internal.STM.STM -- Defined in ‘GHC.Internal.STM’
 instance GHC.Internal.Base.Applicative GHC.Internal.GHCi.NoIO -- Defined in ‘GHC.Internal.GHCi’
 instance forall (f :: * -> *) (g :: * -> *). (GHC.Internal.Base.Applicative f, GHC.Internal.Base.Applicative g) => GHC.Internal.Base.Applicative (f GHC.Internal.Generics.:*: g) -- Defined in ‘GHC.Internal.Generics’
 instance forall (f :: * -> *) (g :: * -> *). (GHC.Internal.Base.Applicative f, GHC.Internal.Base.Applicative g) => GHC.Internal.Base.Applicative (f GHC.Internal.Generics.:.: g) -- Defined in ‘GHC.Internal.Generics’
@@ -11459,7 +11459,6 @@ instance forall m. GHC.Internal.Base.Functor (GHC.Internal.Data.Functor.Const.Co
 instance GHC.Internal.Base.Functor GHC.Internal.Functor.ZipList.ZipList -- Defined in ‘GHC.Internal.Functor.ZipList’
 instance forall (a :: * -> * -> *). GHC.Internal.Control.Arrow.Arrow a => GHC.Internal.Base.Functor (GHC.Internal.Control.Arrow.ArrowMonad a) -- Defined in ‘GHC.Internal.Control.Arrow’
 instance forall (m :: * -> *) a. GHC.Internal.Base.Functor m => GHC.Internal.Base.Functor (GHC.Internal.Control.Arrow.Kleisli m a) -- Defined in ‘GHC.Internal.Control.Arrow’
-instance GHC.Internal.Base.Functor GHC.Internal.Conc.Sync.STM -- Defined in ‘GHC.Internal.Conc.Sync’
 instance GHC.Internal.Base.Functor GHC.Internal.Control.Exception.Handler -- Defined in ‘GHC.Internal.Control.Exception’
 instance forall s. GHC.Internal.Base.Functor (GHC.Internal.ST.ST s) -- Defined in ‘GHC.Internal.ST’
 instance forall s. GHC.Internal.Base.Functor (GHC.Internal.Control.Monad.ST.Lazy.Imp.ST s) -- Defined in ‘GHC.Internal.Control.Monad.ST.Lazy.Imp’
@@ -11485,6 +11484,7 @@ instance GHC.Internal.Base.Functor Data.Semigroup.Last -- Defined in ‘Data.Sem
 instance GHC.Internal.Base.Functor Data.Semigroup.Max -- Defined in ‘Data.Semigroup’
 instance GHC.Internal.Base.Functor Data.Semigroup.Min -- Defined in ‘Data.Semigroup’
 instance forall i. GHC.Internal.Base.Functor (GHC.Internal.Arr.Array i) -- Defined in ‘GHC.Internal.Arr’
+instance GHC.Internal.Base.Functor GHC.Internal.STM.STM -- Defined in ‘GHC.Internal.STM’
 instance GHC.Internal.Base.Functor GHC.Internal.GHCi.NoIO -- Defined in ‘GHC.Internal.GHCi’
 instance forall (f :: * -> *) (g :: * -> *). (GHC.Internal.Base.Functor f, GHC.Internal.Base.Functor g) => GHC.Internal.Base.Functor (f GHC.Internal.Generics.:*: g) -- Defined in ‘GHC.Internal.Generics’
 instance forall (f :: * -> *) (g :: * -> *). (GHC.Internal.Base.Functor f, GHC.Internal.Base.Functor g) => GHC.Internal.Base.Functor (f GHC.Internal.Generics.:+: g) -- Defined in ‘GHC.Internal.Generics’
@@ -11519,7 +11519,6 @@ instance forall a b. (GHC.Internal.Base.Monoid a, GHC.Internal.Base.Monoid b) =>
 instance forall a b c. (GHC.Internal.Base.Monoid a, GHC.Internal.Base.Monoid b, GHC.Internal.Base.Monoid c) => GHC.Internal.Base.Monad ((,,,) a b c) -- Defined in ‘GHC.Internal.Base’
 instance forall (a :: * -> * -> *). GHC.Internal.Control.Arrow.ArrowApply a => GHC.Internal.Base.Monad (GHC.Internal.Control.Arrow.ArrowMonad a) -- Defined in ‘GHC.Internal.Control.Arrow’
 instance forall (m :: * -> *) a. GHC.Internal.Base.Monad m => GHC.Internal.Base.Monad (GHC.Internal.Control.Arrow.Kleisli m a) -- Defined in ‘GHC.Internal.Control.Arrow’
-instance GHC.Internal.Base.Monad GHC.Internal.Conc.Sync.STM -- Defined in ‘GHC.Internal.Conc.Sync’
 instance forall s. GHC.Internal.Base.Monad (GHC.Internal.ST.ST s) -- Defined in ‘GHC.Internal.ST’
 instance forall s. GHC.Internal.Base.Monad (GHC.Internal.Control.Monad.ST.Lazy.Imp.ST s) -- Defined in ‘GHC.Internal.Control.Monad.ST.Lazy.Imp’
 instance GHC.Internal.Base.Monad Data.Complex.Complex -- Defined in ‘Data.Complex’
@@ -11540,6 +11539,7 @@ instance GHC.Internal.Base.Monad Data.Semigroup.First -- Defined in ‘Data.Semi
 instance GHC.Internal.Base.Monad Data.Semigroup.Last -- Defined in ‘Data.Semigroup’
 instance GHC.Internal.Base.Monad Data.Semigroup.Max -- Defined in ‘Data.Semigroup’
 instance GHC.Internal.Base.Monad Data.Semigroup.Min -- Defined in ‘Data.Semigroup’
+instance GHC.Internal.Base.Monad GHC.Internal.STM.STM -- Defined in ‘GHC.Internal.STM’
 instance GHC.Internal.Base.Monad GHC.Internal.GHCi.NoIO -- Defined in ‘GHC.Internal.GHCi’
 instance forall (f :: * -> *) (g :: * -> *). (GHC.Internal.Base.Monad f, GHC.Internal.Base.Monad g) => GHC.Internal.Base.Monad (f GHC.Internal.Generics.:*: g) -- Defined in ‘GHC.Internal.Generics’
 instance forall (f :: * -> *) i (c :: GHC.Internal.Generics.Meta). GHC.Internal.Base.Monad f => GHC.Internal.Base.Monad (GHC.Internal.Generics.M1 i c f) -- Defined in ‘GHC.Internal.Generics’
@@ -11554,11 +11554,11 @@ instance GHC.Internal.Base.MonadPlus [] -- Defined in ‘GHC.Internal.Base’
 instance GHC.Internal.Base.MonadPlus GHC.Internal.Maybe.Maybe -- Defined in ‘GHC.Internal.Base’
 instance forall (a :: * -> * -> *). (GHC.Internal.Control.Arrow.ArrowApply a, GHC.Internal.Control.Arrow.ArrowPlus a) => GHC.Internal.Base.MonadPlus (GHC.Internal.Control.Arrow.ArrowMonad a) -- Defined in ‘GHC.Internal.Control.Arrow’
 instance forall (m :: * -> *) a. GHC.Internal.Base.MonadPlus m => GHC.Internal.Base.MonadPlus (GHC.Internal.Control.Arrow.Kleisli m a) -- Defined in ‘GHC.Internal.Control.Arrow’
-instance GHC.Internal.Base.MonadPlus GHC.Internal.Conc.Sync.STM -- Defined in ‘GHC.Internal.Conc.Sync’
 instance GHC.Internal.Base.MonadPlus GHC.Internal.Data.Proxy.Proxy -- Defined in ‘GHC.Internal.Data.Proxy’
 instance [safe] forall (f :: * -> *) (g :: * -> *). (GHC.Internal.Base.MonadPlus f, GHC.Internal.Base.MonadPlus g) => GHC.Internal.Base.MonadPlus (Data.Functor.Product.Product f g) -- Defined in ‘Data.Functor.Product’
 instance forall (f :: * -> *). GHC.Internal.Base.MonadPlus f => GHC.Internal.Base.MonadPlus (GHC.Internal.Data.Semigroup.Internal.Alt f) -- Defined in ‘GHC.Internal.Data.Semigroup.Internal’
 instance forall (f :: * -> *). GHC.Internal.Base.MonadPlus f => GHC.Internal.Base.MonadPlus (GHC.Internal.Data.Monoid.Ap f) -- Defined in ‘GHC.Internal.Data.Monoid’
+instance GHC.Internal.Base.MonadPlus GHC.Internal.STM.STM -- Defined in ‘GHC.Internal.STM’
 instance forall (f :: * -> *) (g :: * -> *). (GHC.Internal.Base.MonadPlus f, GHC.Internal.Base.MonadPlus g) => GHC.Internal.Base.MonadPlus (f GHC.Internal.Generics.:*: g) -- Defined in ‘GHC.Internal.Generics’
 instance forall (f :: * -> *) i (c :: GHC.Internal.Generics.Meta). GHC.Internal.Base.MonadPlus f => GHC.Internal.Base.MonadPlus (GHC.Internal.Generics.M1 i c f) -- Defined in ‘GHC.Internal.Generics’
 instance forall (f :: * -> *). GHC.Internal.Base.MonadPlus f => GHC.Internal.Base.MonadPlus (GHC.Internal.Generics.Rec1 f) -- Defined in ‘GHC.Internal.Generics’
@@ -11578,7 +11578,6 @@ instance forall a b c d. (GHC.Internal.Base.Monoid a, GHC.Internal.Base.Monoid b
 instance forall a b c d e. (GHC.Internal.Base.Monoid a, GHC.Internal.Base.Monoid b, GHC.Internal.Base.Monoid c, GHC.Internal.Base.Monoid d, GHC.Internal.Base.Monoid e) => GHC.Internal.Base.Monoid (a, b, c, d, e) -- Defined in ‘GHC.Internal.Base’
 instance GHC.Internal.Base.Monoid () -- Defined in ‘GHC.Internal.Base’
 instance forall a k (b :: k). GHC.Internal.Base.Monoid a => GHC.Internal.Base.Monoid (GHC.Internal.Data.Functor.Const.Const a b) -- Defined in ‘GHC.Internal.Data.Functor.Const’
-instance forall a. GHC.Internal.Base.Monoid a => GHC.Internal.Base.Monoid (GHC.Internal.Conc.Sync.STM a) -- Defined in ‘GHC.Internal.Conc.Sync’
 instance GHC.Internal.Base.Monoid GHC.Internal.Exception.Context.ExceptionContext -- Defined in ‘GHC.Internal.Exception.Context’
 instance forall a s. GHC.Internal.Base.Monoid a => GHC.Internal.Base.Monoid (GHC.Internal.ST.ST s a) -- Defined in ‘GHC.Internal.ST’
 instance forall a s. GHC.Internal.Base.Monoid a => GHC.Internal.Base.Monoid (GHC.Internal.Control.Monad.ST.Lazy.Imp.ST s a) -- Defined in ‘GHC.Internal.Control.Monad.ST.Lazy.Imp’
@@ -11609,6 +11608,7 @@ instance forall a. GHC.Internal.Base.Monoid a => GHC.Internal.Base.Monoid (GHC.I
 instance forall a. (GHC.Internal.Classes.Ord a, GHC.Internal.Enum.Bounded a) => GHC.Internal.Base.Monoid (Data.Semigroup.Max a) -- Defined in ‘Data.Semigroup’
 instance forall a. (GHC.Internal.Classes.Ord a, GHC.Internal.Enum.Bounded a) => GHC.Internal.Base.Monoid (Data.Semigroup.Min a) -- Defined in ‘Data.Semigroup’
 instance forall m. GHC.Internal.Base.Monoid m => GHC.Internal.Base.Monoid (Data.Semigroup.WrappedMonoid m) -- Defined in ‘Data.Semigroup’
+instance forall a. GHC.Internal.Base.Monoid a => GHC.Internal.Base.Monoid (GHC.Internal.STM.STM a) -- Defined in ‘GHC.Internal.STM’
 instance GHC.Internal.Base.Monoid GHC.Internal.Event.Windows.EventData -- Defined in ‘GHC.Internal.Event.Windows’
 instance forall k (f :: k -> *) (p :: k) (g :: k -> *). (GHC.Internal.Base.Monoid (f p), GHC.Internal.Base.Monoid (g p)) => GHC.Internal.Base.Monoid ((GHC.Internal.Generics.:*:) f g p) -- Defined in ‘GHC.Internal.Generics’
 instance forall k2 k1 (f :: k2 -> *) (g :: k1 -> k2) (p :: k1). GHC.Internal.Base.Monoid (f (g p)) => GHC.Internal.Base.Monoid ((GHC.Internal.Generics.:.:) f g p) -- Defined in ‘GHC.Internal.Generics’
@@ -11631,7 +11631,6 @@ instance forall a b c d e. (GHC.Internal.Base.Semigroup a, GHC.Internal.Base.Sem
 instance GHC.Internal.Base.Semigroup () -- Defined in ‘GHC.Internal.Base’
 instance GHC.Internal.Base.Semigroup GHC.Internal.Base.Void -- Defined in ‘GHC.Internal.Base’
 instance forall a k (b :: k). GHC.Internal.Base.Semigroup a => GHC.Internal.Base.Semigroup (GHC.Internal.Data.Functor.Const.Const a b) -- Defined in ‘GHC.Internal.Data.Functor.Const’
-instance forall a. GHC.Internal.Base.Semigroup a => GHC.Internal.Base.Semigroup (GHC.Internal.Conc.Sync.STM a) -- Defined in ‘GHC.Internal.Conc.Sync’
 instance GHC.Internal.Base.Semigroup GHC.Internal.Exception.Context.ExceptionContext -- Defined in ‘GHC.Internal.Exception.Context’
 instance forall a s. GHC.Internal.Base.Semigroup a => GHC.Internal.Base.Semigroup (GHC.Internal.ST.ST s a) -- Defined in ‘GHC.Internal.ST’
 instance forall a s. GHC.Internal.Base.Semigroup a => GHC.Internal.Base.Semigroup (GHC.Internal.Control.Monad.ST.Lazy.Imp.ST s a) -- Defined in ‘GHC.Internal.Control.Monad.ST.Lazy.Imp’
@@ -11669,6 +11668,7 @@ instance forall a. GHC.Internal.Base.Semigroup (Data.Semigroup.Last a) -- Define
 instance forall a. GHC.Internal.Classes.Ord a => GHC.Internal.Base.Semigroup (Data.Semigroup.Max a) -- Defined in ‘Data.Semigroup’
 instance forall a. GHC.Internal.Classes.Ord a => GHC.Internal.Base.Semigroup (Data.Semigroup.Min a) -- Defined in ‘Data.Semigroup’
 instance forall m. GHC.Internal.Base.Monoid m => GHC.Internal.Base.Semigroup (Data.Semigroup.WrappedMonoid m) -- Defined in ‘Data.Semigroup’
+instance forall a. GHC.Internal.Base.Semigroup a => GHC.Internal.Base.Semigroup (GHC.Internal.STM.STM a) -- Defined in ‘GHC.Internal.STM’
 instance GHC.Internal.Base.Semigroup GHC.Internal.Event.Windows.EventData -- Defined in ‘GHC.Internal.Event.Windows’
 instance forall k (f :: k -> *) (p :: k) (g :: k -> *). (GHC.Internal.Base.Semigroup (f p), GHC.Internal.Base.Semigroup (g p)) => GHC.Internal.Base.Semigroup ((GHC.Internal.Generics.:*:) f g p) -- Defined in ‘GHC.Internal.Generics’
 instance forall k2 k1 (f :: k2 -> *) (g :: k1 -> k2) (p :: k1). GHC.Internal.Base.Semigroup (f (g p)) => GHC.Internal.Base.Semigroup ((GHC.Internal.Generics.:.:) f g p) -- Defined in ‘GHC.Internal.Generics’
@@ -11768,7 +11768,6 @@ instance forall a. GHC.Internal.Classes.Eq a => GHC.Internal.Classes.Eq (GHC.Int
 instance forall a. GHC.Internal.Classes.Eq (Control.Concurrent.Chan.Chan a) -- Defined in ‘Control.Concurrent.Chan’
 instance forall a. GHC.Internal.Classes.Eq (GHC.Internal.MVar.MVar a) -- Defined in ‘GHC.Internal.MVar’
 instance GHC.Internal.Classes.Eq GHC.Internal.Conc.Sync.BlockReason -- Defined in ‘GHC.Internal.Conc.Sync’
-instance forall a. GHC.Internal.Classes.Eq (GHC.Internal.Conc.Sync.TVar a) -- Defined in ‘GHC.Internal.Conc.Sync’
 instance GHC.Internal.Classes.Eq GHC.Internal.Conc.Sync.ThreadId -- Defined in ‘GHC.Internal.Conc.Sync’
 instance GHC.Internal.Classes.Eq GHC.Internal.Conc.Sync.ThreadStatus -- Defined in ‘GHC.Internal.Conc.Sync’
 instance GHC.Internal.Classes.Eq GHC.Internal.IO.Exception.ArrayException -- Defined in ‘GHC.Internal.IO.Exception’
@@ -11899,6 +11898,7 @@ instance forall i e. (GHC.Internal.Ix.Ix i, GHC.Internal.Classes.Eq e) => GHC.In
 instance forall s i e. GHC.Internal.Classes.Eq (GHC.Internal.Arr.STArray s i e) -- Defined in ‘GHC.Internal.Arr’
 instance GHC.Internal.Classes.Eq GHC.Internal.ByteOrder.ByteOrder -- Defined in ‘GHC.Internal.ByteOrder’
 instance GHC.Internal.Classes.Eq GHC.Internal.Event.Windows.ConsoleEvent.ConsoleEvent -- Defined in ‘GHC.Internal.Event.Windows.ConsoleEvent’
+instance forall a. GHC.Internal.Classes.Eq (GHC.Internal.STM.TVar a) -- Defined in ‘GHC.Internal.STM’
 instance GHC.Internal.Classes.Eq GHC.Internal.Event.TimeOut.TimeoutKey -- Defined in ‘GHC.Internal.Event.TimeOut’
 instance GHC.Internal.Classes.Eq GHC.Internal.Event.Windows.HandleKey -- Defined in ‘GHC.Internal.Event.Windows’
 instance GHC.Internal.Classes.Eq GHC.Internal.Event.Windows.FFI.IOCP -- Defined in ‘GHC.Internal.Event.Windows.FFI’


=====================================
testsuite/tests/interface-stability/base-exports.stdout-ws-32
=====================================
@@ -146,9 +146,9 @@ module Control.Concurrent where
   threadCapability :: ThreadId -> GHC.Internal.Types.IO (GHC.Internal.Types.Int, GHC.Internal.Types.Bool)
   threadDelay :: GHC.Internal.Types.Int -> GHC.Internal.Types.IO ()
   threadWaitRead :: GHC.Internal.System.Posix.Types.Fd -> GHC.Internal.Types.IO ()
-  threadWaitReadSTM :: GHC.Internal.System.Posix.Types.Fd -> GHC.Internal.Types.IO (GHC.Internal.Conc.Sync.STM (), GHC.Internal.Types.IO ())
+  threadWaitReadSTM :: GHC.Internal.System.Posix.Types.Fd -> GHC.Internal.Types.IO (GHC.Internal.STM.STM (), GHC.Internal.Types.IO ())
   threadWaitWrite :: GHC.Internal.System.Posix.Types.Fd -> GHC.Internal.Types.IO ()
-  threadWaitWriteSTM :: GHC.Internal.System.Posix.Types.Fd -> GHC.Internal.Types.IO (GHC.Internal.Conc.Sync.STM (), GHC.Internal.Types.IO ())
+  threadWaitWriteSTM :: GHC.Internal.System.Posix.Types.Fd -> GHC.Internal.Types.IO (GHC.Internal.STM.STM (), GHC.Internal.Types.IO ())
   throwTo :: forall e. GHC.Internal.Exception.Type.Exception e => ThreadId -> e -> GHC.Internal.Types.IO ()
   tryPutMVar :: forall a. MVar a -> a -> GHC.Internal.Types.IO GHC.Internal.Types.Bool
   tryReadMVar :: forall a. MVar a -> GHC.Internal.Types.IO (GHC.Internal.Maybe.Maybe a)
@@ -5117,7 +5117,7 @@ module GHC.Conc where
   threadWaitReadSTM :: GHC.Internal.System.Posix.Types.Fd -> GHC.Internal.Types.IO (STM (), GHC.Internal.Types.IO ())
   threadWaitWrite :: GHC.Internal.System.Posix.Types.Fd -> GHC.Internal.Types.IO ()
   threadWaitWriteSTM :: GHC.Internal.System.Posix.Types.Fd -> GHC.Internal.Types.IO (STM (), GHC.Internal.Types.IO ())
-  throwSTM :: forall e a. GHC.Internal.Exception.Type.Exception e => e -> STM a
+  throwSTM :: forall e a. (GHC.Internal.Stack.Types.HasCallStack, GHC.Internal.Exception.Type.Exception e) => e -> STM a
   throwTo :: forall e. GHC.Internal.Exception.Type.Exception e => ThreadId -> e -> GHC.Internal.Types.IO ()
   unsafeIOToSTM :: forall a. GHC.Internal.Types.IO a -> STM a
   withMVar :: forall a b. GHC.Internal.MVar.MVar a -> (a -> GHC.Internal.Types.IO b) -> GHC.Internal.Types.IO b
@@ -5197,7 +5197,7 @@ module GHC.Conc.Sync where
   threadCapability :: ThreadId -> GHC.Internal.Types.IO (GHC.Internal.Types.Int, GHC.Internal.Types.Bool)
   threadLabel :: ThreadId -> GHC.Internal.Types.IO (GHC.Internal.Maybe.Maybe GHC.Internal.Base.String)
   threadStatus :: ThreadId -> GHC.Internal.Types.IO ThreadStatus
-  throwSTM :: forall e a. GHC.Internal.Exception.Type.Exception e => e -> STM a
+  throwSTM :: forall e a. (GHC.Internal.Stack.Types.HasCallStack, GHC.Internal.Exception.Type.Exception e) => e -> STM a
   throwTo :: forall e. GHC.Internal.Exception.Type.Exception e => ThreadId -> e -> GHC.Internal.Types.IO ()
   unsafeIOToSTM :: forall a. GHC.Internal.Types.IO a -> STM a
   withMVar :: forall a b. GHC.Internal.MVar.MVar a -> (a -> GHC.Internal.Types.IO b) -> GHC.Internal.Types.IO b
@@ -11117,12 +11117,12 @@ instance GHC.Internal.Base.Alternative GHC.Internal.Maybe.Maybe -- Defined in 
 instance GHC.Internal.Base.Alternative GHC.Internal.Functor.ZipList.ZipList -- Defined in ‘GHC.Internal.Functor.ZipList’
 instance forall (a :: * -> * -> *). GHC.Internal.Control.Arrow.ArrowPlus a => GHC.Internal.Base.Alternative (GHC.Internal.Control.Arrow.ArrowMonad a) -- Defined in ‘GHC.Internal.Control.Arrow’
 instance forall (m :: * -> *) a. GHC.Internal.Base.Alternative m => GHC.Internal.Base.Alternative (GHC.Internal.Control.Arrow.Kleisli m a) -- Defined in ‘GHC.Internal.Control.Arrow’
-instance GHC.Internal.Base.Alternative GHC.Internal.Conc.Sync.STM -- Defined in ‘GHC.Internal.Conc.Sync’
 instance GHC.Internal.Base.Alternative GHC.Internal.Data.Proxy.Proxy -- Defined in ‘GHC.Internal.Data.Proxy’
 instance forall (f :: * -> *) (g :: * -> *). (GHC.Internal.Base.Alternative f, GHC.Internal.Base.Applicative g) => GHC.Internal.Base.Alternative (Data.Functor.Compose.Compose f g) -- Defined in ‘Data.Functor.Compose’
 instance [safe] forall (f :: * -> *) (g :: * -> *). (GHC.Internal.Base.Alternative f, GHC.Internal.Base.Alternative g) => GHC.Internal.Base.Alternative (Data.Functor.Product.Product f g) -- Defined in ‘Data.Functor.Product’
 instance forall (f :: * -> *). GHC.Internal.Base.Alternative f => GHC.Internal.Base.Alternative (GHC.Internal.Data.Semigroup.Internal.Alt f) -- Defined in ‘GHC.Internal.Data.Semigroup.Internal’
 instance forall (f :: * -> *). GHC.Internal.Base.Alternative f => GHC.Internal.Base.Alternative (GHC.Internal.Data.Monoid.Ap f) -- Defined in ‘GHC.Internal.Data.Monoid’
+instance GHC.Internal.Base.Alternative GHC.Internal.STM.STM -- Defined in ‘GHC.Internal.STM’
 instance forall (f :: * -> *) (g :: * -> *). (GHC.Internal.Base.Alternative f, GHC.Internal.Base.Alternative g) => GHC.Internal.Base.Alternative (f GHC.Internal.Generics.:*: g) -- Defined in ‘GHC.Internal.Generics’
 instance forall (f :: * -> *) (g :: * -> *). (GHC.Internal.Base.Alternative f, GHC.Internal.Base.Applicative g) => GHC.Internal.Base.Alternative (f GHC.Internal.Generics.:.: g) -- Defined in ‘GHC.Internal.Generics’
 instance forall (f :: * -> *). (GHC.Internal.Generics.Generic1 f, GHC.Internal.Base.Alternative (GHC.Internal.Generics.Rep1 f)) => GHC.Internal.Base.Alternative (GHC.Internal.Generics.Generically1 f) -- Defined in ‘GHC.Internal.Generics’
@@ -11146,7 +11146,6 @@ instance forall m. GHC.Internal.Base.Monoid m => GHC.Internal.Base.Applicative (
 instance GHC.Internal.Base.Applicative GHC.Internal.Functor.ZipList.ZipList -- Defined in ‘GHC.Internal.Functor.ZipList’
 instance forall (a :: * -> * -> *). GHC.Internal.Control.Arrow.Arrow a => GHC.Internal.Base.Applicative (GHC.Internal.Control.Arrow.ArrowMonad a) -- Defined in ‘GHC.Internal.Control.Arrow’
 instance forall (m :: * -> *) a. GHC.Internal.Base.Applicative m => GHC.Internal.Base.Applicative (GHC.Internal.Control.Arrow.Kleisli m a) -- Defined in ‘GHC.Internal.Control.Arrow’
-instance GHC.Internal.Base.Applicative GHC.Internal.Conc.Sync.STM -- Defined in ‘GHC.Internal.Conc.Sync’
 instance forall s. GHC.Internal.Base.Applicative (GHC.Internal.ST.ST s) -- Defined in ‘GHC.Internal.ST’
 instance forall s. GHC.Internal.Base.Applicative (GHC.Internal.Control.Monad.ST.Lazy.Imp.ST s) -- Defined in ‘GHC.Internal.Control.Monad.ST.Lazy.Imp’
 instance GHC.Internal.Base.Applicative Data.Complex.Complex -- Defined in ‘Data.Complex’
@@ -11168,6 +11167,7 @@ instance GHC.Internal.Base.Applicative Data.Semigroup.First -- Defined in ‘Dat
 instance GHC.Internal.Base.Applicative Data.Semigroup.Last -- Defined in ‘Data.Semigroup’
 instance GHC.Internal.Base.Applicative Data.Semigroup.Max -- Defined in ‘Data.Semigroup’
 instance GHC.Internal.Base.Applicative Data.Semigroup.Min -- Defined in ‘Data.Semigroup’
+instance GHC.Internal.Base.Applicative GHC.Internal.STM.STM -- Defined in ‘GHC.Internal.STM’
 instance GHC.Internal.Base.Applicative GHC.Internal.GHCi.NoIO -- Defined in ‘GHC.Internal.GHCi’
 instance forall (f :: * -> *) (g :: * -> *). (GHC.Internal.Base.Applicative f, GHC.Internal.Base.Applicative g) => GHC.Internal.Base.Applicative (f GHC.Internal.Generics.:*: g) -- Defined in ‘GHC.Internal.Generics’
 instance forall (f :: * -> *) (g :: * -> *). (GHC.Internal.Base.Applicative f, GHC.Internal.Base.Applicative g) => GHC.Internal.Base.Applicative (f GHC.Internal.Generics.:.: g) -- Defined in ‘GHC.Internal.Generics’
@@ -11197,7 +11197,6 @@ instance forall m. GHC.Internal.Base.Functor (GHC.Internal.Data.Functor.Const.Co
 instance GHC.Internal.Base.Functor GHC.Internal.Functor.ZipList.ZipList -- Defined in ‘GHC.Internal.Functor.ZipList’
 instance forall (a :: * -> * -> *). GHC.Internal.Control.Arrow.Arrow a => GHC.Internal.Base.Functor (GHC.Internal.Control.Arrow.ArrowMonad a) -- Defined in ‘GHC.Internal.Control.Arrow’
 instance forall (m :: * -> *) a. GHC.Internal.Base.Functor m => GHC.Internal.Base.Functor (GHC.Internal.Control.Arrow.Kleisli m a) -- Defined in ‘GHC.Internal.Control.Arrow’
-instance GHC.Internal.Base.Functor GHC.Internal.Conc.Sync.STM -- Defined in ‘GHC.Internal.Conc.Sync’
 instance GHC.Internal.Base.Functor GHC.Internal.Control.Exception.Handler -- Defined in ‘GHC.Internal.Control.Exception’
 instance forall s. GHC.Internal.Base.Functor (GHC.Internal.ST.ST s) -- Defined in ‘GHC.Internal.ST’
 instance forall s. GHC.Internal.Base.Functor (GHC.Internal.Control.Monad.ST.Lazy.Imp.ST s) -- Defined in ‘GHC.Internal.Control.Monad.ST.Lazy.Imp’
@@ -11223,6 +11222,7 @@ instance GHC.Internal.Base.Functor Data.Semigroup.Last -- Defined in ‘Data.Sem
 instance GHC.Internal.Base.Functor Data.Semigroup.Max -- Defined in ‘Data.Semigroup’
 instance GHC.Internal.Base.Functor Data.Semigroup.Min -- Defined in ‘Data.Semigroup’
 instance forall i. GHC.Internal.Base.Functor (GHC.Internal.Arr.Array i) -- Defined in ‘GHC.Internal.Arr’
+instance GHC.Internal.Base.Functor GHC.Internal.STM.STM -- Defined in ‘GHC.Internal.STM’
 instance GHC.Internal.Base.Functor GHC.Internal.GHCi.NoIO -- Defined in ‘GHC.Internal.GHCi’
 instance forall (f :: * -> *) (g :: * -> *). (GHC.Internal.Base.Functor f, GHC.Internal.Base.Functor g) => GHC.Internal.Base.Functor (f GHC.Internal.Generics.:*: g) -- Defined in ‘GHC.Internal.Generics’
 instance forall (f :: * -> *) (g :: * -> *). (GHC.Internal.Base.Functor f, GHC.Internal.Base.Functor g) => GHC.Internal.Base.Functor (f GHC.Internal.Generics.:+: g) -- Defined in ‘GHC.Internal.Generics’
@@ -11257,7 +11257,6 @@ instance forall a b. (GHC.Internal.Base.Monoid a, GHC.Internal.Base.Monoid b) =>
 instance forall a b c. (GHC.Internal.Base.Monoid a, GHC.Internal.Base.Monoid b, GHC.Internal.Base.Monoid c) => GHC.Internal.Base.Monad ((,,,) a b c) -- Defined in ‘GHC.Internal.Base’
 instance forall (a :: * -> * -> *). GHC.Internal.Control.Arrow.ArrowApply a => GHC.Internal.Base.Monad (GHC.Internal.Control.Arrow.ArrowMonad a) -- Defined in ‘GHC.Internal.Control.Arrow’
 instance forall (m :: * -> *) a. GHC.Internal.Base.Monad m => GHC.Internal.Base.Monad (GHC.Internal.Control.Arrow.Kleisli m a) -- Defined in ‘GHC.Internal.Control.Arrow’
-instance GHC.Internal.Base.Monad GHC.Internal.Conc.Sync.STM -- Defined in ‘GHC.Internal.Conc.Sync’
 instance forall s. GHC.Internal.Base.Monad (GHC.Internal.ST.ST s) -- Defined in ‘GHC.Internal.ST’
 instance forall s. GHC.Internal.Base.Monad (GHC.Internal.Control.Monad.ST.Lazy.Imp.ST s) -- Defined in ‘GHC.Internal.Control.Monad.ST.Lazy.Imp’
 instance GHC.Internal.Base.Monad Data.Complex.Complex -- Defined in ‘Data.Complex’
@@ -11278,6 +11277,7 @@ instance GHC.Internal.Base.Monad Data.Semigroup.First -- Defined in ‘Data.Semi
 instance GHC.Internal.Base.Monad Data.Semigroup.Last -- Defined in ‘Data.Semigroup’
 instance GHC.Internal.Base.Monad Data.Semigroup.Max -- Defined in ‘Data.Semigroup’
 instance GHC.Internal.Base.Monad Data.Semigroup.Min -- Defined in ‘Data.Semigroup’
+instance GHC.Internal.Base.Monad GHC.Internal.STM.STM -- Defined in ‘GHC.Internal.STM’
 instance GHC.Internal.Base.Monad GHC.Internal.GHCi.NoIO -- Defined in ‘GHC.Internal.GHCi’
 instance forall (f :: * -> *) (g :: * -> *). (GHC.Internal.Base.Monad f, GHC.Internal.Base.Monad g) => GHC.Internal.Base.Monad (f GHC.Internal.Generics.:*: g) -- Defined in ‘GHC.Internal.Generics’
 instance forall (f :: * -> *) i (c :: GHC.Internal.Generics.Meta). GHC.Internal.Base.Monad f => GHC.Internal.Base.Monad (GHC.Internal.Generics.M1 i c f) -- Defined in ‘GHC.Internal.Generics’
@@ -11292,11 +11292,11 @@ instance GHC.Internal.Base.MonadPlus [] -- Defined in ‘GHC.Internal.Base’
 instance GHC.Internal.Base.MonadPlus GHC.Internal.Maybe.Maybe -- Defined in ‘GHC.Internal.Base’
 instance forall (a :: * -> * -> *). (GHC.Internal.Control.Arrow.ArrowApply a, GHC.Internal.Control.Arrow.ArrowPlus a) => GHC.Internal.Base.MonadPlus (GHC.Internal.Control.Arrow.ArrowMonad a) -- Defined in ‘GHC.Internal.Control.Arrow’
 instance forall (m :: * -> *) a. GHC.Internal.Base.MonadPlus m => GHC.Internal.Base.MonadPlus (GHC.Internal.Control.Arrow.Kleisli m a) -- Defined in ‘GHC.Internal.Control.Arrow’
-instance GHC.Internal.Base.MonadPlus GHC.Internal.Conc.Sync.STM -- Defined in ‘GHC.Internal.Conc.Sync’
 instance GHC.Internal.Base.MonadPlus GHC.Internal.Data.Proxy.Proxy -- Defined in ‘GHC.Internal.Data.Proxy’
 instance [safe] forall (f :: * -> *) (g :: * -> *). (GHC.Internal.Base.MonadPlus f, GHC.Internal.Base.MonadPlus g) => GHC.Internal.Base.MonadPlus (Data.Functor.Product.Product f g) -- Defined in ‘Data.Functor.Product’
 instance forall (f :: * -> *). GHC.Internal.Base.MonadPlus f => GHC.Internal.Base.MonadPlus (GHC.Internal.Data.Semigroup.Internal.Alt f) -- Defined in ‘GHC.Internal.Data.Semigroup.Internal’
 instance forall (f :: * -> *). GHC.Internal.Base.MonadPlus f => GHC.Internal.Base.MonadPlus (GHC.Internal.Data.Monoid.Ap f) -- Defined in ‘GHC.Internal.Data.Monoid’
+instance GHC.Internal.Base.MonadPlus GHC.Internal.STM.STM -- Defined in ‘GHC.Internal.STM’
 instance forall (f :: * -> *) (g :: * -> *). (GHC.Internal.Base.MonadPlus f, GHC.Internal.Base.MonadPlus g) => GHC.Internal.Base.MonadPlus (f GHC.Internal.Generics.:*: g) -- Defined in ‘GHC.Internal.Generics’
 instance forall (f :: * -> *) i (c :: GHC.Internal.Generics.Meta). GHC.Internal.Base.MonadPlus f => GHC.Internal.Base.MonadPlus (GHC.Internal.Generics.M1 i c f) -- Defined in ‘GHC.Internal.Generics’
 instance forall (f :: * -> *). GHC.Internal.Base.MonadPlus f => GHC.Internal.Base.MonadPlus (GHC.Internal.Generics.Rec1 f) -- Defined in ‘GHC.Internal.Generics’
@@ -11316,7 +11316,6 @@ instance forall a b c d. (GHC.Internal.Base.Monoid a, GHC.Internal.Base.Monoid b
 instance forall a b c d e. (GHC.Internal.Base.Monoid a, GHC.Internal.Base.Monoid b, GHC.Internal.Base.Monoid c, GHC.Internal.Base.Monoid d, GHC.Internal.Base.Monoid e) => GHC.Internal.Base.Monoid (a, b, c, d, e) -- Defined in ‘GHC.Internal.Base’
 instance GHC.Internal.Base.Monoid () -- Defined in ‘GHC.Internal.Base’
 instance forall a k (b :: k). GHC.Internal.Base.Monoid a => GHC.Internal.Base.Monoid (GHC.Internal.Data.Functor.Const.Const a b) -- Defined in ‘GHC.Internal.Data.Functor.Const’
-instance forall a. GHC.Internal.Base.Monoid a => GHC.Internal.Base.Monoid (GHC.Internal.Conc.Sync.STM a) -- Defined in ‘GHC.Internal.Conc.Sync’
 instance GHC.Internal.Base.Monoid GHC.Internal.Exception.Context.ExceptionContext -- Defined in ‘GHC.Internal.Exception.Context’
 instance forall a s. GHC.Internal.Base.Monoid a => GHC.Internal.Base.Monoid (GHC.Internal.ST.ST s a) -- Defined in ‘GHC.Internal.ST’
 instance forall a s. GHC.Internal.Base.Monoid a => GHC.Internal.Base.Monoid (GHC.Internal.Control.Monad.ST.Lazy.Imp.ST s a) -- Defined in ‘GHC.Internal.Control.Monad.ST.Lazy.Imp’
@@ -11347,6 +11346,7 @@ instance forall a. GHC.Internal.Base.Monoid a => GHC.Internal.Base.Monoid (GHC.I
 instance forall a. (GHC.Internal.Classes.Ord a, GHC.Internal.Enum.Bounded a) => GHC.Internal.Base.Monoid (Data.Semigroup.Max a) -- Defined in ‘Data.Semigroup’
 instance forall a. (GHC.Internal.Classes.Ord a, GHC.Internal.Enum.Bounded a) => GHC.Internal.Base.Monoid (Data.Semigroup.Min a) -- Defined in ‘Data.Semigroup’
 instance forall m. GHC.Internal.Base.Monoid m => GHC.Internal.Base.Monoid (Data.Semigroup.WrappedMonoid m) -- Defined in ‘Data.Semigroup’
+instance forall a. GHC.Internal.Base.Monoid a => GHC.Internal.Base.Monoid (GHC.Internal.STM.STM a) -- Defined in ‘GHC.Internal.STM’
 instance GHC.Internal.Base.Monoid ghc-internal-9.1500.0:GHC.Internal.Event.Internal.Types.Event -- Defined in ‘ghc-internal-9.1500.0:GHC.Internal.Event.Internal.Types’
 instance GHC.Internal.Base.Monoid ghc-internal-9.1500.0:GHC.Internal.Event.Internal.Types.EventLifetime -- Defined in ‘ghc-internal-9.1500.0:GHC.Internal.Event.Internal.Types’
 instance GHC.Internal.Base.Monoid ghc-internal-9.1500.0:GHC.Internal.Event.Internal.Types.Lifetime -- Defined in ‘ghc-internal-9.1500.0:GHC.Internal.Event.Internal.Types’
@@ -11371,7 +11371,6 @@ instance forall a b c d e. (GHC.Internal.Base.Semigroup a, GHC.Internal.Base.Sem
 instance GHC.Internal.Base.Semigroup () -- Defined in ‘GHC.Internal.Base’
 instance GHC.Internal.Base.Semigroup GHC.Internal.Base.Void -- Defined in ‘GHC.Internal.Base’
 instance forall a k (b :: k). GHC.Internal.Base.Semigroup a => GHC.Internal.Base.Semigroup (GHC.Internal.Data.Functor.Const.Const a b) -- Defined in ‘GHC.Internal.Data.Functor.Const’
-instance forall a. GHC.Internal.Base.Semigroup a => GHC.Internal.Base.Semigroup (GHC.Internal.Conc.Sync.STM a) -- Defined in ‘GHC.Internal.Conc.Sync’
 instance GHC.Internal.Base.Semigroup GHC.Internal.Exception.Context.ExceptionContext -- Defined in ‘GHC.Internal.Exception.Context’
 instance forall a s. GHC.Internal.Base.Semigroup a => GHC.Internal.Base.Semigroup (GHC.Internal.ST.ST s a) -- Defined in ‘GHC.Internal.ST’
 instance forall a s. GHC.Internal.Base.Semigroup a => GHC.Internal.Base.Semigroup (GHC.Internal.Control.Monad.ST.Lazy.Imp.ST s a) -- Defined in ‘GHC.Internal.Control.Monad.ST.Lazy.Imp’
@@ -11409,6 +11408,7 @@ instance forall a. GHC.Internal.Base.Semigroup (Data.Semigroup.Last a) -- Define
 instance forall a. GHC.Internal.Classes.Ord a => GHC.Internal.Base.Semigroup (Data.Semigroup.Max a) -- Defined in ‘Data.Semigroup’
 instance forall a. GHC.Internal.Classes.Ord a => GHC.Internal.Base.Semigroup (Data.Semigroup.Min a) -- Defined in ‘Data.Semigroup’
 instance forall m. GHC.Internal.Base.Monoid m => GHC.Internal.Base.Semigroup (Data.Semigroup.WrappedMonoid m) -- Defined in ‘Data.Semigroup’
+instance forall a. GHC.Internal.Base.Semigroup a => GHC.Internal.Base.Semigroup (GHC.Internal.STM.STM a) -- Defined in ‘GHC.Internal.STM’
 instance GHC.Internal.Base.Semigroup ghc-internal-9.1500.0:GHC.Internal.Event.Internal.Types.Event -- Defined in ‘ghc-internal-9.1500.0:GHC.Internal.Event.Internal.Types’
 instance GHC.Internal.Base.Semigroup ghc-internal-9.1500.0:GHC.Internal.Event.Internal.Types.EventLifetime -- Defined in ‘ghc-internal-9.1500.0:GHC.Internal.Event.Internal.Types’
 instance GHC.Internal.Base.Semigroup ghc-internal-9.1500.0:GHC.Internal.Event.Internal.Types.Lifetime -- Defined in ‘ghc-internal-9.1500.0:GHC.Internal.Event.Internal.Types’
@@ -11510,7 +11510,6 @@ instance forall a. GHC.Internal.Classes.Eq a => GHC.Internal.Classes.Eq (GHC.Int
 instance forall a. GHC.Internal.Classes.Eq (Control.Concurrent.Chan.Chan a) -- Defined in ‘Control.Concurrent.Chan’
 instance forall a. GHC.Internal.Classes.Eq (GHC.Internal.MVar.MVar a) -- Defined in ‘GHC.Internal.MVar’
 instance GHC.Internal.Classes.Eq GHC.Internal.Conc.Sync.BlockReason -- Defined in ‘GHC.Internal.Conc.Sync’
-instance forall a. GHC.Internal.Classes.Eq (GHC.Internal.Conc.Sync.TVar a) -- Defined in ‘GHC.Internal.Conc.Sync’
 instance GHC.Internal.Classes.Eq GHC.Internal.Conc.Sync.ThreadId -- Defined in ‘GHC.Internal.Conc.Sync’
 instance GHC.Internal.Classes.Eq GHC.Internal.Conc.Sync.ThreadStatus -- Defined in ‘GHC.Internal.Conc.Sync’
 instance GHC.Internal.Classes.Eq GHC.Internal.IO.Exception.ArrayException -- Defined in ‘GHC.Internal.IO.Exception’
@@ -11640,6 +11639,7 @@ instance forall a. GHC.Internal.Classes.Eq (GHC.Internal.Foreign.C.ConstPtr.Cons
 instance forall i e. (GHC.Internal.Ix.Ix i, GHC.Internal.Classes.Eq e) => GHC.Internal.Classes.Eq (GHC.Internal.Arr.Array i e) -- Defined in ‘GHC.Internal.Arr’
 instance forall s i e. GHC.Internal.Classes.Eq (GHC.Internal.Arr.STArray s i e) -- Defined in ‘GHC.Internal.Arr’
 instance GHC.Internal.Classes.Eq GHC.Internal.ByteOrder.ByteOrder -- Defined in ‘GHC.Internal.ByteOrder’
+instance forall a. GHC.Internal.Classes.Eq (GHC.Internal.STM.TVar a) -- Defined in ‘GHC.Internal.STM’
 instance GHC.Internal.Classes.Eq ghc-internal-9.1500.0:GHC.Internal.Event.Internal.Types.Event -- Defined in ‘ghc-internal-9.1500.0:GHC.Internal.Event.Internal.Types’
 instance GHC.Internal.Classes.Eq ghc-internal-9.1500.0:GHC.Internal.Event.Internal.Types.EventLifetime -- Defined in ‘ghc-internal-9.1500.0:GHC.Internal.Event.Internal.Types’
 instance GHC.Internal.Classes.Eq ghc-internal-9.1500.0:GHC.Internal.Event.Internal.Types.Lifetime -- Defined in ‘ghc-internal-9.1500.0:GHC.Internal.Event.Internal.Types’


=====================================
testsuite/tests/simplCore/should_compile/T26682.hs
=====================================
@@ -0,0 +1,105 @@
+{-# LANGUAGE Haskell2010 #-}
+
+{-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE PolyKinds #-}
+{-# LANGUAGE StandaloneKindSignatures #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeFamilies #-}
+
+{-# OPTIONS_GHC -fspecialise-aggressively #-}
+
+-- This is the result of @sheaf's work in minimising
+-- @mikolaj's original bug report for #26682
+
+module T26682 ( tensorADOnceMnistTests2 ) where
+
+import Prelude
+
+import Data.Proxy
+  ( Proxy (Proxy) )
+
+import GHC.TypeNats
+import Data.Kind
+
+import T26682a
+
+
+data Concrete2 x = Concrete2
+
+instance Eq ( Concrete2 a ) where
+  _ == _ = error "no"
+  {-# OPAQUE (==) #-}
+
+type X :: Type -> TK
+type family X a
+
+type instance X (target y) = y
+type instance X (a, b) = TKProduct (X a) (X b)
+type instance X (a, b, c) = TKProduct (TKProduct (X a) (X b)) (X c)
+
+tensorADOnceMnistTests2 :: Int -> Bool
+tensorADOnceMnistTests2 seed0 =
+  withSomeSNat 999 $ \ _ ->
+    let seed1 =
+          randomValue2
+            @(Concrete2 (X (ADFcnnMnist2ParametersShaped Concrete2 101 101 Double Double)))
+            seed0
+        art = mnistTrainBench2VTOGradient3 seed1
+
+        gg :: Concrete2
+                (TKProduct
+                   (TKProduct
+                      (TKProduct
+                         (TKProduct (TKR2 2 (TKScalar Double)) (TKR2 1 (TKScalar Double)))
+                         (TKProduct (TKR2 2 (TKScalar Double)) (TKR2 1 (TKScalar Double))))
+                      (TKProduct (TKR2 2 (TKScalar Double)) (TKR2 1 (TKScalar Double))))
+                   (TKProduct (TKR 1 Double) (TKR 1 Double)))
+        gg = undefined
+        value1 = revInterpretArtifact2 art gg
+    in
+      value1 == value1
+
+mnistTrainBench2VTOGradient3
+  :: Int
+  -> AstArtifactRev2
+        (TKProduct
+           (XParams2 Double Double)
+           (TKProduct (TKR2 1 (TKScalar Double))
+                      (TKR2 1 (TKScalar Double))))
+        (TKScalar Double)
+mnistTrainBench2VTOGradient3 !_
+  | Dict0 <- lemTKScalarAllNumAD2 (Proxy @Double)
+  = undefined
+
+type ADFcnnMnist2ParametersShaped
+       (target :: TK -> Type) (widthHidden :: Nat) (widthHidden2 :: Nat) r q =
+  ( ( target (TKS '[widthHidden, 784] r)
+    , target (TKS '[widthHidden] r) )
+  , ( target (TKS '[widthHidden2, widthHidden] q)
+    , target (TKS '[widthHidden2] r) )
+  , ( target (TKS '[10, widthHidden2] r)
+    , target (TKS '[10] r) )
+  )
+
+-- | The differentiable type of all trainable parameters of this nn.
+type ADFcnnMnist2Parameters (target :: TK -> Type) r q =
+  ( ( target (TKR 2 r)
+    , target (TKR 1 r) )
+  , ( target (TKR 2 q)
+    , target (TKR 1 r) )
+  , ( target (TKR 2 r)
+    , target (TKR 1 r) )
+  )
+
+type XParams2 r q = X (ADFcnnMnist2Parameters Concrete2 r q)
+
+data AstArtifactRev2 x z = AstArtifactRev2
+
+revInterpretArtifact2
+  :: AstArtifactRev2 x z
+  -> Concrete2 x
+  -> Concrete2 z
+{-# OPAQUE revInterpretArtifact2 #-}
+revInterpretArtifact2 _ _ = error "no"


=====================================
testsuite/tests/simplCore/should_compile/T26682a.hs
=====================================
@@ -0,0 +1,109 @@
+{-# LANGUAGE Haskell2010 #-}
+
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE PolyKinds #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE StandaloneKindSignatures #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeData #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE UndecidableSuperClasses #-}
+{-# LANGUAGE UndecidableInstances #-}
+
+module T26682a
+  ( TK(..), TKR, TKS, TKX
+  , Dict0(..)
+  , randomValue2
+  , lemTKScalarAllNumAD2
+  ) where
+
+import Prelude
+
+
+import GHC.TypeLits ( KnownNat(..), Nat, SNat )
+import Data.Kind ( Type, Constraint )
+import Data.Typeable ( Typeable )
+import Data.Proxy ( Proxy )
+
+import Type.Reflection
+import Data.Type.Equality
+
+ifDifferentiable2 :: forall r a. Typeable r
+                 => (Num r => a) -> a -> a
+{-# INLINE ifDifferentiable2 #-}
+ifDifferentiable2 ra _
+  | Just Refl <- testEquality (typeRep @r) (typeRep @Double) = ra
+ifDifferentiable2 ra _
+  | Just Refl <- testEquality (typeRep @r) (typeRep @Float) = ra
+ifDifferentiable2 _ a = a
+
+data Dict0 c where
+  Dict0 :: c => Dict0 c
+
+type ShS2 :: [Nat] -> Type
+data ShS2 ns where
+  Z :: ShS2 '[]
+  S :: {-# UNPACK #-} !( SNat n ) -> !( ShS2 ns ) -> ShS2 (n ': ns)
+
+type KnownShS2 :: [Nat] -> Constraint
+class KnownShS2 ns where
+  knownShS2 :: ShS2 ns
+
+instance KnownShS2 '[] where
+  knownShS2 = Z
+instance ( KnownNat n, KnownShS2 ns ) => KnownShS2 ( n ': ns ) where
+  knownShS2 =
+    case natSing @n of
+      !i ->
+        case knownShS2 @ns of
+          !j ->
+            S i j
+
+type RandomValue2 :: Type -> Constraint
+class RandomValue2 vals where
+  randomValue2 :: Int -> Int
+
+
+type IsDouble :: Type -> Constraint
+type family IsDouble a where
+  IsDouble Double = ( () :: Constraint )
+
+class ( Typeable r, IsDouble r ) => NumScalar2 r
+instance ( Typeable r, IsDouble r ) => NumScalar2 r
+
+instance forall sh r target. (KnownShS2 sh, NumScalar2 r)
+         => RandomValue2 (target (TKS sh r)) where
+  randomValue2 g =
+    ifDifferentiable2 @r
+      ( case knownShS2 @sh of
+          !_ -> g )
+      g
+
+instance (RandomValue2 (target a), RandomValue2 (target b))
+         => RandomValue2 (target (TKProduct a b)) where
+  randomValue2 g =
+    let g1 = randomValue2 @(target a) g
+        g2 = randomValue2 @(target b) g1
+    in g2
+
+lemTKScalarAllNumAD2 :: Proxy r -> Dict0 ( IsDouble r )
+lemTKScalarAllNumAD2 _ = undefined
+{-# OPAQUE lemTKScalarAllNumAD2 #-}
+
+
+type data TK =
+    TKScalar Type
+  | TKR2 Nat TK
+  | TKS2 [Nat] TK
+  | TKX2 [Maybe Nat] TK
+  | TKProduct TK TK
+
+type TKR n r = TKR2 n (TKScalar r)
+type TKS sh r = TKS2 sh (TKScalar r)
+type TKX sh r = TKX2 sh (TKScalar r)


=====================================
testsuite/tests/simplCore/should_compile/all.T
=====================================
@@ -569,4 +569,6 @@ test('T26681',  normal, compile, ['-O'])
 test('T26709', [grep_errmsg(r'case')],
        multimod_compile,
        ['T26709', '-O -ddump-simpl -dsuppress-uniques -dno-typeable-binds'])
+test('T26682',  normal, multimod_compile, ['T26682', '-O -v0'])
+
 



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/99721d450079074a5bb622eca00ef8d...

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/99721d450079074a5bb622eca00ef8d...
You're receiving this email because of your account on gitlab.haskell.org.

    

Marge Bot (＠marge-bot)

tags

participants (1)