diff --git a/CHANGELOG.markdown b/CHANGELOG.markdown --- a/CHANGELOG.markdown +++ b/CHANGELOG.markdown @@ -7,6 +7,29 @@ *de facto* standard Haskell versioning scheme. +0.8.0.0 +------- + +- **Date** 2017-09-26 +- **Git tag** [dejafu-0.8.0.0][] +- **Hackage** https://hackage.haskell.org/package/dejafu-0.8.0.0 + +### Test.DejaFu.Common + +- Execution traces now only include a single item of lookahead (#120). +- STM traces now include IDs of created `TVar`s (#80). + +### Test.DejaFu.Schedule + +- Schedulers no longer take the execution trace so far (#106). +- The `Scheduler` type is now a newtype (#122). + +[dejafu-0.8.0.0]: https://github.com/barrucadu/dejafu/releases/tag/dejafu-0.8.0.0 + + +--------------------------------------------------------------------------------------------------- + + 0.7.3.0 ------- diff --git a/Test/DejaFu/Common.hs b/Test/DejaFu/Common.hs --- a/Test/DejaFu/Common.hs +++ b/Test/DejaFu/Common.hs @@ -63,14 +63,13 @@ , runRefCont ) where -import Control.DeepSeq (NFData(..)) -import Control.Exception (Exception(..), MaskingState(..)) -import Control.Monad.Ref (MonadRef(..)) -import Data.List (intercalate) -import Data.List.NonEmpty (NonEmpty) -import Data.Maybe (fromMaybe, mapMaybe) -import Data.Set (Set) -import qualified Data.Set as S +import Control.DeepSeq (NFData(..)) +import Control.Exception (Exception(..), MaskingState(..)) +import Control.Monad.Ref (MonadRef(..)) +import Data.List (intercalate) +import Data.Maybe (fromMaybe, mapMaybe) +import Data.Set (Set) +import qualified Data.Set as S ------------------------------------------------------------------------------- -- Identifiers @@ -702,9 +701,9 @@ -- | All the actions that an STM transaction can perform. -- --- @since 0.4.0.0 +-- @since 0.8.0.0 data TAction = - TNew + TNew TVarId -- ^ Create a new @TVar@ | TRead TVarId -- ^ Read from a @TVar@. @@ -741,9 +740,9 @@ -- decisions made, all the runnable threads and what they would do, -- and the action a thread took in its step. -- --- @since 0.5.0.0 +-- @since 0.8.0.0 type Trace - = [(Decision, [(ThreadId, NonEmpty Lookahead)], ThreadAction)] + = [(Decision, [(ThreadId, Lookahead)], ThreadAction)] -- | Scheduling decisions are based on the state of the running -- program, and so we can capture some of that state in recording what diff --git a/Test/DejaFu/Conc.hs b/Test/DejaFu/Conc.hs --- a/Test/DejaFu/Conc.hs +++ b/Test/DejaFu/Conc.hs @@ -190,13 +190,13 @@ -- nonexistent thread. In either of those cases, the computation will -- be halted. -- --- @since 0.6.0.0 +-- @since 0.8.0.0 runConcurrent :: MonadRef r n - => Scheduler s - -> MemType - -> s - -> ConcT r n a - -> n (Either Failure a, s, Trace) + => Scheduler s + -> MemType + -> s + -> ConcT r n a + -> n (Either Failure a, s, Trace) runConcurrent sched memtype s ma = do (res, ctx, trace, _) <- runConcurrency sched memtype s initialIdSource 2 (unC ma) pure (res, cSchedState ctx, F.toList trace) diff --git a/Test/DejaFu/Conc/Internal.hs b/Test/DejaFu/Conc/Internal.hs --- a/Test/DejaFu/Conc/Internal.hs +++ b/Test/DejaFu/Conc/Internal.hs @@ -19,10 +19,9 @@ toException) import Control.Monad.Ref (MonadRef, newRef, readRef, writeRef) -import qualified Data.Foldable as F import Data.Functor (void) import Data.List (sortOn) -import Data.List.NonEmpty (NonEmpty(..), fromList) +import Data.List.NonEmpty (fromList) import qualified Data.Map.Strict as M import Data.Maybe (fromJust, isJust) import Data.Monoid ((<>)) @@ -42,7 +41,7 @@ -- | 'Trace' but as a sequence. type SeqTrace - = Seq (Decision, [(ThreadId, NonEmpty Lookahead)], ThreadAction) + = Seq (Decision, [(ThreadId, Lookahead)], ThreadAction) -- | Run a concurrent computation with a given 'Scheduler' and initial -- state, returning a failure reason on error. Also returned is the @@ -78,11 +77,13 @@ -- | Run a collection of threads, until there are no threads left. runThreads :: MonadRef r n - => Scheduler g -> MemType -> r (Maybe (Either Failure a)) -> Context n r g -> n (Context n r g, SeqTrace, Maybe (ThreadId, ThreadAction)) -runThreads sched memtype ref = go Seq.empty [] Nothing where - -- sofar is the 'SeqTrace', sofarSched is the @[(Decision, - -- ThreadAction)]@ trace the scheduler needs. - go sofar sofarSched prior ctx + => Scheduler g + -> MemType + -> r (Maybe (Either Failure a)) + -> Context n r g + -> n (Context n r g, SeqTrace, Maybe (ThreadId, ThreadAction)) +runThreads sched memtype ref = go Seq.empty Nothing where + go sofar prior ctx | isTerminated = pure (ctx, sofar, prior) | isDeadlocked = die sofar prior Deadlock ctx | isSTMLocked = die sofar prior STMDeadlock ctx @@ -96,7 +97,7 @@ Nothing -> die sofar prior InternalError ctx' Nothing -> die sofar prior Abort ctx' where - (choice, g') = sched sofarSched prior (fromList $ map (\(t,l:|_) -> (t,l)) runnable') (cSchedState ctx) + (choice, g') = scheduleThread sched prior (fromList runnable') (cSchedState ctx) runnable' = [(t, lookahead (_continuation a)) | (t, a) <- sortOn fst $ M.assocs runnable] runnable = M.filter (not . isBlocked) threadsc threadsc = addCommitThreads (cWriteBuf ctx) threads @@ -121,17 +122,16 @@ step chosen thread ctx' = do (res, actOrTrc) <- stepThread sched memtype chosen (_continuation thread) $ ctx { cSchedState = g' } - let trc = getTrc actOrTrc - let sofar' = sofar <> trc - let sofarSched' = sofarSched <> map (\(d,_,a) -> (d,a)) (F.toList trc) - let prior' = getPrior actOrTrc + let trc = getTrc actOrTrc + let sofar' = sofar <> trc + let prior' = getPrior actOrTrc case res of Right ctx'' -> let threads' = if (interruptible <$> M.lookup chosen (cThreads ctx'')) /= Just False then unblockWaitingOn chosen (cThreads ctx'') else cThreads ctx'' ctx''' = ctx'' { cThreads = delCommitThreads threads' } - in go sofar' sofarSched' prior' ctx''' + in go sofar' prior' ctx''' Left failure -> let ctx'' = ctx' { cThreads = delCommitThreads threads } in die sofar' prior' failure ctx'' diff --git a/Test/DejaFu/Conc/Internal/Common.hs b/Test/DejaFu/Conc/Internal/Common.hs --- a/Test/DejaFu/Conc/Internal/Common.hs +++ b/Test/DejaFu/Conc/Internal/Common.hs @@ -15,7 +15,6 @@ module Test.DejaFu.Conc.Internal.Common where import Control.Exception (Exception, MaskingState(..)) -import Data.List.NonEmpty (NonEmpty, fromList) import Data.Map.Strict (Map) import Test.DejaFu.Common import Test.DejaFu.STM (STMLike) @@ -153,37 +152,36 @@ -- * Scheduling & Traces -- | Look as far ahead in the given continuation as possible. -lookahead :: Action n r -> NonEmpty Lookahead -lookahead = fromList . lookahead' where - lookahead' (AFork _ _ _) = [WillFork] - lookahead' (AMyTId _) = [WillMyThreadId] - lookahead' (AGetNumCapabilities _) = [WillGetNumCapabilities] - lookahead' (ASetNumCapabilities i k) = WillSetNumCapabilities i : lookahead' k - lookahead' (ANewMVar _ _) = [WillNewMVar] - lookahead' (APutMVar (MVar c _) _ k) = WillPutMVar c : lookahead' k - lookahead' (ATryPutMVar (MVar c _) _ _) = [WillTryPutMVar c] - lookahead' (AReadMVar (MVar c _) _) = [WillReadMVar c] - lookahead' (ATryReadMVar (MVar c _) _) = [WillTryReadMVar c] - lookahead' (ATakeMVar (MVar c _) _) = [WillTakeMVar c] - lookahead' (ATryTakeMVar (MVar c _) _) = [WillTryTakeMVar c] - lookahead' (ANewCRef _ _ _) = [WillNewCRef] - lookahead' (AReadCRef (CRef r _) _) = [WillReadCRef r] - lookahead' (AReadCRefCas (CRef r _) _) = [WillReadCRefCas r] - lookahead' (AModCRef (CRef r _) _ _) = [WillModCRef r] - lookahead' (AModCRefCas (CRef r _) _ _) = [WillModCRefCas r] - lookahead' (AWriteCRef (CRef r _) _ k) = WillWriteCRef r : lookahead' k - lookahead' (ACasCRef (CRef r _) _ _ _) = [WillCasCRef r] - lookahead' (ACommit t c) = [WillCommitCRef t c] - lookahead' (AAtom _ _) = [WillSTM] - lookahead' (AThrow _) = [WillThrow] - lookahead' (AThrowTo tid _ k) = WillThrowTo tid : lookahead' k - lookahead' (ACatching _ _ _) = [WillCatching] - lookahead' (APopCatching k) = WillPopCatching : lookahead' k - lookahead' (AMasking ms _ _) = [WillSetMasking False ms] - lookahead' (AResetMask b1 b2 ms k) = (if b1 then WillSetMasking else WillResetMasking) b2 ms : lookahead' k - lookahead' (ALift _) = [WillLiftIO] - lookahead' (AYield k) = WillYield : lookahead' k - lookahead' (AReturn k) = WillReturn : lookahead' k - lookahead' (AStop _) = [WillStop] - lookahead' (ASub _ _) = [WillSubconcurrency] - lookahead' (AStopSub k) = WillStopSubconcurrency : lookahead' k +lookahead :: Action n r -> Lookahead +lookahead (AFork _ _ _) = WillFork +lookahead (AMyTId _) = WillMyThreadId +lookahead (AGetNumCapabilities _) = WillGetNumCapabilities +lookahead (ASetNumCapabilities i _) = WillSetNumCapabilities i +lookahead (ANewMVar _ _) = WillNewMVar +lookahead (APutMVar (MVar c _) _ _) = WillPutMVar c +lookahead (ATryPutMVar (MVar c _) _ _) = WillTryPutMVar c +lookahead (AReadMVar (MVar c _) _) = WillReadMVar c +lookahead (ATryReadMVar (MVar c _) _) = WillTryReadMVar c +lookahead (ATakeMVar (MVar c _) _) = WillTakeMVar c +lookahead (ATryTakeMVar (MVar c _) _) = WillTryTakeMVar c +lookahead (ANewCRef _ _ _) = WillNewCRef +lookahead (AReadCRef (CRef r _) _) = WillReadCRef r +lookahead (AReadCRefCas (CRef r _) _) = WillReadCRefCas r +lookahead (AModCRef (CRef r _) _ _) = WillModCRef r +lookahead (AModCRefCas (CRef r _) _ _) = WillModCRefCas r +lookahead (AWriteCRef (CRef r _) _ _) = WillWriteCRef r +lookahead (ACasCRef (CRef r _) _ _ _) = WillCasCRef r +lookahead (ACommit t c) = WillCommitCRef t c +lookahead (AAtom _ _) = WillSTM +lookahead (AThrow _) = WillThrow +lookahead (AThrowTo tid _ _) = WillThrowTo tid +lookahead (ACatching _ _ _) = WillCatching +lookahead (APopCatching _) = WillPopCatching +lookahead (AMasking ms _ _) = WillSetMasking False ms +lookahead (AResetMask b1 b2 ms _) = (if b1 then WillSetMasking else WillResetMasking) b2 ms +lookahead (ALift _) = WillLiftIO +lookahead (AYield _) = WillYield +lookahead (AReturn _) = WillReturn +lookahead (AStop _) = WillStop +lookahead (ASub _ _) = WillSubconcurrency +lookahead (AStopSub _) = WillStopSubconcurrency diff --git a/Test/DejaFu/SCT/Internal.hs b/Test/DejaFu/SCT/Internal.hs --- a/Test/DejaFu/SCT/Internal.hs +++ b/Test/DejaFu/SCT/Internal.hs @@ -31,8 +31,7 @@ import System.Random (RandomGen, randomR) import Test.DejaFu.Common -import Test.DejaFu.Schedule (Decision(..), Scheduler, decisionOf, - tidOf) +import Test.DejaFu.Schedule (Scheduler(..), decisionOf, tidOf) ------------------------------------------------------------------------------- -- * Dynamic partial-order reduction @@ -440,9 +439,70 @@ -- ^ Bound function: returns true if that schedule prefix terminated -- with the lookahead decision fits within the bound. -> Scheduler (DPORSchedState k) -dporSched memtype boundf _ prior threads s = schedule where - -- Pick a thread to run. - schedule = case schedPrefix s of +dporSched memtype boundf = Scheduler $ \prior threads s -> + let + -- The next scheduler state + nextState rest = s + { schedBPoints = schedBPoints s |> (restrictToBound fst threads', rest) + , schedDepState = nextDepState + } + nextDepState = let ds = schedDepState s in maybe ds (uncurry $ updateDepState ds) prior + + -- Pick a new thread to run, not considering bounds. Choose the + -- current thread if available and it hasn't just yielded, + -- otherwise add all runnable threads. + initialise = tryDaemons . yieldsToEnd $ case prior of + Just (tid, act) + | not (didYield act) && tid `elem` tids -> [tid] + _ -> tids + + -- If one of the chosen actions will kill the computation, and + -- there are daemon threads, try them instead. + -- + -- This is necessary if the killing action is NOT dependent with + -- every other action, according to the dependency function. This + -- is, strictly speaking, wrong; an action that kills another + -- thread is definitely dependent with everything in that + -- thread. HOWEVER, implementing it that way leads to an explosion + -- of schedules tried. Really, all that needs to happen is for the + -- thread-that-would-be-killed to be executed fully ONCE, and then + -- the normal dependency mechanism will identify any other + -- backtracking points that should be tried. This is achieved by + -- adding every thread that would be killed to the to-do list. + -- Furthermore, these threads MUST be ahead of the killing thread, + -- or the killing thread will end up in the sleep set and so the + -- killing action not performed. This is, again, because of the + -- lack of the dependency messing things up in the name of + -- performance. + -- + -- See commits a056f54 and 8554ce9, and my 4th June comment in + -- issue #52. + tryDaemons ts + | any doesKill ts = case partition doesKill tids of + (kills, nokills) -> nokills ++ kills + | otherwise = ts + doesKill t = killsDaemons t (action t) + + -- Restrict the possible decisions to those in the bound. + restrictToBound f = + filter (\x -> let t = f x in isJust $ boundf (schedBState s) prior (decision t, action t)) + + -- Move the threads which will immediately yield to the end of the list + yieldsToEnd ts = case partition (willYield . action) ts of + (yields, noyields) -> noyields ++ yields + + -- Get the decision that will lead to a thread being scheduled. + decision = decisionOf (fst <$> prior) (S.fromList tids) + + -- Get the action of a thread + action t = fromJust $ lookup t threads' + + -- The runnable thread IDs + tids = map fst threads' + + -- The runnable threads as a normal list. + threads' = toList threads + in case schedPrefix s of -- If there is a decision available, make it (t:ts) -> let bstate' = boundf (schedBState s) prior (decision t, action t) @@ -461,71 +521,11 @@ signore' = not (null choices) && all (`elem` M.keys ssleep') choices sbkill' = not (null initialise) && null choices in case choices' of - (nextTid:rest) -> - let bstate' = boundf (schedBState s) prior (decision nextTid, action nextTid) - in (Just nextTid, (nextState rest) { schedSleep = ssleep', schedBState = bstate' }) - [] -> - (Nothing, (nextState []) { schedIgnore = signore', schedBoundKill = sbkill', schedBState = Nothing }) - - -- The next scheduler state - nextState rest = s - { schedBPoints = schedBPoints s |> (restrictToBound fst threads', rest) - , schedDepState = nextDepState - } - nextDepState = let ds = schedDepState s in maybe ds (uncurry $ updateDepState ds) prior - - -- Pick a new thread to run, not considering bounds. Choose the - -- current thread if available and it hasn't just yielded, otherwise - -- add all runnable threads. - initialise = tryDaemons . yieldsToEnd $ case prior of - Just (tid, act) - | not (didYield act) && tid `elem` tids -> [tid] - _ -> tids - - -- If one of the chosen actions will kill the computation, and there - -- are daemon threads, try them instead. - -- - -- This is necessary if the killing action is NOT dependent with - -- every other action, according to the dependency function. This - -- is, strictly speaking, wrong; an action that kills another thread - -- is definitely dependent with everything in that thread. HOWEVER, - -- implementing it that way leads to an explosion of schedules - -- tried. Really, all that needs to happen is for the - -- thread-that-would-be-killed to be executed fully ONCE, and then - -- the normal dependency mechanism will identify any other - -- backtracking points that should be tried. This is achieved by - -- adding every thread that would be killed to the to-do list. - -- Furthermore, these threads MUST be ahead of the killing thread, - -- or the killing thread will end up in the sleep set and so the - -- killing action not performed. This is, again, because of the lack - -- of the dependency messing things up in the name of performance. - -- - -- See commits a056f54 and 8554ce9, and my 4th June comment in issue - -- #52. - tryDaemons ts - | any doesKill ts = case partition doesKill tids of - (kills, nokills) -> nokills ++ kills - | otherwise = ts - doesKill t = killsDaemons t (action t) - - -- Restrict the possible decisions to those in the bound. - restrictToBound f = filter (\x -> let t = f x in isJust $ boundf (schedBState s) prior (decision t, action t)) - - -- Move the threads which will immediately yield to the end of the list - yieldsToEnd ts = case partition (willYield . action) ts of - (yields, noyields) -> noyields ++ yields - - -- Get the decision that will lead to a thread being scheduled. - decision = decisionOf (fst <$> prior) (S.fromList tids) - - -- Get the action of a thread - action t = fromJust $ lookup t threads' - - -- The runnable thread IDs - tids = map fst threads' - - -- The runnable threads as a normal list. - threads' = toList threads + (nextTid:rest) -> + let bstate' = boundf (schedBState s) prior (decision nextTid, action nextTid) + in (Just nextTid, (nextState rest) { schedSleep = ssleep', schedBState = bstate' }) + [] -> + (Nothing, (nextState []) { schedIgnore = signore', schedBoundKill = sbkill', schedBState = Nothing }) ------------------------------------------------------------------------------- -- Weighted random scheduler @@ -551,23 +551,25 @@ -- and makes a weighted random choice out of the runnable threads at -- every step. randSched :: RandomGen g => (g -> (Int, g)) -> Scheduler (RandSchedState g) -randSched weightf _ _ threads s = (pick choice enabled, RandSchedState weights' g'') where - -- Select a thread - pick idx ((x, f):xs) - | idx < f = Just x - | otherwise = pick (idx - f) xs - pick _ [] = Nothing - (choice, g'') = randomR (0, sum (map snd enabled) - 1) g' - enabled = M.toList $ M.filterWithKey (\tid _ -> tid `elem` tids) weights' +randSched weightf = Scheduler $ \_ threads s -> + let + -- Select a thread + pick idx ((x, f):xs) + | idx < f = Just x + | otherwise = pick (idx - f) xs + pick _ [] = Nothing + (choice, g'') = randomR (0, sum (map snd enabled) - 1) g' + enabled = M.toList $ M.filterWithKey (\tid _ -> tid `elem` tids) weights' - -- The weights, with any new threads added. - (weights', g') = foldr assignWeight (M.empty, schedGen s) tids - assignWeight tid ~(ws, g0) = - let (w, g) = maybe (weightf g0) (,g0) (M.lookup tid (schedWeights s)) - in (M.insert tid w ws, g) + -- The weights, with any new threads added. + (weights', g') = foldr assignWeight (M.empty, schedGen s) tids + assignWeight tid ~(ws, g0) = + let (w, g) = maybe (weightf g0) (,g0) (M.lookup tid (schedWeights s)) + in (M.insert tid w ws, g) - -- The runnable threads. - tids = map fst (toList threads) + -- The runnable threads. + tids = map fst (toList threads) + in (pick choice enabled, RandSchedState weights' g'') ------------------------------------------------------------------------------- -- Dependency function diff --git a/Test/DejaFu/STM/Internal.hs b/Test/DejaFu/STM/Internal.hs --- a/Test/DejaFu/STM/Internal.hs +++ b/Test/DejaFu/STM/Internal.hs @@ -201,7 +201,7 @@ let (idsource', tvid) = nextTVId n idsource ref <- newRef a let tvar = TVar (tvid, ref) - pure (c tvar, nothing, idsource', [], [tvid], TNew) + pure (c tvar, nothing, idsource', [], [tvid], TNew tvid) stepOrElse a b c = cases TOrElse a c (\trace -> transaction (TOrElse trace . Just) b c) diff --git a/Test/DejaFu/Schedule.hs b/Test/DejaFu/Schedule.hs --- a/Test/DejaFu/Schedule.hs +++ b/Test/DejaFu/Schedule.hs @@ -9,7 +9,7 @@ -- Scheduling for concurrent computations. module Test.DejaFu.Schedule ( -- * Scheduling - Scheduler + Scheduler(..) , Decision(..) , tidOf @@ -37,25 +37,24 @@ -- | A @Scheduler@ drives the execution of a concurrent program. The -- parameters it takes are: -- --- 1. The trace so far. --- --- 2. The last thread executed (if this is the first invocation, this +-- 1. The last thread executed (if this is the first invocation, this -- is @Nothing@). -- --- 3. The runnable threads at this point. +-- 2. The runnable threads at this point. -- --- 4. The state. +-- 3. The state. -- -- It returns a thread to execute, or @Nothing@ if execution should -- abort here, and also a new state. -- --- @since 0.5.0.0 -type Scheduler state - = [(Decision, ThreadAction)] - -> Maybe (ThreadId, ThreadAction) - -> NonEmpty (ThreadId, Lookahead) - -> state - -> (Maybe ThreadId, state) +-- @since 0.8.0.0 +newtype Scheduler state = Scheduler + { scheduleThread + :: Maybe (ThreadId, ThreadAction) + -> NonEmpty (ThreadId, Lookahead) + -> state + -> (Maybe ThreadId, state) + } ------------------------------------------------------------------------------- -- Scheduling decisions @@ -93,24 +92,28 @@ -- | A simple random scheduler which, at every step, picks a random -- thread to run. -- --- @since 0.5.0.0 +-- @since 0.8.0.0 randomSched :: RandomGen g => Scheduler g -randomSched _ _ threads g = (Just $ threads' !! choice, g') where - (choice, g') = randomR (0, length threads' - 1) g - threads' = map fst $ toList threads +randomSched = Scheduler go where + go _ threads g = + let threads' = map fst (toList threads) + (choice, g') = randomR (0, length threads' - 1) g + in (Just $ threads' !! choice, g') -- | A round-robin scheduler which, at every step, schedules the -- thread with the next 'ThreadId'. -- --- @since 0.5.0.0 +-- @since 0.8.0.0 roundRobinSched :: Scheduler () -roundRobinSched _ Nothing ((tid,_):|_) _ = (Just tid, ()) -roundRobinSched _ (Just (prior, _)) threads _ - | prior >= maximum threads' = (Just $ minimum threads', ()) - | otherwise = (Just . minimum $ filter (>prior) threads', ()) - - where - threads' = map fst $ toList threads +roundRobinSched = Scheduler go where + go Nothing ((tid,_):|_) _ = (Just tid, ()) + go (Just (prior, _)) threads _ = + let threads' = map fst (toList threads) + candidates = + if prior >= maximum threads' + then threads' + else filter (>prior) threads' + in (Just (minimum candidates), ()) ------------------------------------------------------------------------------- -- Non-preemptive @@ -119,14 +122,14 @@ -- thread. That is, if the last thread scheduled is still runnable, -- run that, otherwise schedule randomly. -- --- @since 0.5.0.0 +-- @since 0.8.0.0 randomSchedNP :: RandomGen g => Scheduler g randomSchedNP = makeNonPreemptive randomSched -- | A round-robin scheduler which doesn't preempt the running -- thread. -- --- @since 0.5.0.0 +-- @since 0.8.0.0 roundRobinSchedNP :: Scheduler () roundRobinSchedNP = makeNonPreemptive roundRobinSched @@ -136,10 +139,10 @@ -- | Turn a potentially preemptive scheduler into a non-preemptive -- one. -- --- @since 0.5.0.0 +-- @since 0.8.0.0 makeNonPreemptive :: Scheduler s -> Scheduler s -makeNonPreemptive sched = newsched where - newsched trc p@(Just (prior, _)) threads s +makeNonPreemptive sched = Scheduler newsched where + newsched p@(Just (prior, _)) threads s | prior `elem` map fst (toList threads) = (Just prior, s) - | otherwise = sched trc p threads s - newsched trc Nothing threads s = sched trc Nothing threads s + | otherwise = scheduleThread sched p threads s + newsched Nothing threads s = scheduleThread sched Nothing threads s diff --git a/dejafu.cabal b/dejafu.cabal --- a/dejafu.cabal +++ b/dejafu.cabal @@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/ name: dejafu -version: 0.7.3.0 +version: 0.8.0.0 synopsis: Systematic testing for Haskell concurrency. description: @@ -37,7 +37,7 @@ source-repository this type: git location: https://github.com/barrucadu/dejafu.git - tag: dejafu-0.7.3.0 + tag: dejafu-0.8.0.0 library exposed-modules: Test.DejaFu