module Spops(module Spops,Cont(..)) where
import SP
import EitherUtils(Cont(..))

{- INLINE nullSP -}
nullSP :: SP a b
nullSP :: forall a b. SP a b
nullSP = forall a b. SP a b
NullSP

putsSP :: [b] -> SP a b -> SP a b
putsSP :: forall b a. [b] -> SP a b -> SP a b
putsSP [] SP a b
sp = SP a b
sp
putsSP (b
x : [b]
xs) SP a b
sp = forall a b. b -> SP a b -> SP a b
PutSP b
x (forall b a. [b] -> SP a b -> SP a b
putsSP [b]
xs SP a b
sp)

{- INLINE putSP -}
putSP :: b -> SP a b -> SP a b
putSP :: forall b a. b -> SP a b -> SP a b
putSP = forall a b. b -> SP a b -> SP a b
PutSP

appendStartSP :: [b] -> SP a b -> SP a b
appendStartSP :: forall b a. [b] -> SP a b -> SP a b
appendStartSP [b]
zs (PutSP b
y SP a b
sp) = forall a b. b -> SP a b -> SP a b
PutSP b
y (forall b a. [b] -> SP a b -> SP a b
putsSP [b]
zs SP a b
sp)
appendStartSP [b]
zs SP a b
sp = forall b a. [b] -> SP a b -> SP a b
putsSP [b]
zs SP a b
sp

stepSP :: [b] -> Cont (SP a b) a
stepSP :: forall b a. [b] -> Cont (SP a b) a
stepSP [b]
ys a -> SP a b
xsp = forall b a. [b] -> SP a b -> SP a b
putsSP [b]
ys (forall a b. (a -> SP a b) -> SP a b
GetSP a -> SP a b
xsp)

getSP :: Cont (SP a b) a
getSP :: forall a b. (a -> SP a b) -> SP a b
getSP = forall a b. (a -> SP a b) -> SP a b
GetSP

walkSP :: SP a a -> a -> ([a], SP a a)
walkSP SP a a
sp a
x =
    case SP a a
sp of
      PutSP a
y SP a a
sp' -> let ([a]
ys, SP a a
sp'') = SP a a -> a -> ([a], SP a a)
walkSP SP a a
sp' a
x
                     in  (a
y forall a. a -> [a] -> [a]
: [a]
ys, SP a a
sp'')
      GetSP a -> SP a a
xsp' -> forall {a} {a}. SP a a -> ([a], SP a a)
pullSP (a -> SP a a
xsp' a
x)
      SP a a
NullSP -> ([], forall a b. SP a b
NullSP)

pullSP :: SP a a -> ([a], SP a a)
pullSP SP a a
sp =
    case SP a a
sp of
      PutSP a
y SP a a
sp' -> let ([a]
ys, SP a a
sp'') = SP a a -> ([a], SP a a)
pullSP SP a a
sp'
                     in  (a
y forall a. a -> [a] -> [a]
: [a]
ys, SP a a
sp'')
      SP a a
_ -> ([], SP a a
sp)

runSP :: SP a a -> [a] -> [a]
runSP SP a a
sp [a]
xs =
    case SP a a
sp of
      PutSP a
y SP a a
sp' -> a
y forall a. a -> [a] -> [a]
: SP a a -> [a] -> [a]
runSP SP a a
sp' [a]
xs
      GetSP a -> SP a a
xsp -> case [a]
xs of
                     a
x : [a]
xs' -> SP a a -> [a] -> [a]
runSP (a -> SP a a
xsp a
x) [a]
xs'
                     [] -> []
      SP a a
NullSP -> []

feedSP :: a -> [a] -> SP a b -> SP a b
feedSP :: forall a b. a -> [a] -> SP a b -> SP a b
feedSP a
x [a]
xs SP a b
sp =
    case SP a b
sp of
      PutSP b
