Tuple up scheduler & runner sct states, as partial application doesn't really make sense

Control/Monad/Conc/SCT/Internal.hs

@@ -50,9 +50,9 @@ data Decision =
 -- so it is important that the scheduler actually maintain some
 -- internal state, or all the results will be identical.
 runSCT :: SCTScheduler s -> s -> Int -> (forall t. Conc t a) -> [(Maybe a, SCTTrace)]
-runSCT sched s n = runSCT' sched s n term step where
+runSCT sched s n = runSCT' sched (s, n) term step where
-  term _  g = g == 0
+  term (_,  g) = g == 0
-  step s' g _ = (s', g - 1)
+  step (s', g) _ = (s', g - 1)
 
 -- | A varant of 'runSCT' for concurrent programs that do 'IO'.
 --
@@ -61,9 +61,9 @@ runSCT sched s n = runSCT' sched s n term step where
 -- block on the action of another thread, or you risk deadlocking this
 -- function!
 runSCTIO :: SCTScheduler s -> s -> Int -> (forall t. CIO.Conc t a) -> IO [(Maybe a, SCTTrace)]
-runSCTIO sched s n = runSCTIO' sched s n term step where
+runSCTIO sched s n = runSCTIO' sched (s, n) term step where
-  term _  g = g == 0
+  term (_,  g) = g == 0
-  step s' g _ = (s', g - 1)
+  step (s', g) _ = (s', g - 1)
 
 -- | Run a concurrent program under a given scheduler, where the SCT
 -- runner itself maintains some internal state, and has a function to
@@ -73,23 +73,22 @@ runSCTIO sched s n = runSCTIO' sched s n term step where
 -- Note: the state step function takes the state returned by the
 -- scheduler, not the initial state!
 runSCT' :: SCTScheduler s -- ^ The scheduler
-        -> s -- ^ The scheduler's initial state
+        -> (s, g) -- ^ The scheduler's and runner's initial states
-        -> g -- ^ The runner's initial state
+        -> ((s, g) -> Bool) -- ^ Termination decider
-        -> (s -> g -> Bool) -- ^ Termination decider
+        -> ((s, g) -> SCTTrace -> (s, g)) -- ^ State step function
-        -> (s -> g -> SCTTrace -> (s, g)) -- ^ State step function
         -> (forall t. Conc t a) -- ^ Conc program
         -> [(Maybe a, SCTTrace)]
-runSCT' sched s g term step c
+runSCT' sched (s, g) term step c
-  | term s g = []
+  | term (s, g) = []
   | otherwise = (res, trace) : rest where
 
   (res, (s', strace), ttrace) = runConc' sched (s, [(Start 0, [])]) c
 
   trace = reverse $ scttrace strace ttrace
 
-  (s'', g') = step s' g trace
+  (s'', g') = step (s', g) trace
 
-  rest = runSCT' sched s'' g' term step c
+  rest = runSCT' sched (s'', g') term step c
 
 -- | A variant of runSCT' for concurrent programs that do IO.
 --
@@ -97,16 +96,16 @@ runSCT' sched s g term step c
 -- interleavings! Be very confident that nothing in a 'liftIO' can
 -- block on the action of another thread, or you risk deadlocking this
 -- function!
-runSCTIO' :: SCTScheduler s -> s -> g -> (s -> g -> Bool) -> (s -> g -> SCTTrace -> (s, g)) -> (forall t. CIO.Conc t a) -> IO [(Maybe a, SCTTrace)]
+runSCTIO' :: SCTScheduler s -> (s, g) -> ((s, g) -> Bool) -> ((s, g) -> SCTTrace -> (s, g)) -> (forall t. CIO.Conc t a) -> IO [(Maybe a, SCTTrace)]
-runSCTIO' sched s g term step c
+runSCTIO' sched (s, g) term step c
-  | term s g = return []
+  | term (s, g) = return []
   | otherwise = do
     (res, (s', strace), ttrace) <- CIO.runConc' sched (s, [(Start 0, [])]) c
 
     let trace = reverse $ scttrace strace ttrace
-    let (s'', g') = step s' g trace
+    let (s'', g') = step (s', g) trace
 
-    rest <- runSCTIO' sched s'' g' term step c
+    rest <- runSCTIO' sched (s'', g') term step c
 
     return $ (res, trace) : rest
 

Control/Monad/Conc/SCT/PreBound.hs

@@ -22,12 +22,12 @@ sctPreBound :: Int
             -- ^ The pre-emption bound. Anything < 0 will be
             -- interpreted as 0.
             -> (forall t. Conc t a) -> [(Maybe a, SCTTrace)]
-sctPreBound pb = runSCT' pbSched pbInitialS pbInitialG (pbTerm pb') (pbStep pb' False) where
+sctPreBound pb = runSCT' pbSched (pbInitialS, pbInitialG) (pbTerm pb') (pbStep pb' False) where
   pb' = if pb < 0 then 0 else pb
 
 -- | Variant of 'sctPreBound' using 'IO'. See usual caveats about IO.
 sctPreBoundIO :: Int -> (forall t. CIO.Conc t a) -> IO [(Maybe a, SCTTrace)]
-sctPreBoundIO pb = runSCTIO' pbSched pbInitialS pbInitialG (pbTerm pb') (pbStep pb' True) where
+sctPreBoundIO pb = runSCTIO' pbSched (pbInitialS, pbInitialG) (pbTerm pb') (pbStep pb' True) where
   pb' = if pb < 0 then 0 else pb
 
 -- * Utils
@@ -105,8 +105,8 @@ pbSched (s, trc) prior threads@(next:|_) = case _decisions s of
 
 -- | Pre-emption bounding termination function: terminates on attempt
 -- to start a PB above the limit.
-pbTerm :: Int -> a -> PBState -> Bool
+pbTerm :: Int -> (a, PBState) -> Bool
-pbTerm pb _ g = (_pc g == pb + 1) || _halt g
+pbTerm pb (_, g) = (_pc g == pb + 1) || _halt g
 
 -- | Pre-emption bounding state step function: computes remaining
 -- schedules to try and chooses one.
@@ -121,8 +121,8 @@ pbStep :: Int
        -- ^ Pre-emption bound.
        -> Bool
        -- ^ Whether to consider pre-emptions around lifts.
-       -> PBSched -> PBState -> SCTTrace -> (PBSched, PBState)
+       -> (PBSched, PBState) -> SCTTrace -> (PBSched, PBState)
-pbStep pb lifts s g t = case _next g of
+pbStep pb lifts (s, g) t = case _next g of
   -- We have schedules remaining, so run the next
   Lazy (x:xs) rest -> (s' x, g { _next = nextPB +| thisPB +| xs +| rest })