barrucadu/dejafu
1
1
Fork 0
mirror of https://github.com/barrucadu/dejafu.git synced 2024-12-18 19:11:37 +03:00
Code Issues Projects Releases Wiki Activity

Implement CRefs in stepThread

Browse Source
This commit is contained in:
Michael Walker 2015-02-20 16:24:21 +00:00
parent a4a291368d
commit 0ea2930862
2 changed files with 32 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
Test/DejaFu/Deterministic/Internal.hs
View File

@ -160,11 +160,11 @@ stepThread fixed runconc runstm action idSource tid threads = case action of
AGet ref c -> stepGet ref c
ATake ref c -> stepTake ref c
ATryTake ref c -> stepTryTake ref c
AReadRef ref c -> error "'AReadRef' not yet implemented in 'stepThread'"
AModRef ref f c -> error "'AModRef' not yet implemented in 'stepThread'"
AReadRef ref c -> stepReadRef ref c
AModRef ref f c -> stepModRef ref f c
AAtom stm c -> stepAtom stm c
ANew na -> stepNew na
ANewRef na -> error "'ANewRef' not yet implemented in 'stepThread'"
ANewRef na -> stepNewRef na
ALift na -> stepLift na
AThrow e -> stepThrow e
AThrowTo t e c -> stepThrowTo t e c
@ -212,6 +212,17 @@ stepThread fixed runconc runstm action idSource tid threads = case action of
(success, threads', woken) <- readFromCVar True False cvar c fixed tid threads
return $ Right (threads', idSource, TryTake cvid success woken)
-- | Read from a @CRef@.
stepReadRef (crid, ref) c = do
val <- readRef (wref fixed) ref
return $ Right (goto (c val) tid threads, idSource, ReadRef crid)
-- | Modify a @CRef@.
stepModRef (crid, ref) f c = do
(new, val) <- f <$> readRef (wref fixed) ref
writeRef (wref fixed) ref new
return $ Right (goto (c val) tid threads, idSource, ModRef crid)
-- | Run a STM transaction atomically.
stepAtom stm c = do
(res, newctvid) <- runstm stm (_nextCTVId idSource)
@ -289,6 +300,12 @@ stepThread fixed runconc runstm action idSource tid threads = case action of
a <- na newcvid
return $ Right (goto a tid threads, idSource', New newcvid)
-- | Create a new @CRef@, using the next 'CRefId'.
stepNewRef na = do
let (idSource', newcrid) = nextCRId idSource
a <- na newcrid
return $ Right (goto a tid threads, idSource', NewRef newcrid)
-- | Lift an action from the underlying monad into the @Conc@
-- computation.
stepLift na = do

14
Test/DejaFu/Deterministic/Internal/Common.hs
View File

@ -73,7 +73,11 @@ type CRefId = Int
-- | The number of ID parameters was getting a bit unwieldy, so this
-- hides them all away.
data IdSource = Id { _nextCVId :: CVarId, _nextCTVId :: CTVarId, _nextTId :: ThreadId }
data IdSource = Id { _nextCRId :: CRefId, _nextCVId :: CVarId, _nextCTVId :: CTVarId, _nextTId :: ThreadId }
-- | Get the next free 'CRefId'.
nextCRId :: IdSource -> (IdSource, CRefId)
nextCRId idsource = let newid = _nextCRId idsource + 1 in (idsource { _nextCRId = newid }, newid)
-- | Get the next free 'CVarId'.
nextCVId :: IdSource -> (IdSource, CVarId)
@ -89,7 +93,7 @@ nextTId idsource = let newid = _nextTId idsource + 1 in (idsource { _nextTId = n
-- | The initial ID source.
initialIdSource :: IdSource
initialIdSource = Id 0 0 0
initialIdSource = Id 0 0 0 0
--------------------------------------------------------------------------------
-- * Scheduling & Traces
@ -162,6 +166,12 @@ data ThreadAction =
-- ^ Get blocked on a take.
| TryTake CVarId Bool [ThreadId]
-- ^ Try to take from a 'CVar', possibly waking up some threads.
| NewRef CRefId
-- ^ Create a new 'CRef'.
| ReadRef CRefId
-- ^ Read from a 'CRef'.
| ModRef CRefId
-- ^ Modify a 'CRef'.
| STM [ThreadId]
-- ^ An STM transaction was executed, possibly waking up some
-- threads.