module Data.Repa.Chain.Weave
( weaveC
, Weave (..)
, Turn (..)
, Move (..), move
, Option (..))
where
import Data.Repa.Option
import Data.Repa.Chain.Base
import qualified Data.Vector.Fusion.Stream.Size as S
#include "repa-stream.h"
weaveC :: Monad m
=> (k -> Option aL -> Option aR -> m (Turn k aX))
-> k
-> Chain m sL aL
-> Chain m sR aR
-> Chain m (Weave sL aL sR aR k) aX
weaveC f !ki (Chain _sz1 s1i step1) (Chain _sz2 s2i step2)
= Chain S.Unknown
(Weave s1i None False s2i None False ki)
step
where
step ss@(Weave s1 m1 e1 s2 m2 e2 k)
= case (m1, e1, m2, e2) of
(None, False, _, _)
-> step1 s1 >>= \r1
-> return $ Skip
$ case r1 of
Yield x1 sL' -> ss { _stateL = sL', _elemL = Some x1 }
Skip sL' -> ss { _stateL = sL' }
Done sL' -> ss { _stateL = sL', _endL = True }
(_, _, None, False)
-> step2 s2 >>= \r2
-> return $ Skip
$ case r2 of
Yield x2 sR' -> ss { _stateR = sR', _elemR = Some x2 }
Skip sR' -> ss { _stateR = sR' }
Done sR' -> ss { _stateR = sR', _endR = True }
_
-> f k m1 m2 >>= \t
-> case t of
Give x k' m -> return $ Yield x (move k' m ss)
Next k' m -> return $ Skip (move k' m ss)
Finish k' m -> return $ Done (move k' m ss)
data Weave sL aL sR aR k
= Weave
{
_stateL :: !sL
, _elemL :: !(Option aL)
, _endL :: Bool
, _stateR :: !sR
, _elemR :: !(Option aR)
, _endR :: Bool
, _here :: !k }
deriving Show
data Turn k a
= Give !a !k !Move
| Next !k !Move
| Finish !k !Move
deriving Show
data Move
= MoveLeft
| MoveRight
| MoveBoth
| MoveNone
deriving Show
move :: k -> Move
-> Weave s1 a1 s2 a2 k -> Weave s1 a1 s2 a2 k
move !k' !mm !ss
= case mm of
MoveLeft -> ss { _here = k', _elemL = None }
MoveRight -> ss { _here = k', _elemR = None }
MoveBoth -> ss { _here = k', _elemL = None, _elemR = None }
MoveNone -> ss { _here = k' }