y SP a b
sp' -> forall a b. b -> SP a b -> SP a b
PutSP b
y (forall a b. a -> [a] -> SP a b -> SP a b
feedSP a
x [a]
xs SP a b
sp')
      GetSP a -> SP a b
xsp' -> forall a b. [a] -> SP a b -> SP a b
startupSP [a]
xs (a -> SP a b
xsp' a
x)
      SP a b
NullSP -> forall a b. SP a b
NullSP

startupSP :: [a] -> SP a b -> SP a b
startupSP :: forall a b. [a] -> SP a b -> SP a b
startupSP [] SP a b
sp = SP a b
sp
startupSP (a
x : [a]
xs) SP a b
sp = forall a b. a -> [a] -> SP a b -> SP a b
feedSP a
x [a]
xs SP a b
sp

delaySP :: SP a b -> SP a b
delaySP SP a b
sp = forall a b. (a -> SP a b) -> SP a b
GetSP (\a
x -> forall a b. [a] -> SP a b -> SP a b
startupSP [a
x] SP a b
sp)

mapSP :: (t -> b) -> SP t b
mapSP t -> b
f = SP t b
m where m :: SP t b
m = forall a b. (a -> SP a b) -> SP a b
GetSP (\t
x -> forall a b. b -> SP a b -> SP a b
PutSP (t -> b
f t
x) SP t b
m)

idSP :: SP b b
idSP = forall a b. (a -> SP a b) -> SP a b
GetSP (\b
x -> forall a b. b -> SP a b -> SP a b
PutSP b
x SP b b
idSP)

--and concatMapSP :: (*a->[*b]) -> SP *a *b
concatMapSP :: (t -> [b]) -> SP t b
concatMapSP t -> [b]
f = SP t b
m where m :: SP t b
m = forall a b. (a -> SP a b) -> SP a b
GetSP (\t
x -> forall b a. [b] -> SP a b -> SP a b
putsSP (t -> [b]
f t
x) SP t b
m)

concmapSP :: (t -> [b]) -> SP t b
concmapSP = forall {t} {b}. (t -> [b]) -> SP t b
concatMapSP

concatMapAccumlSP :: (t -> a -> (t, [b])) -> t -> SP a b
concatMapAccumlSP t -> a -> (t, [b])
f t
s0 =
    forall a b. (a -> SP a b) -> SP a b
GetSP (\a
x ->
           let (t
s, [b]
y) = t -> a -> (t, [b])
f t
s0 a
x
           in forall b a. [b] -> SP a b -> SP a b
putsSP [b]
y ((t -> a -> (t, [b])) -> t -> SP a b
concatMapAccumlSP t -> a -> (t, [b])
f t
s))

mapstateSP :: (t -> a -> (t, [b])) -> t -> SP a b
mapstateSP = forall {t} {a} {b}. (t -> a -> (t, [b])) -> t -> SP a b
concatMapAccumlSP

mapAccumlSP :: (t -> a -> (t, b)) -> t -> SP a b
mapAccumlSP t -> a -> (t, b)
f t
s0 =
    forall a b. (a -> SP a b) -> SP a b
GetSP (\a
x ->
           let (t
s, b
y) = t -> a -> (t, b)
f t
s0 a
x
           in forall a b. b -> SP a b -> SP a b
PutSP b
y ((t -> a -> (t, b)) -> t -> SP a b
mapAccumlSP t -> a -> (t, b)
f t
s))

concatSP :: SP [b] b
concatSP = forall a b. (a -> SP a b) -> SP a b
GetSP (\[b]
xs -> forall b a. [b] -> SP a b -> SP a b
putsSP [b]
xs SP [b] b
concatSP)
concSP :: SP [b] b
concSP = forall {b}. SP [b] b
concatSP

zipSP :: [a] -> SP b (a, b)
zipSP (a
x : [a]
xs) = forall a b. (a -> SP a b) -> SP a b
getSP (\b
y -> forall b a. b -> SP a b -> SP a b
putSP (a
x, b
y) ([a] -> SP b (a, b)
zipSP [a]
xs))
zipSP [] = forall a b. SP a b
nullSP

filterSP :: (b -> Bool) -> SP b b
filterSP b -> Bool
p = forall a b. (a -> SP a b) -> SP a b
getSP (\b
x -> (if b -> Bool
p b
x then forall b a. b -> SP a b -> SP a b
putSP b
x else forall a. a -> a
id) ((b -> Bool) -> SP b b
filterSP b -> Bool
p))

splitAtElemSP :: (a -> Bool) -> Cont (SP a b) [a]
splitAtElemSP :: forall a b. (a -> Bool) -> Cont (SP a b) [a]
splitAtElemSP a -> Bool
p [a] -> SP a b
xsp =
    let lSP :: [a] -> SP a b
lSP [a]
acc =
            forall a b. (a -> SP a b) -> SP a b
getSP (\a
x -> if a -> Bool
p a
x then [a] -> SP a b
xsp (forall a. [a] -> [a]
reverse [a]
acc) else [a] -> SP a b
lSP (a
x forall a. a -> [a] -> [a]
: [a]
acc))
    in  [a] -> SP a b
lSP []

chopSP :: ((b -> SP a b) -> SP a b) -> SP a b
chopSP (b -> SP a b) -> SP a b
splitSP' = (b -> SP a b) -> SP a b
splitSP' (\b
xs -> forall b a. b -> SP a b -> SP a b
putSP b
xs (((b -> SP a b) -> SP a b) -> SP a b
chopSP (b -> SP a b) -> SP a b
splitSP'))