Skip to content

Commit e38dcf0

Browse files
yogeshsajanikaryogeshsajanikar
committed
Add strictness annotation to BranchFrame
- Refector changes to deduplicate
1 parent d5b4c46 commit e38dcf0

File tree

3 files changed

+42
-47
lines changed

3 files changed

+42
-47
lines changed

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

Lines changed: 20 additions & 23 deletions
Original file line numberDiff line numberDiff line change
@@ -906,30 +906,27 @@ execAtomically !time !tid !tlbl !nextVid0 action0 k0 =
906906

907907
Retry ->
908908
{-# SCC "execAtomically.go.Retry" #-}
909-
case ctl of
910-
AtomicallyFrame -> do
911-
-- Revert all the TVar writes
912-
!_ <- traverse_ (\(SomeTVar tvar) -> revertTVar tvar) written
913-
-- Return vars read, so the thread can block on them
914-
k0 $! StmTxBlocked $! (Map.elems read)
915-
916-
BranchFrame (OrElseStmA b) k writtenOuter writtenOuterSeq createdOuterSeq ctl' ->
917-
{-# SCC "execAtomically.go.BranchFrame" #-} do
918-
-- Revert all the TVar writes within this orElse branch
919-
!_ <- traverse_ (\(SomeTVar tvar) -> revertTVar tvar) written
920-
-- Execute the orElse right hand with an empty written set
921-
let ctl'' = BranchFrame NoOpStmA k writtenOuter writtenOuterSeq createdOuterSeq ctl'
922-
go ctl'' read Map.empty [] [] nextVid b
923-
924-
BranchFrame _ _k writtenOuter writtenOuterSeq createdOuterSeq ctl' ->
925-
{-# SCC "execAtomically.go.BranchFrame" #-} do
926-
-- Retry makes sense only within a OrElse context. If it is a branch other than
927-
-- OrElse left side, then bubble up the `retry` to the frame above.
928-
-- Revert all the TVar writes within this branch
909+
do
910+
-- Always revert all the TVar writes for the retry
929911
!_ <- traverse_ (\(SomeTVar tvar) -> revertTVar tvar) written
930-
-- Skip the continuation and propagate the retry into the outer frame
931-
-- using the written set for the outer frame
932-
go ctl' read writtenOuter writtenOuterSeq createdOuterSeq nextVid Retry
912+
case ctl of
913+
AtomicallyFrame -> do
914+
-- Return vars read, so the thread can block on them
915+
k0 $! StmTxBlocked $! (Map.elems read)
916+
917+
BranchFrame (OrElseStmA b) k writtenOuter writtenOuterSeq createdOuterSeq ctl' ->
918+
{-# SCC "execAtomically.go.BranchFrame" #-} do
919+
-- Execute the orElse right hand with an empty written set
920+
let ctl'' = BranchFrame NoOpStmA k writtenOuter writtenOuterSeq createdOuterSeq ctl'
921+
go ctl'' read Map.empty [] [] nextVid b
922+
923+
BranchFrame _ _k writtenOuter writtenOuterSeq createdOuterSeq ctl' ->
924+
{-# SCC "execAtomically.go.BranchFrame" #-} do
925+
-- Retry makes sense only within a OrElse context. If it is a branch other than
926+
-- OrElse left side, then bubble up the `retry` to the frame above.
927+
-- Skip the continuation and propagate the retry into the outer frame
928+
-- using the written set for the outer frame
929+
go ctl' read writtenOuter writtenOuterSeq createdOuterSeq nextVid Retry
933930

934931
OrElse a b k ->
935932
{-# SCC "execAtomically.go.OrElse" #-} do

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

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -844,7 +844,7 @@ data StmStack s b a where
844844

845845
-- | Executing in the context of the /left/ hand side of a branch.
846846
-- A right branch is represented by a frame containing empty statement.
847-
BranchFrame :: BranchStmA s a -- right alternative, can be empty
847+
BranchFrame :: !(BranchStmA s a) -- right alternative, can be empty
848848
-> (a -> StmA s b) -- subsequent continuation
849849
-> Map TVarId (SomeTVar s) -- saved written vars set
850850
-> [SomeTVar s] -- saved written vars list

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

Lines changed: 21 additions & 23 deletions
Original file line numberDiff line numberDiff line change
@@ -1117,30 +1117,28 @@ execAtomically time tid tlbl nextVid0 action0 k0 =
11171117

11181118
Retry ->
11191119
{-# SCC "execAtomically.go.Retry" #-}
1120-
case ctl of
1121-
AtomicallyFrame -> do
1122-
-- Revert all the TVar writes
1123-
!_ <- traverse_ (\(SomeTVar tvar) -> revertTVar tvar) written
1124-
-- Return vars read, so the thread can block on them
1125-
k0 $! StmTxBlocked $! Map.elems read
1126-
1127-
BranchFrame (OrElseStmA b) k writtenOuter writtenOuterSeq createdOuterSeq ctl' ->
1128-
{-# SCC "execAtomically.go.BranchFrame" #-} do
1129-
-- Revert all the TVar writes within this orElse
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-
-- Revert all the TVar writes within this orElse branch
1120+
do
1121+
-- Always revert all the TVar writes for the retry
11401122
!_ <- traverse_ (\(SomeTVar tvar) -> revertTVar tvar) written
1141-
-- Skip the continuation and propagate the retry into the outer frame
1142-
-- using the written set for the outer frame
1143-
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" #-} 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
11441142

11451143
OrElse a b k ->
11461144
{-# SCC "execAtomically.go.OrElse" #-} do

0 commit comments

Comments
 (0)