module Loopthrough(loopThroughRightSP) where
import SP
--import Spops
import Queue

loopThroughRightSP :: SP (Either a b) (Either a b) -> SP a a -> SP b b
loopThroughRightSP SP (Either a b) (Either a b)
sp1 SP a a
sp2 = QUEUE a -> SP (Either a b) (Either a b) -> SP a a -> SP b b
ltrSP forall {a}. QUEUE a
empty SP (Either a b) (Either a b)
sp1 SP a a
sp2

-- When sp1 and sp2 are unknown:
ltrSP :: QUEUE a -> SP (Either a b) (Either a b) -> SP a a -> SP b b
ltrSP QUEUE a
q SP (Either a b) (Either a b)
sp1 SP a a
sp2 =
    case SP (Either a b) (Either a b)
sp1 of
      PutSP (Right b
out) SP (Either a b) (Either a b)
sp1' -> forall a b. b -> SP a b -> SP a b
PutSP b
out (QUEUE a -> SP (Either a b) (Either a b) -> SP a a -> SP b b
ltrSP QUEUE a
q SP (Either a b) (Either a b)
sp1' SP a a
sp2)
      PutSP (Left a
loop') SP (Either a b) (Either a b)
sp1' -> QUEUE a -> SP (Either a b) (Either a b) -> SP a a -> SP b b
ltrSP (forall {a}. QUEUE a -> a -> QUEUE a
enter QUEUE a
q a
loop') SP (Either a b) (Either a b)
sp1' SP a a
sp2
      GetSP Either a b -> SP (Either a b) (Either a b)
xsp1 -> QUEUE a
-> (Either a b -> SP (Either a b) (Either a b)) -> SP a a -> SP b b
ltrSP1 QUEUE a
q Either a b -> SP (Either a b) (Either a b)
xsp1 SP a a
sp2
      SP (Either a b) (Either a b)
NullSP -> forall a b. SP a b
NullSP

-- When sp1 is waiting for input:
ltrSP1 :: QUEUE a
-> (Either a b -> SP (Either a b) (Either a b)) -> SP a a -> SP b b
ltrSP1 QUEUE a
q Either a b -> SP (Either a b) (Either a b)
xsp1 SP a a
sp2 =
    case SP a a
sp2 of
      PutSP a
x SP a a
sp2' -> QUEUE a -> SP (Either a b) (Either a b) -> SP a a -> SP b b
ltrSP QUEUE a
q (Either a b -> SP (Either a b) (Either a b)
xsp1 (forall a b. a -> Either a b
Left a
x)) SP a a
sp2'
      GetSP a -> SP a a
xsp2 ->
	case forall {a}. QUEUE a -> Maybe (a, QUEUE a)
qremove QUEUE a
q of
	  Just (a
x,QUEUE a
q') -> QUEUE a
-> (Either a b -> SP (Either a b) (Either a b)) -> SP a a -> SP b b
ltrSP1 QUEUE a
q' Either a b -> SP (Either a b) (Either a b)
xsp1 (a -> SP a a
xsp2 a
x)
	  Maybe (a, QUEUE a)
Nothing -> forall a b. (a -> SP a b) -> SP a b
GetSP (\b
x -> SP (Either a b) (Either a b) -> (a -> SP a a) -> SP b b
ltrSP2 (Either a b -> SP (Either a b) (Either a b)
xsp1 (forall a b. b -> Either a b
Right b
x)) a -> SP a a
xsp2)
      SP a a
NullSP -> forall a b. (a -> SP a b) -> SP a b
GetSP (forall {a} {a} {a} {b}. SP (Either a a) (Either a b) -> SP a b
lltrSP forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either a b -> SP (Either a b) (Either a b)
xsp1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right)

-- When sp2 is waiting for input:
ltrSP2 :: SP (Either a b) (Either a b) -> (a -> SP a a) -> SP b b
ltrSP2 SP (Either a b) (Either a b)
sp1 a -> SP a a
xsp2 =
    case SP (Either a b) (Either a b)
sp1 of
      PutSP (Right b
out) SP (Either a b) (Either a b)
sp1' -> forall a b. b -> SP a b -> SP a b
PutSP b
out (SP (Either a b) (Either a b) -> (a -> SP a a) -> SP b b
ltrSP2 SP (Either a b) (Either a b)
sp1' a -> SP a a
xsp2)
      PutSP (Left a
loop') SP (Either a b) (Either a b)
sp1' -> SP (Either a b) (Either a b) -> SP a a -> SP b b
loopThroughRightSP SP (Either a b) (Either a b)
sp1' (a -> SP a a
xsp2 a
loop')
      GetSP Either a b -> SP (Either a b) (Either a b)
xsp1 -> forall a b. (a -> SP a b) -> SP a b
GetSP (\b
x -> SP (Either a b) (Either a b) -> (a -> SP a a) -> SP b b
ltrSP2 (Either a b -> SP (Either a b) (Either a b)
xsp1 (forall a b. b -> Either a b
Right b
x)) a -> SP a a
xsp2)
      SP (Either a b) (Either a b)
NullSP -> forall a b. SP a b
NullSP

-- When sp2 has terminated:
lltrSP :: SP (Either a a) (Either a b) -> SP a b
lltrSP SP (Either a a) (Either a b)
sp1 =
    case SP (Either a a) (Either a b)
sp1 of
      PutSP (Right b
out) SP (Either a a) (Either a b)
sp1' -> forall a b. b -> SP a b -> SP a b
PutSP b
out (SP (Either a a) (Either a b) -> SP a b
lltrSP SP (Either a a) (Either a b)
sp1')
      PutSP (Left a
loop') SP (Either a a) (Either a b)
sp1' -> SP (Either a a) (Either a b) -> SP a b
lltrSP SP (Either a a) (Either a b)
sp1'
      GetSP Either a a -> SP (Either a a) (Either a b)
xsp1 -> forall a b. (a -> SP a b) -> SP a b
GetSP (SP (Either a a) (Either a b) -> SP a b
lltrSP forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either a a -> SP (Either a a) (Either a b)
xsp1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right)
      SP (Either a a) (Either a b)
NullSP -> forall a b. SP a b
NullSP

{- old (inefficient queueing and too strict in sp2):

loopThroughRightSP sp1 sp2 =
    case sp1 of
      PutSP (Right out) sp1' -> PutSP out (loopThroughRightSP sp1' sp2)
      PutSP (Left loop') sp1' -> case sp2 of
                                  GetSP xsp2 -> loopThroughRightSP sp1'
                                                                   (xsp2 loop')
                                  NullSP -> lltrSP sp1'
                                  _ -> loopThroughRightSP sp1'
                                                          (feedSP' loop' [] sp2)
      GetSP xsp1 -> ltrSP1 xsp1 sp2
      NullSP -> NullSP

ltrSP1 xsp1 sp2 =
    case sp2 of
      PutSP x sp2' -> loopThroughRightSP (xsp1 (Left x)) sp2'
      GetSP xsp2 -> GetSP (\x -> ltrSP2 (xsp1 (Right x)) xsp2)
      NullSP -> GetSP (lltrSP . xsp1 . Right)

ltrSP2 sp1 xsp2 =
    case sp1 of
      PutSP (Right out) sp1' -> PutSP out (ltrSP2 sp1' xsp2)
      PutSP (Left loop') sp1' -> loopThroughRightSP sp1' (xsp2 loop')
      GetSP xsp1 -> GetSP (\x -> ltrSP2 (xsp1 (Right x)) xsp2)
      NullSP -> NullSP

lltrSP sp1 =
    case sp1 of
      PutSP (Right out) sp1' -> PutSP out (lltrSP sp1')
      PutSP (Left loop') sp1' -> lltrSP sp1'
      GetSP xsp1 -> GetSP (lltrSP . xsp1 . Right)
      NullSP -> NullSP

-- normal code
feedSP' = feedSP

-}