dejafu 0.7.3.0 → 0.8.0.0

raw patch · 9 files changed

+212/−187 lines, 9 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.markdown +23/−0
• Test/DejaFu/Common.hs +11/−12
• Test/DejaFu/Conc.hs +6/−6
• Test/DejaFu/Conc/Internal.hs +14/−14
• Test/DejaFu/Conc/Internal/Common.hs +33/−35
• Test/DejaFu/SCT/Internal.hs +87/−85
• Test/DejaFu/STM/Internal.hs +1/−1
• Test/DejaFu/Schedule.hs +35/−32
• dejafu.cabal +2/−2

@@ -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 ------- 

@@ -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

@@ -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)

@@ -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''

@@ -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

@@ -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

@@ -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)

@@ -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

@@ -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