Commit 071aaed6 authored by Hans-Peter Deifel's avatar Hans-Peter Deifel
Browse files

Random stuff that improves performance

[skip ci]
parent 1b23b6b3
......@@ -44,12 +44,14 @@ library
, MA.Algorithm.Types
, MA.Algorithm.Initialize
, MA.Algorithm.Split
, MA.Algorithm.Internal
, MA.FunctorExpression.Type
, MA.FunctorExpression.Parser
, MA.FunctorExpression.Pretty
, MA.FunctorExpression.Sorts
, MA.FunctorExpression.Desorting
, MA.Coalgebra.Parser
, MA.Coalgebra.Parser.Class
, MA.Coalgebra.Parser.Internal
, MA.Coalgebra.RefinementTypes
, MA.PartitionPrinter
......
......@@ -29,6 +29,7 @@ module Data.RefinablePartition
, groupBy
-- * Conversion
, freeze
, unsafeStatesOfBlock
) where
import Control.Monad (forM_, when, foldM)
......@@ -41,7 +42,7 @@ import qualified Data.Vector.Algorithms.Heap as VM
import Data.Vector.Mutable (MVector)
import qualified Data.Vector.Mutable as VM
import qualified Data.Vector.Unboxed.Mutable as VU
import qualified Data.Vector.Unboxed as VUU
import qualified Data.Vector.Unboxed as VU (convert, freeze, unsafeFreeze, Vector)
import Lens.Micro
import Lens.Micro.TH
......@@ -227,25 +228,36 @@ isMarked partition s = do
-- | Return the marked states of a block.
--
-- Runtime O(n) for n == number of states in this block
markedStates :: RefinablePartition s -> Block -> ST s (V.Vector State)
markedStates :: RefinablePartition s -> Block -> ST s (VU.Vector State)
markedStates partition b = do
block <- getBlock partition b
let len = block^.unmarkedOffset - block^.startOffset
V.convert <$>
VUU.freeze (VU.slice (block^.startOffset) len (partition^.statesByBlock))
VU.freeze (VU.slice (block^.startOffset) len (partition^.statesByBlock))
-- | Return a vector of all states in a given block.
--
-- Runtime: O(n) for n == number of states in this block
statesOfBlock :: RefinablePartition s -> Block -> ST s (V.Vector State)
statesOfBlock :: RefinablePartition s -> Block -> ST s (VU.Vector State)
statesOfBlock partition b = do
block <- getBlock partition b
len <- blockSize partition b
let slice = VU.slice (block^.startOffset) len (partition^.statesByBlock)
V.convert <$> VUU.freeze slice
VU.freeze slice
-- | Return a vector of all states in a given block.
--
-- Runtime: O(n) for n == number of states in this block
unsafeStatesOfBlock :: RefinablePartition s -> Block -> ST s (VU.Vector State)
unsafeStatesOfBlock partition b = do
block <- getBlock partition b
len <- blockSize partition b
let slice = VU.slice (block^.startOffset) len (partition^.statesByBlock)
VU.unsafeFreeze slice
-- | Split a block into two new blocks for its marked and unmarked states.
--
......@@ -404,19 +416,24 @@ freeze partition = do
-- helpers
getBlock :: RefinablePartition s -> Block -> ST s BlockRepr
getBlock !partition (Block b) = VM.unsafeRead (_blocks partition) b
{-# INLINE getBlock #-}
setBlock :: RefinablePartition s -> Block -> (BlockRepr -> BlockRepr) -> ST s ()
setBlock partition (Block b) setter = VM.unsafeModify (_blocks partition) setter b
{-# INLINE setBlock #-}
getState :: RefinablePartition s -> State -> ST s StateRepr
getState partition s = VM.unsafeRead (partition^.states) s
{-# INLINE getState #-}
setState :: RefinablePartition s -> State -> (StateRepr -> StateRepr) -> ST s ()
setState partition s setter = VM.modify (partition^.states) setter s
{-# INLINE setState #-}
setStateAt :: RefinablePartition s -> Int -> (StateRepr -> StateRepr) -> ST s ()
setStateAt partition loc setter = VU.read (partition^.statesByBlock) loc >>= \state ->
setState partition state setter
{-# INLINE setStateAt #-}
newBlock :: RefinablePartition s -> Int -> Int -> ST s Block
newBlock partition beginning end = do
......
......@@ -9,6 +9,7 @@ module Data.Vector.Unboxed.Mutable.Utils
) where
import Control.Monad (foldM)
import qualified Control.Monad.ST.Strict
import Control.Monad.Primitive
import qualified Data.Vector.Unboxed.Mutable as VU
......@@ -33,8 +34,21 @@ partition :: (VU.Unbox a, PrimMonad m)
-> Int -- ^ The beginning of the region to partition (inclusive)
-> Int -- ^ The end of the region to partition (exclusive)
-> m Int
partition vec predicate = partitionM vec (return . predicate)
{-# INLINE partition #-}
partition vec predicate = go
where
go lower upper
| lower >= upper = return lower
| otherwise = do
l <- VU.read vec lower
r <- VU.read vec (upper-1)
let predL = predicate l
let predR = predicate r
if predL then go (lower+1) upper
else if not predR then go lower (upper-1)
else VU.swap vec lower (upper-1) >> go (lower+1) upper
{-# SPECIALIZE INLINE partition :: VU.MVector s Int -> (Int -> Bool) -> Int -> Int -> Control.Monad.ST.Strict.ST s Int #-}
-- | 'partition' with monadic predicate
partitionM :: (VU.Unbox a, PrimMonad m)
......
{-# LANGUAGE BangPatterns #-}
module Data.Vector.Utils
( iforM_
, sort
, sortBy
, sortOn
, hasDuplicates
, imap'
) where
import Data.Ord (comparing)
import Control.Monad (forM_)
import Data.Vector (Vector)
import qualified Data.Vector as V
import qualified Data.Vector.Mutable as VM
import qualified Data.Vector.Algorithms.Intro as V
iforM_ :: Monad m => Vector a -> (Int -> a -> m b) -> m ()
......@@ -33,3 +37,17 @@ sortOn f = V.modify (V.sortBy (comparing f))
hasDuplicates :: Eq a => Vector a -> Bool
hasDuplicates v = V.length (V.uniq v) /= V.length v
{-# INLINE hasDuplicates #-}
imap' :: (Int -> a -> b) -> Vector a -> Vector b
imap' !f !v = V.create $ do
let !len = (length v)
v' <- VM.new len
forM_ [0..len-1] $ \i -> do
let !a = v V.! i
VM.write v' i (f' i a)
return v'
where
f' !i !a = (f $! i) $! a
......@@ -19,22 +19,23 @@ import MA.Coalgebra.RefinementTypes
import MA.Algorithm.Types
import MA.Algorithm.Initialize
import MA.Algorithm.Split
import MA.Algorithm.Internal
processQueue :: RefinementInterface h => BlockQueue s -> AlgoState s h -> ST s ()
processQueue queue as = whileM $
processQueue queue as = whileM $
Queue.dequeue queue >>= \case
Nothing -> return False
Just block -> do
runReaderT (split block) (as, queue)
return True
{-# SPECIALIZE processQueue :: BlockQueue s -> AlgoState s TheFunctor -> ST s () #-}
refine ::
refine :: forall f s.
RefinementInterface f
=> Proxy f
-> Encoding (Label f) (H1 f)
-> ST s Partition
refine (_ :: Proxy f) encoding = do
refine Proxy encoding = do
queue <- Queue.empty (size encoding)
(blocks, state) <- initialize @f encoding
mapM_ (Queue.enqueue queue) blocks
......@@ -42,3 +43,4 @@ refine (_ :: Proxy f) encoding = do
processQueue queue state
Partition.freeze (partition state)
{-# SPECIALIZE refine :: Proxy TheFunctor -> Encoding (Label TheFunctor) (H1 TheFunctor) -> ST s Partition #-}
module MA.Algorithm.Internal (TheFunctor) where
import MA.FunctorExpression.Desorting (Desorted)
import MA.Functors.SomeFunctor (SomeFunctor)
type TheFunctor = Desorted SomeFunctor
......@@ -22,6 +22,7 @@ import Data.Tuple.Extra (snd3)
import Data.Vector (Vector)
import qualified Data.Vector as V
import qualified Data.Vector.Mutable as VM
import qualified Data.Vector.Unboxed as VU
import Data.Algorithm.PossibleMajorityCandidate
import Data.BlockQueue (BlockQueue)
......@@ -33,39 +34,48 @@ import MA.RefinementInterface (RefinementInterface)
import qualified MA.RefinementInterface as RI
import MA.Coalgebra.RefinementTypes
import MA.Algorithm.Types
import MA.Algorithm.Internal
type SplitM s h = ReaderT (AlgoState s h, BlockQueue s) (ST s)
split :: RefinementInterface h => Block -> SplitM s h ()
split blockS = do
(as, _) <- ask
statesOfS <- lift $ (Partition.statesOfBlock (partition as) blockS)
touchedBlocks <- collectTouchedBlocks statesOfS
touchedBlocks <- collectTouchedBlocks blockS
forM_ touchedBlocks $ \(b, v0) -> do
updateBlock b v0
whenM (lift $ Partition.hasMarked (partition as) b) $
splitBlock b
{-# SPECIALIZE split :: Block -> SplitM s TheFunctor () #-}
updateBlock :: forall s h. RefinementInterface h => Block -> H3 h -> SplitM s h ()
updateBlock b v0 = ask >>= \(as, _) -> lift $ do
markB <- Partition.markedStates (partition as) b
forM_ markB $ \x -> do
VU.forM_ markB $ \x -> do
-- We can use `head` here, since states are only marked if they have at
-- least one edge into S => toSub[x] can't be empty.
pc <- (fromEdgeRef . head <$> VM.read (toSub as) x)
!pc <- (fromEdgeRef . head <$> VM.read (toSub as) x)
>>= VM.read (lastW as)
labelsToS <- map (label . graph (encoding as)) <$> VM.read (toSub as) x
(wxS, vx, wxCwithoutS) <- RI.update @h labelsToS <$> readSTRef pc
writeSTRef pc wxCwithoutS
ps <- newSTRef wxS
VM.read (toSub as) x >>= \edges -> forM_ edges $ \(EdgeRef e) ->
VM.write (lastW as) e ps
!labelsToS <- {-# SCC readLabels #-} VM.read (toSub as) x >>= (mapM $ \e -> do
let Edge _ !lab _ = graph (encoding as) e
return $! lab)
!pc' <- readSTRef pc
(!wxS, !vx, !wxCwithoutS) <- {-# SCC riupdate #-} return $! (((RI.update @h) $! labelsToS) $! pc')
writeSTRef pc $! {-# SCC wxCwithoutS #-} wxCwithoutS
!ps <- newSTRef $! {-# SCC wxS #-} wxS
VM.read (toSub as) x >>= \(!edges) -> forM_ edges $ \(EdgeRef !e) ->
{-# SCC writelastw #-} (VM.write (lastW as) $! e) $! ps
VM.write (toSub as) x []
if vx == v0
then Partition.unmark (partition as) x
else VM.write (h3Cache as) x vx
else VM.write (h3Cache as) x $! vx
{-# SPECIALIZE updateBlock :: Block -> H3 TheFunctor -> SplitM s TheFunctor () #-}
-- b must have at least one marked state
splitBlock :: RefinementInterface h => Block -> SplitM s h ()
......@@ -79,12 +89,12 @@ splitBlock b = ask >>= \(as, queue) -> lift $ do
-- effects, this should be safe.
let unsafeH3 = unsafeDupablePerformIO . unsafeSTToIO . VM.read (h3Cache as)
!pmc <- (possibleMajorityCandidate . V.map unsafeH3) <$>
Partition.statesOfBlock (partition as) b1
!pmc <- (possibleMajorityCandidateBy' unsafeH3) <$>
Partition.unsafeStatesOfBlock (partition as) b1
-- the pmc occurs in b1, so b1' has to be non-empty
(Just b1', b2) <- Partition.splitByM (partition as) b1
(fmap (==pmc) . VM.read (h3Cache as))
(Just b1', b2) <- Partition.splitBy (partition as) b1
((==pmc) . unsafeH3)
blocks <- ((b1':maybeToList bunmarked) ++) <$> case b2 of
Nothing -> return []
......@@ -95,6 +105,7 @@ splitBlock b = ask >>= \(as, queue) -> lift $ do
ifM (b `Queue.elem` queue) (mapM_ enqueue blocks) $
deleteLargest (Partition.blockSize (partition as)) (maybeAdd b blocks)
>>= mapM_ enqueue
{-# SPECIALIZE splitBlock :: Block -> SplitM s TheFunctor () #-}
-- | Remove one largest element from the list
--
......@@ -103,20 +114,24 @@ deleteLargest :: Eq e => (e -> ST s Int) -> [e] -> ST s [e]
deleteLargest sizeFunction lst = do
zipWithSize <- traverse (\x -> (,x) <$> sizeFunction x) lst
return (delete (snd (maximumBy (compare `on` fst) zipWithSize)) lst)
{-# INLINE deleteLargest #-}
-- | Add element to list if it isn't already there
maybeAdd :: Eq e => e -> [e] -> [e]
maybeAdd e lst
| e `elem` lst = lst
| otherwise = e : lst
{-# INLINE maybeAdd #-}
collectTouchedBlocks :: forall s h. RefinementInterface h => Vector State -> SplitM s h [(Block, H3 h)]
collectTouchedBlocks statesOfS = do
collectTouchedBlocks :: forall s h. RefinementInterface h => Block -> SplitM s h [(Block, H3 h)]
collectTouchedBlocks blockS = do
(as, _) <- ask
statesOfS <- lift $ Partition.statesOfBlock (partition as) blockS
markedBlocks <- lift $ newSTRef []
lift $ forM_ statesOfS $ \y -> forM_ (pred as V.! y) $ \e -> do
lift $ VU.forM_ statesOfS $ \y -> forM_ (pred as V.! y) $ \e -> do
let Edge x _ _ = graph (encoding as) e
b <- Partition.blockOfState (partition as) x
......@@ -131,3 +146,4 @@ collectTouchedBlocks statesOfS = do
VM.modify (toSub as) (e:) x
lift $ readSTRef markedBlocks
{-# SPECIALIZE collectTouchedBlocks :: Block -> SplitM s TheFunctor [(Block, H3 TheFunctor)] #-}
......@@ -21,5 +21,3 @@ data AlgoState s h = AlgoState
, partition :: RefinablePartition s
, h3Cache :: MVector s (H3 h)
}
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE ScopedTypeVariables #-}
module MA.Coalgebra.Parser
( parseMorphisms
, morphismsParser
, ParseMorphism(..)
, SymbolTable(..)
, MorphParser
, module MA.Coalgebra.Parser.Class
) where
import Data.Void (Void)
import Data.Tuple
import Control.Monad (void)
import Data.Bifunctor
import Data.Tuple
import Data.Void (Void)
import Control.Monad.State.Strict (StateT, execStateT)
import qualified Data.HashMap.Strict as M
......@@ -32,13 +34,10 @@ import MA.Coalgebra.Parser.Internal
import MA.Coalgebra.RefinementTypes
import MA.FunctorExpression.Sorts (Sort, Sorted(..))
import MA.FunctorExpression.Type
import MA.FunctorExpression.Desorting (Desorted)
import qualified MA.Parser.Lexer as L
import MA.Parser.Types
type MorphParser l h1 = StateT (ParserState l h1) Parser
class ParseMorphism f where
parseMorphismPoint :: (Ord x) => f (MorphParser l h1 x) -> MorphParser l h1 (H1 f, Vector (x, Label f))
import MA.Coalgebra.Parser.Class
newState :: MorphParser l h1 State
newState = nextState <<%= succ
......@@ -77,8 +76,8 @@ checkUndefinedRefs = use (symbolTable . to M.toList . to (filter isUndefined)) >
newtype SymbolTable = SymbolTable { fromSymbolTable :: M.HashMap State Text }
deriving (Show,Eq,Ord,NFData)
finalizeState ::
ParserState l h1 -> (SymbolTable, Encoding (Sorted l) (Sorted h1))
finalizeState :: forall f.
ParserState (Label f) (H1 f) -> (SymbolTable, Encoding (Label (Desorted f)) (H1 (Desorted f)))
finalizeState state =
let
h1s = state ^. h1Map
......@@ -92,15 +91,12 @@ finalizeState state =
in
(SymbolTable symTab, Encoding.new h1Vec edges)
toEdges :: (State, (Sort, Vector (State, l))) -> (Vector (Encoding.Edge (Sort, l)))
toEdges (!from, (!sort, !succs)) = V.map (\(!to, !lab) -> Encoding.Edge from (sort, lab) to) succs
morphismsParser ::
morphismsParser :: forall f.
(Functor f, ParseMorphism f)
=> FunctorExpression f Sort
-> Parser (SymbolTable, Encoding (Sorted (Label f)) (Sorted (H1 f)))
-> Parser (SymbolTable, Encoding (Label (Desorted f)) (H1 (Desorted f)))
morphismsParser Variable = error "should not happen: variable" -- FIXME: Useful error message
morphismsParser (Functor sort f) = finalizeState <$> (execStateT p initState)
morphismsParser (Functor sort f) = finalizeState @f <$> (execStateT p initState)
where
p = do
void (some parsePoint)
......@@ -124,7 +120,7 @@ parseMorphisms ::
-> String
-> Text
-> Either (ParseError Char Void) ( SymbolTable
, Encoding (Sorted (Label f)) (Sorted (H1 f)))
, Encoding (Label (Desorted f)) (H1 (Desorted f)))
parseMorphisms = parse . morphismsParser
wrapper ::
......
module MA.Coalgebra.Parser.Class
( MorphParser
, ParseMorphism(..)
) where
import Data.Vector (Vector)
import Control.Monad.State.Strict (StateT, execStateT)
import MA.Coalgebra.Parser.Internal
import MA.Coalgebra.RefinementTypes
import MA.Parser.Types
type MorphParser l h1 = StateT (ParserState l h1) Parser
class ParseMorphism f where
parseMorphismPoint :: (Ord x) => f (MorphParser l h1 x) -> MorphParser l h1 (H1 f, Vector (x, Label f))
{-# LANGUAGE Strict #-}
{-# LANGUAGE CPP #-}
module MA.FunctorExpression.Desorting
( Desorted
, Sorted(..)
......@@ -20,17 +21,37 @@ desort :: FunctorExpression f Sort -> Desorted f ()
desort expr = Desorted expr ()
type instance H1 (Desorted f) = Sorted (H1 f)
#ifdef RELEASE
type instance Label (Desorted f) = Label f
type instance Weight (Desorted f) = Weight f
type instance H3 (Desorted f) = H3 f
#else
type instance Label (Desorted f) = Sorted (Label f)
type instance Weight (Desorted f) = Sorted (Weight f)
type instance H3 (Desorted f) = Sorted (H3 f)
#endif
instance RefinementInterface f => RefinementInterface (Desorted f) where
{-# SPECIALIZE instance RefinementInterface (Desorted SomeFunctor) #-}
#ifdef RELEASE
init (Sorted sort h1) labels = init @f h1 labels
#else
init (Sorted sort h1) labels = Sorted sort (init @f h1 (filterBySort sort labels))
#endif
#ifdef RELEASE
update labels w =
let (l, h3, r) = ((update @f) $! labels) $! w
in (l, h3, r)
#else
update labels (Sorted sort w) =
let (l, h3, r) = update @f (filterBySort sort labels) w
in (Sorted sort l, Sorted sort h3, Sorted sort r)
#endif
#ifndef RELEASE
-- FIXME Don't ignore sort-mismatches. Raise a lound error!
filterBySort :: Sort -> [Sorted x] -> [x]
filterBySort sort = map sortedElem . filter ((==sort) . sortedSort)
#endif
......@@ -301,22 +301,27 @@ instance RefinementInterface Polynomial where
[Label Polynomial]
-> Weight Polynomial
-> (Weight Polynomial, H3 Polynomial, Weight Polynomial)
update = curry (val . up)
update !labs !w = {-# SCC polynoial #-} val $! (up $! (labs, w))
where
val :: H3 Polynomial -> (Weight Polynomial, H3 Polynomial, Weight Polynomial)
val h3 = (fmap (== ToSub) h3, h3, fmap (== ToCompound) h3)
val !h3 =
let !toS = {-# SCC a #-} fmap (== ToSub) h3
!toC = {-# SCC a #-} fmap (== ToCompound) h3
in
(toS, h3, toC)
up :: ([Label Polynomial], Weight Polynomial) -> H3 Polynomial
up (labels, weight) = fmapIndex (\i j bi -> bi +? ((i,j) `elem` labels)) weight
up (!labels, !weight) = {-# SCC a #-} (fmapIndex $! (\i j bi -> bi +? ((i,j) `elem` labels))) $! weight
(+?) :: Bool -> Bool -> Three
(+?) a b = toEnum (fromEnum a + fromEnum b)
(+?) !a !b = {-# SCC a #-} toEnum (fromEnum a + fromEnum b)
fmapIndex :: forall a b. (Int -> Int -> a -> b) -> SumValue a -> SumValue b
fmapIndex f (SumValue s (ProductValue factors)) =
SumValue s (ProductValue (V.imap fmapFactor factors))
fmapIndex f (SumValue !s (ProductValue !factors)) =
let !res = V.imap' fmapFactor factors
in (SumValue $! s) $! (ProductValue $! res)
where
fmapFactor :: Int -> FactorValue a -> FactorValue b
fmapFactor i (ExponentialValue as) = ExponentialValue (V.imap (f i) as)
fmapFactor i other = fmap (f i 0) other
fmapFactor !i (ExponentialValue !as) = ExponentialValue (V.imap' (f i) as)
fmapFactor !i !other = (fmap $! (f i 0)) $! other
......@@ -20,7 +20,7 @@ import qualified Data.Vector as V
import MA.RefinementInterface
import MA.Coalgebra.RefinementTypes
import MA.FunctorExpression.Parser
import MA.Coalgebra.Parser
import MA.Coalgebra.Parser.Class
type Suitable f = (RefinementInterface f, Functor f, Foldable f, Traversable f, NFData (H1 f), NFData (Label f))
......@@ -94,9 +94,9 @@ instance RefinementInterface SomeFunctor where
Nothing -> Nothing
Just HRefl -> Just l
update labels (SomeWeight (f :: TypeRep tf) w) =
let myLabels = mapMaybe isSameType labels
(a, b, c) = update @tf myLabels w
update labels (SomeWeight (f :: TypeRep tf) w) = {-# SCC thefuck #-}
let myLabels = (mapMaybe $! isSameType) $! labels
(a, b, c) = (update @tf $! myLabels) $! w
in (SomeWeight f a, SomeH3 f b, SomeWeight f c)
where
......
......@@ -12,6 +12,7 @@ import Data.Maybe (isJust,isNothing,fromJust)
import qualified Data.Vector as V
import qualified Data.Vector.Algorithms.Intro as V
import qualified Data.Vector.Unboxed as VU
import Data.RefinablePartition
......@@ -60,15 +61,15 @@ statesOfBlockSpec = describe "statesOfBlock" $ do
| otherwise = 2
it "returns the correct states" $
toList (runST (make 10 3 initPart >>= flip statesOfBlock 1))
VU.toList (runST (make 10 3 initPart >>= flip statesOfBlock 1))
`shouldMatchList` [3,4,5,6,9]
it "works with empty blocks" $
toList (runST (make 5 3 initPart >>= flip statesOfBlock 2))
VU.toList (runST (make 5 3 initPart >>= flip statesOfBlock 2))
`shouldMatchList` []
it "works with block containing all states" $
toList (runST (make 3 3 initPart >>= flip statesOfBlock 0))
VU.toList (runST (make 3 3 initPart >>= flip statesOfBlock 0))
`shouldMatchList` [0,1,2]
markSpec :: Spec
......@@ -220,8 +221,8 @@ markedStatesSpec = describe "markedStates" $ do
mapM_ (mark p) states
marked <- markedStates p blk
blockStates <- toList <$> statesOfBlock p blk
return $ sort (intersect states blockStates) == sort (toList marked)
blockStates <- VU.toList <$> statesOfBlock p blk
return $ sort (intersect states blockStates) == sort (VU.toList marked)
in
property $
forAll (arbitraryBlock 3) $ \block ->
......@@ -239,9 +240,9 @@ splitMarkedSpec = describe "splitMarkedSpec" $ do
let doIt markStates block = runST $ do
p <- make 10 3 initPart
mapM_ (mark p) markStates
markedPreviously <- statesOfBlock p block >>= V.filterM (isMarked p)
markedPreviously <- statesOfBlock p block >>= VU.filterM (isMarked p)
(a, _) <- splitMarked p block
nowInBlock <- maybe (return V.empty) (statesOfBlock p) a
nowInBlock <- maybe (return VU.empty) (statesOfBlock p) a
return (nowInBlock, markedPreviously)
in
property $
......@@ -255,9 +256,9 @@ splitMarkedSpec = describe "splitMarkedSpec" $ do
p <- make 10 3 initPart
mapM_ (mark p) markStates
unMarkedPreviously <- statesOfBlock p block
>>= V.filterM (fmap not . isMarked p)
>>= VU.filterM (fmap not . isMarked p)
(_, b) <- splitMarked p block