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 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.