@@ -1092,21 +1092,9 @@ execAtomically time tid tlbl nextVid0 action0 k0 =
1092
1092
(mapMaybe traceString $ ds ++ ds')
1093
1093
nextVid
1094
1094
1095
- OrElseLeftFrame _b k writtenOuter writtenOuterSeq createdOuterSeq ctl' -> do
1096
- -- Commit the TVars written in this sub-transaction that are also
1097
- -- in the written set of the outer transaction
1098
- ! _ <- traverse_ (\ (SomeTVar tvar) -> commitTVar tvar)
1099
- (Map. intersection written writtenOuter)
1100
- -- Merge the written set of the inner with the outer
1101
- let written' = Map. union written writtenOuter
1102
- writtenSeq' = filter (\ (SomeTVar tvar) ->
1103
- tvarId tvar `Map.notMember` writtenOuter)
1104
- writtenSeq
1105
- ++ writtenOuterSeq
1106
- -- Skip the orElse right hand and continue with the k continuation
1107
- go ctl' read written' writtenSeq' createdOuterSeq nextVid (k x)
1108
-
1109
- OrElseRightFrame k writtenOuter writtenOuterSeq createdOuterSeq ctl' -> do
1095
+ BranchFrame _b k writtenOuter writtenOuterSeq createdOuterSeq ctl' -> do
1096
+ -- The branch has successfully completed the transaction. Hence,
1097
+ -- the alternative branch can be ignored.
1110
1098
-- Commit the TVars written in this sub-transaction that are also
1111
1099
-- in the written set of the outer transaction
1112
1100
! _ <- traverse_ (\ (SomeTVar tvar) -> commitTVar tvar)
@@ -1118,7 +1106,7 @@ execAtomically time tid tlbl nextVid0 action0 k0 =
1118
1106
writtenSeq
1119
1107
++ writtenOuterSeq
1120
1108
createdSeq' = createdSeq ++ createdOuterSeq
1121
- -- Continue with the k continuation
1109
+ -- Skip the orElse right hand and continue with the k continuation
1122
1110
go ctl' read written' writtenSeq' createdSeq' nextVid (k x)
1123
1111
1124
1112
ThrowStm e ->
@@ -1129,33 +1117,33 @@ execAtomically time tid tlbl nextVid0 action0 k0 =
1129
1117
1130
1118
Retry ->
1131
1119
{-# SCC "execAtomically.go.Retry" #-}
1132
- case ctl of
1133
- AtomicallyFrame -> do
1134
- -- Revert all the TVar writes
1135
- ! _ <- traverse_ (\ (SomeTVar tvar) -> revertTVar tvar) written
1136
- -- Return vars read, so the thread can block on them
1137
- k0 $! StmTxBlocked $! Map. elems read
1138
-
1139
- OrElseLeftFrame b k writtenOuter writtenOuterSeq createdOuterSeq ctl' ->
1140
- {-# SCC "execAtomically.go.OrElseLeftFrame" #-} do
1141
- -- Revert all the TVar writes within this orElse
1142
- ! _ <- traverse_ (\ (SomeTVar tvar) -> revertTVar tvar) written
1143
- -- Execute the orElse right hand with an empty written set
1144
- let ctl'' = OrElseRightFrame k writtenOuter writtenOuterSeq createdOuterSeq ctl'
1145
- go ctl'' read Map. empty [] [] nextVid b
1146
-
1147
- OrElseRightFrame _k writtenOuter writtenOuterSeq createdOuterSeq ctl' ->
1148
- {-# SCC "execAtomically.go.OrElseRightFrame" #-} do
1149
- -- Revert all the TVar writes within this orElse branch
1120
+ do
1121
+ -- Always revert all the TVar writes for the retry
1150
1122
! _ <- traverse_ (\ (SomeTVar tvar) -> revertTVar tvar) written
1151
- -- Skip the continuation and propagate the retry into the outer frame
1152
- -- using the written set for the outer frame
1153
- go ctl' read writtenOuter writtenOuterSeq createdOuterSeq nextVid Retry
1123
+ case ctl of
1124
+ AtomicallyFrame -> do
1125
+ -- Return vars read, so the thread can block on them
1126
+ k0 $! StmTxBlocked $! Map. elems read
1127
+
1128
+ BranchFrame (OrElseStmA b) k writtenOuter writtenOuterSeq createdOuterSeq ctl' ->
1129
+ {-# SCC "execAtomically.go.BranchFrame.OrElseStmA" #-} do
1130
+ ! _ <- traverse_ (\ (SomeTVar tvar) -> revertTVar tvar) written
1131
+ -- Execute the orElse right hand with an empty written set
1132
+ let ctl'' = BranchFrame NoOpStmA k writtenOuter writtenOuterSeq createdOuterSeq ctl'
1133
+ go ctl'' read Map. empty [] [] nextVid b
1134
+
1135
+ BranchFrame _ _k writtenOuter writtenOuterSeq createdOuterSeq ctl' ->
1136
+ {-# SCC "execAtomically.go.BranchFrame" #-} do
1137
+ -- Retry makes sense only within a OrElse context. If it is a branch other than
1138
+ -- OrElse left side, then bubble up the `retry` to the frame above.
1139
+ -- Skip the continuation and propagate the retry into the outer frame
1140
+ -- using the written set for the outer frame
1141
+ go ctl' read writtenOuter writtenOuterSeq createdOuterSeq nextVid Retry
1154
1142
1155
1143
OrElse a b k ->
1156
1144
{-# SCC "execAtomically.go.OrElse" #-} do
1157
1145
-- Execute the left side in a new frame with an empty written set
1158
- let ctl' = OrElseLeftFrame b k written writtenSeq createdSeq ctl
1146
+ let ctl' = BranchFrame ( OrElseStmA b) k written writtenSeq createdSeq ctl
1159
1147
go ctl' read Map. empty [] [] nextVid a
1160
1148
1161
1149
NewTVar ! mbLabel x k ->
0 commit comments