diff --git a/Control/Monad/Conc/Fixed/Internal.hs b/Control/Monad/Conc/Fixed/Internal.hs index 82e0bc8..66b84ae 100644 --- a/Control/Monad/Conc/Fixed/Internal.hs +++ b/Control/Monad/Conc/Fixed/Internal.hs @@ -8,6 +8,7 @@ module Control.Monad.Conc.Fixed.Internal where import Control.DeepSeq (NFData(..)) import Control.Monad (liftM, mapAndUnzipM) import Control.Monad.Cont (Cont, runCont) +import Data.List.Extra import Data.Map (Map) import Data.Maybe (catMaybes, fromJust, isNothing) @@ -37,21 +38,6 @@ data Fixed c n r t = F -- type. } --- * Non-Empty Lists - --- | The type of non-empty lists. -data NonEmpty a = a :| [a] deriving (Eq, Ord, Read, Show) - -instance Functor NonEmpty where - fmap f (a :| as) = f a :| map f as - -instance NFData a => NFData (NonEmpty a) where - rnf (x:|xs) = rnf (x, xs) - --- | Convert a 'NonEmpty' to a regular non-empty list. -toList :: NonEmpty a -> [a] -toList (a :| as) = a : as - -- * Running @Conc@ Computations -- | Scheduling is done in terms of a trace of 'Action's. Blocking can diff --git a/Control/Monad/Conc/Fixed/Schedulers.hs b/Control/Monad/Conc/Fixed/Schedulers.hs index 8a23bb2..4067442 100644 --- a/Control/Monad/Conc/Fixed/Schedulers.hs +++ b/Control/Monad/Conc/Fixed/Schedulers.hs @@ -16,6 +16,7 @@ module Control.Monad.Conc.Fixed.Schedulers ) where import Control.Monad.Conc.Fixed.Internal +import Data.List.Extra import System.Random (RandomGen, randomR) -- | A simple random scheduler which, at every step, picks a random diff --git a/Control/Monad/Conc/SCT/Bounding.hs b/Control/Monad/Conc/SCT/Bounding.hs index a0516bf..f446e51 100755 --- a/Control/Monad/Conc/SCT/Bounding.hs +++ b/Control/Monad/Conc/SCT/Bounding.hs @@ -7,6 +7,7 @@ module Control.Monad.Conc.SCT.Bounding where import Control.DeepSeq (NFData(..), force) import Control.Monad.Conc.Fixed import Control.Monad.Conc.SCT.Internal +import Data.List.Extra import qualified Control.Monad.Conc.Fixed.IO as CIO @@ -83,16 +84,6 @@ sctBoundedIO siblings offspring b = runSCTIO' prefixSched (initialS, initialG) b -- * State --- | Data type representing a lazy, chunky, tagged, stream of data. -data Lazy t a = Lazy (t, NonEmpty a) (Lazy t a) | Empty t - --- | Prepend a value onto a lazy stream. -(+|) :: (t, [a]) -> Lazy t a -> Lazy t a -(_, []) +| l = l -(t, x:xs) +| l = Lazy (t, x:|xs) l - -infixr +| - -- | State for the prefix scheduler. data Sched = S { _decisions :: [Decision] @@ -106,7 +97,7 @@ instance NFData Sched where -- | State for the bounded runner. data State = P - { _next :: Lazy Int [Decision] + { _next :: Stream Int [Decision] -- ^ Schedules to try. , _halt :: Bool -- ^ Indicates more schedules couldn't be found, and to halt @@ -159,7 +150,7 @@ bStep :: (SCTTrace -> [[Decision]]) -> (Sched, State) -> SCTTrace -> (Sched, State) bStep siblings offspring blim (s, g) t = case _next g of -- We have schedules remaining, so run the next - Lazy (b, x:|xs) rest + Stream (b, x:|xs) rest | b /= blim -> (s' x, g { _next = (b+1, next) +| (b, this) +| (b, xs) +| rest }) | otherwise -> (s' x, g { _next = (b, this) +| (b, xs) +| rest }) @@ -184,7 +175,7 @@ bStep siblings offspring blim (s, g) t = case _next g of _ -> halt where - (pref, suff) = let ((Start 0,_,_):px, sx) = splitAt (_prefixlen s + 1) t in ((map (\(d,_,_) -> d) px ++), sx) + (pref, suff) = splitAtF (\((Start 0,_,_):px) -> (map (\(d,_,_) -> d) px ++)) id (_prefixlen s + 1) t -- | New scheduler state, with a given list of initial decisions. s' ds = initialS { _decisions = ds, _prefixlen = length ds } diff --git a/Control/Monad/Conc/SCT/Tests.hs b/Control/Monad/Conc/SCT/Tests.hs index acc95cd..c97d34a 100644 --- a/Control/Monad/Conc/SCT/Tests.hs +++ b/Control/Monad/Conc/SCT/Tests.hs @@ -34,6 +34,7 @@ import Control.Monad (when, void) import Control.Monad.Conc.Fixed import Control.Monad.Conc.SCT.Internal import Control.Monad.Conc.SCT.Bounding +import Data.List.Extra import Data.Maybe (isJust, isNothing) import qualified Control.Monad.Conc.Fixed.IO as CIO @@ -84,19 +85,6 @@ simplify ts = map (\t -> (pref, drop plen $ take (length t - slen) t, suff)) ts suff = commonSuffix ts slen = length suff - -- | Common prefix of a bunch of lists - commonPrefix = foldl1 commonPrefix2 - - -- | Common suffix of a bunch of lists - commonSuffix = reverse . commonPrefix . map reverse - - -- | Common prefix of two lists - commonPrefix2 [] _ = [] - commonPrefix2 _ [] = [] - commonPrefix2 (x:xs) (y:ys) - | x == y = x : commonPrefix2 xs ys - | otherwise = [] - -- | Pretty-print a simplified trace showtrc :: (SCTTrace, SCTTrace, SCTTrace) -> String showtrc (p, t, s) = case (p, s) of diff --git a/Data/List/Extra.hs b/Data/List/Extra.hs new file mode 100755 index 0000000..497b697 --- /dev/null +++ b/Data/List/Extra.hs @@ -0,0 +1,54 @@ +-- | Extra list functions and list-like types. +module Data.List.Extra where + +import Control.DeepSeq (NFData(..)) + +-- * Regular lists + +-- | Split a list at an index and transform the two halves. +splitAtF :: ([a] -> b) -> ([a] -> c) -> Int -> [a] -> (b, c) +splitAtF f g i xs = let (l, r) = splitAt i xs in (f l, g r) + +-- | Get the longest common prefix of a bunch of lists. +commonPrefix :: Eq a => [[a]] -> [a] +commonPrefix [] = [] +commonPrefix ls = foldl1 commonPrefix2 ls where + commonPrefix2 [] _ = [] + commonPrefix2 _ [] = [] + commonPrefix2 (x:xs) (y:ys) + | x == y = x : commonPrefix2 xs ys + | otherwise = [] + +-- | Get the longest common suffix of a bunch of lists. +commonSuffix :: Eq a => [[a]] -> [a] +commonSuffix = reverse . commonPrefix . map reverse + +-- * Non-empty lists +-- | This gets exposed to users of the library, so it has a bunch of +-- classes which aren't actually used in the rest of the code to make +-- it more friendly to further use. + +-- | The type of non-empty lists. +data NonEmpty a = a :| [a] deriving (Eq, Ord, Read, Show) + +instance Functor NonEmpty where + fmap f (a :| as) = f a :| map f as + +instance NFData a => NFData (NonEmpty a) where + rnf (x:|xs) = rnf (x, xs) + +-- | Convert a 'NonEmpty' to a regular non-empty list. +toList :: NonEmpty a -> [a] +toList (a :| as) = a : as + +-- * Tagged streams + +-- | Data type representing a chunky, tagged, stream of data. +data Stream t a = Stream (t, NonEmpty a) (Stream t a) | Empty t + +-- | Prepend a value onto a lazy stream. +(+|) :: (t, [a]) -> Stream t a -> Stream t a +(_, []) +| l = l +(t, x:xs) +| l = Stream (t, x:|xs) l + +infixr +| diff --git a/monad-conc.cabal b/monad-conc.cabal index 7d4c224..0e2421e 100755 --- a/monad-conc.cabal +++ b/monad-conc.cabal @@ -54,6 +54,7 @@ library other-modules: Control.Monad.Conc.Fixed.Internal , Control.Monad.Conc.SCT.Bounding , Control.Monad.Conc.SCT.Internal + , Data.List.Extra -- other-extensions: build-depends: base >=4.6 && <5 , containers