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"
diceSepS
:: Monad m
=> (a -> Bool)
-> (a -> Bool)
-> Stream m a
-> Stream m (Maybe (Int, Int), Maybe (Int, Int))
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
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'
| 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)
| pEndCol x
-> return $ Yield
(Just (iSrc, 0), Nothing)
(si', f, iSrc + 1, iRowStart, iSeps + 1, True, mCol)
| otherwise
-> return $ Skip
(si', f, iSrc + 1, iRowStart, iSeps, True, Just (iSrc, 1))
Skip si'
-> return $ Skip
(si', f, iSrc, iRowStart, iSeps, inRow, mCol)
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)
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'
| pEndRow x
-> return $ Yield
( Just (iColStart, iColLen)
, Just (iRowStart, iSeps + 1))
( si', f, iSrc + 1, iRowStart + iSeps + 1, 0, False, Nothing)
| pEndCol x
-> return $ Yield
( Just (iColStart, iColLen)
, Nothing)
( si', f, iSrc + 1, iRowStart, iSeps + 1, inRow, Nothing)
| otherwise
-> return $ Skip
( si', f, iSrc + 1, iRowStart, iSeps, inRow
, Just (iColStart, iColLen + 1))
Skip si'
-> return $ Skip
( si', f, iSrc, iRowStart, iSeps, inRow, mCol)
Done
-> return $ Yield
( Just (iColStart, iColLen)
, Nothing)
( si, True, iSrc, iRowStart, iSeps, inRow, Nothing)