-* Multiline strings are now accepted in foreign imports. (#25157)

-  will be rejected unless :extension:`DataKinds` is on:

-- SIMD support in the X86 native code generator has been extended with 128-bit

-- :ghci-cmd:`:info` now outputs type declarations with @-binders that are

-* The `UnknownDiagnostic` constructor now takes an additional type argument

-  - `addToHpt` and `addListToHPT` were moved from `GHC.Unit.Home.ModInfo` to `GHC.Unit.Home.PackageTable` and deprecated in favour of `addHomeModInfoToHpt` and `addHomeModInfosToHpt`.

-  - `UnitEnvGraph` and operations `unitEnv_lookup_maybe`, `unitEnv_foldWithKey, `unitEnv_singleton`, `unitEnv_adjust`, `unitEnv_insert`, `unitEnv_new` were moved from `GHC.Unit.Env` to `GHC.Unit.Home.Graph`.

-  - The HomePackageTable (HPT) is now exported from `GHC.Unit.Home.PackageTable`,

-    `emptyHomePackageTable` and `addHomeModInfoToHpt` are now in IO.

-  - `mkHomeUnitEnv` was moved to `GHC.Unit.Home.PackageTable`, and now takes two

-    extra explicit arguments. To restore previous behaviour, pass `emptyUnitState`

-    and `Nothing` as the first two arguments additionally.

-  - `hugElts` was removed. Users should prefer `allUnits` to get the keys of the

-    HUG (the typical use case), or `traverse` or `unitEnv_foldWithKey` in other

-* Changes to `Language.Haskell.Syntax.Expr`

-  - The `ParStmtBlock` list argument of the `ParStmt` constructor of `StmtLR` is now `NonEmpty`.

-* As part of the implementation of `GHC proposal 493 <https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0493-specialise-expressions.rst>`_,

-  the `SpecSig` constructor of `Sig` has been deprecated. It is replaced by

-  the constructor `SpecSigE` which supports expressions at the head, rather than

-* The functions `getClosureInfoTbl_maybe`, `getClosureInfoTbl`,

-  `getClosurePtrArgs` and `getClosurePtrArgs_maybe` have been added to allow

-

-    if (running_alt_code != 1) {

-      // When exiting the lhs code of catchRetry# lhs rhs, we need to cleanup

-      // the nested transaction.

-      // See Note [catchRetry# implementation]

-      outer  = StgTRecHeader_enclosing_trec(trec);

-      (r) = ccall stmCommitNestedTransaction(MyCapability() "ptr", trec "ptr");

-      if (r != 0) {

-          // Succeeded in first branch

-          StgTSO_trec(CurrentTSO) = outer;

-          return (ret);

-      } else {

-          // Did not commit: abort and restart.

-          StgTSO_trec(CurrentTSO) = outer;

-          jump stg_abort();

-      }

-    }

-    else {

-      // nothing to do in the rhs code of catchRetry# lhs rhs, it's already

-      // using the parent transaction (not a nested one).

-      // See Note [catchRetry# implementation]

-      return (ret);

-        // The retry reaches a CATCH_RETRY_FRAME before the ATOMICALLY_FRAME

-

-            // Retrying in the lhs of catchRetry# lhs rhs, i.e. in a nested

-            // transaction. See Note [catchRetry# implementation]

-

-            // check that we have a parent transaction

-            ASSERT(outer != NO_TREC);

-

-            // Abort the nested transaction

-            ccall stmAbortTransaction(MyCapability() "ptr", trec "ptr");

-            ccall stmFreeAbortedTRec(MyCapability() "ptr", trec "ptr");

-

-            // As we are retrying in the lhs code, we must now try the rhs code

-            StgTSO_trec(CurrentTSO) = outer;

-            // Retry in the rhs code: propagate the retry

-            // CATCH_STM frame within an atomically block: abort the

-            debugTraceCap(DEBUG_stm, cap, "raiseAsync: traversing CATCH_STM frame");

-        case CATCH_RETRY_FRAME:

-            // CATCH_RETY frame within an atomically block: if we're executing

-            // the lhs code, abort the inner transaction and continue; if we're

-            // executing thr rhs, continue (no nested transaction to abort. See

-            // Note [catchRetry# implementation]). Eventually we will hit the

-            // outer transaction that will get frozen (see above).

-            //

-            // As for the CATCH_STM_FRAME case above, we do not care

-            // whether the transaction is valid or not because its

-            // possible validity cannot have caused the exception

-            // and will not be visible after the abort.

-        {

-            if (!((StgCatchRetryFrame *)frame) -> running_alt_code) {

-                debugTraceCap(DEBUG_stm, cap, "raiseAsync: traversing CATCH_RETRY frame (lhs)");

-                StgTRecHeader *trec = tso -> trec;

-                StgTRecHeader *outer = trec -> enclosing_trec;

-                stmAbortTransaction(cap, trec);

-                stmFreeAbortedTRec(cap, trec);

-                tso -> trec = outer;

-            }

-            else

-            {

-                debugTraceCap(DEBUG_stm, cap, "raiseAsync: traversing CATCH_RETRY frame (rhs)");

-            }

-            break;

-        };

-

-

-

-

-/*

-

-Note [catchRetry# implementation]

-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

-catchRetry# creates a nested transaction for its lhs:

-- if the lhs transaction succeeds:

-    - the lhs transaction is committed

-    - its read-variables are merged with those of the parent transaction

-    - the rhs code is ignored

-- if the lhs transaction retries:

-    - the lhs transaction is aborted

-    - its read-variables are merged with those of the parent transaction

-    - the rhs code is executed directly in the parent transaction (see #26028).

-

-So note that:

-- lhs code uses a nested transaction

-- rhs code doesn't use a nested transaction

-

-We have to take which case we're in into account (using the running_alt_code

-field of the catchRetry frame) in catchRetry's entry code, in retry#

-implementation, and also when an async exception is received (to cleanup the

-right number of transactions).

-

-*/

-module Main where

-

-import GHC.Conc

-

-forever :: IO String

-forever = delay 10 >> forever

-

-terminates :: IO String

-terminates = delay 1 >> pure "terminates"

-

-delay s = threadDelay (1000000 * s)

-

-async :: IO a -> IO (STM a)

-async a = do 

-  var <- atomically (newTVar Nothing)

-  forkIO (a >>= atomically . writeTVar var . Just)

-  pure (readTVar var >>= maybe retry pure)

-

-main :: IO ()

-main = do

-  x <- mapM async $ terminates : replicate 50000 forever

-  r <- atomically (foldr1 orElse x)

-  print r

-"terminates"

-test('T26028', only_ways(['threaded1']), compile_and_run, ['-O2'])