module Data.Repa.Stream.Dice ( diceSepS ) where import Data.Vector.Fusion.Stream.Monadic (Stream(..), Step(..)) import qualified Data.Vector.Fusion.Stream.Size as S #include "repa-stream.h" ------------------------------------------------------------------------------- -- | Given predicates that detect the begining and end of interesting segments -- of information, scan through a vector looking for when these begin -- and end. -- diceSepS :: Monad m => (a -> Bool) -- ^ Detect the end of a column. -> (a -> Bool) -- ^ Detect the end of a row. -> Stream m a -> Stream m (Maybe (Int, Int), Maybe (Int, Int)) -- ^ Segment starts and lengths diceSepS pEndCol pEndRow (Stream istep s0 sz) = Stream ostep (s0, True, 0, 0, 0, False, Nothing) (case sz of S.Exact n -> S.Max (n + 1) S.Max n -> S.Max (n + 1) S.Unknown -> S.Unknown) where ostep (_, False, _, _, _, _, _) = return Done -- We're not in an inner segment, so look for the next starting element. ostep (si, f, iSrc, iRowStart, iSeps, inRow, mCol@Nothing) = iSrc `seq` iRowStart `seq` iSeps `seq` inRow `seq` istep si >>= \m -> case m of Yield x si' -- Line ended outside a word. | pEndRow x -> let nRow = if inRow then iSeps + 1 else 0 in return $ Yield ( Just (iSrc, 0) , Just (iRowStart, nRow)) (si', f, iSrc + 1, iRowStart + nRow, 0, False, mCol) -- Inner segment started and ended on the same element. | pEndCol x -> return $ Yield (Just (iSrc, 0), Nothing) (si', f, iSrc + 1, iRowStart, iSeps + 1, True, mCol) -- Segment has started on this element. | otherwise -> return $ Skip (si', f, iSrc + 1, iRowStart, iSeps, True, Just (iSrc, 1)) -- We didn't get an element this time. Skip si' -> return $ Skip (si', f, iSrc, iRowStart, iSeps, inRow, mCol) -- Found end of input outside a segment. Done | inRow -> return $ Yield (Just (0, 0), Just (iRowStart, iSeps + 1)) (si, False, iSrc, iRowStart, iSeps, False, mCol) | otherwise -> return $ Yield (Just (0, 0), Nothing) (si, False, iSrc, iRowStart, iSeps, False, mCol) -- We're in an inner segment, looking for the ending element. ostep ( si, f, iSrc, iRowStart, iSeps, inRow , mCol@(Just (iColStart, iColLen))) = iSrc `seq` iRowStart `seq` iSeps `seq` inRow `seq` istep si >>= \m -> case m of Yield x si' -- Both inner and outer ended at this point, -- and now we're looking for a new segment start. | pEndRow x -> return $ Yield ( Just (iColStart, iColLen) , Just (iRowStart, iSeps + 1)) ( si', f, iSrc + 1, iRowStart + iSeps + 1, 0, False, Nothing) -- Inner segment ended at this point, -- but we're still in the outer segment. | pEndCol x -> return $ Yield ( Just (iColStart, iColLen) , Nothing) ( si', f, iSrc + 1, iRowStart, iSeps + 1, inRow, Nothing) -- Another element of the inner segment. | otherwise -> return $ Skip ( si', f, iSrc + 1, iRowStart, iSeps, inRow , Just (iColStart, iColLen + 1)) -- We didn't get an element this time. Skip si' -> return $ Skip ( si', f, iSrc, iRowStart, iSeps, inRow, mCol) -- Found end of input during a segment. Done -> return $ Yield ( Just (iColStart, iColLen) , Nothing) ( si, True, iSrc, iRowStart, iSeps, inRow, Nothing) {-# INLINE_STREAM diceSepS #-}