Skip to content

Commit 780e11a

Browse files
Refactor comments
- Refactor comments to remove redundancy. - Add explicit case statements for handling branches for ThrowSTM
1 parent 734c9e3 commit 780e11a

File tree

3 files changed

+14
-9
lines changed

3 files changed

+14
-9
lines changed

io-sim/src/Control/Monad/IOSim/Internal.hs

Lines changed: 6 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -935,13 +935,16 @@ execAtomically !time !tid !tlbl !nextVid0 action0 k0 =
935935
BranchFrame (CatchStmA h) k writtenOuter writtenOuterSeq createdOuterSeq ctl' ->
936936
{-# SCC "execAtomically.go.BranchFrame" #-} do
937937
-- Execute the left side in a new frame with an empty written set.
938-
-- Rollback `TVar`s written since catch handler was installed,
939938
-- but preserve ones that were set prior to it, as specified in the
940939
-- [stm](https://hackage.haskell.org/package/stm/docs/Control-Monad-STM.html#v:catchSTM) package.
941940
let ctl'' = BranchFrame NoOpStmA k writtenOuter writtenOuterSeq createdOuterSeq ctl'
942941
go ctl'' read Map.empty [] [] nextVid (h e)
943-
--
944-
BranchFrame _ _k writtenOuter writtenOuterSeq createdOuterSeq ctl' ->
942+
943+
BranchFrame (OrElseStmA _r) _k writtenOuter writtenOuterSeq createdOuterSeq ctl' ->
944+
{-# SCC "execAtomically.go.BranchFrame" #-} do
945+
go ctl' read writtenOuter writtenOuterSeq createdOuterSeq nextVid (ThrowStm e)
946+
947+
BranchFrame NoOpStmA _k writtenOuter writtenOuterSeq createdOuterSeq ctl' ->
945948
{-# SCC "execAtomically.go.BranchFrame" #-} do
946949
go ctl' read writtenOuter writtenOuterSeq createdOuterSeq nextVid (ThrowStm e)
947950

io-sim/src/Control/Monad/IOSim/Types.hs

Lines changed: 3 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -346,10 +346,9 @@ instance MonadCatch (STM s) where
346346
Nothing -> throwIO e -- Rethrow the exception if handler does not handle it.
347347
Just e' -> h e'
348348

349-
-- STM actions are always run inside `execAtomically` and behave as if masked
350-
-- Another point to note that the default implementation of `generalBracket` needs
351-
-- mask, and is part of `MonadThrow`. For STM, we don't need masking because
352-
-- async exceptions are handled outside of `execAtomically`.
349+
-- Masking is not required as STM actions are always run inside
350+
-- `execAtomically` and behave as if masked. Also note that the default
351+
-- implementation of `generalBracket` needs mask, and is part of `MonadThrow`.
353352
generalBracket acquire release use = do
354353
resource <- acquire
355354
b <- use resource `catch` \e -> do

io-sim/src/Control/Monad/IOSimPOR/Internal.hs

Lines changed: 5 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1181,13 +1181,16 @@ execAtomically time tid tlbl nextVid0 action0 k0 =
11811181
BranchFrame (CatchStmA h) k writtenOuter writtenOuterSeq createdOuterSeq ctl' ->
11821182
{-# SCC "execAtomically.go.BranchFrame" #-} do
11831183
-- Execute the left side in a new frame with an empty written set.
1184-
-- Rollback `TVar`s written since catch handler was installed,
11851184
-- but preserve ones that were set prior to it, as specified in the
11861185
-- [stm](https://hackage.haskell.org/package/stm/docs/Control-Monad-STM.html#v:catchSTM) package.
11871186
let ctl'' = BranchFrame NoOpStmA k writtenOuter writtenOuterSeq createdOuterSeq ctl'
11881187
go ctl'' read Map.empty [] [] nextVid (h e)
11891188

1190-
BranchFrame _ _k writtenOuter writtenOuterSeq createdOuterSeq ctl' ->
1189+
BranchFrame (OrElseStmA _r) _k writtenOuter writtenOuterSeq createdOuterSeq ctl' ->
1190+
{-# SCC "execAtomically.go.BranchFrame" #-} do
1191+
go ctl' read writtenOuter writtenOuterSeq createdOuterSeq nextVid (ThrowStm e)
1192+
1193+
BranchFrame NoOpStmA _k writtenOuter writtenOuterSeq createdOuterSeq ctl' ->
11911194
{-# SCC "execAtomically.go.BranchFrame" #-} do
11921195
go ctl' read writtenOuter writtenOuterSeq createdOuterSeq nextVid (ThrowStm e)
11931196

0 commit comments

Comments
 (0)