module Loop(loopLeftSP,loopSP,loopOnlySP) where
import SP
import Queue

-- New versions with explicit queues for improved efficiency:
-- (Adding a message to the loop queue is O(1) instead of O(n), n=queue length.)

loopLeftSP :: SP (Either a a) (Either a b) -> SP a b
loopLeftSP SP (Either a a) (Either a b)
sp = QUEUE a -> SP (Either a a) (Either a b) -> SP a b
llSP QUEUE a
forall a. QUEUE a
empty SP (Either a a) (Either a b)
sp
  where
    llSP :: QUEUE a -> SP (Either a a) (Either a b) -> SP a b
llSP QUEUE a
q SP (Either a a) (Either a b)
sp =
      case SP (Either a a) (Either a b)
sp of
	PutSP (Right b
out) SP (Either a a) (Either a b)
sp' -> b -> SP a b -> SP a b
forall a b. b -> SP a b -> SP a b
PutSP b
out (QUEUE a -> SP (Either a a) (Either a b) -> SP a b
llSP QUEUE a
q SP (Either a a) (Either a b)
sp')
	PutSP (Left a
loop') SP (Either a a) (Either a b)
sp' -> QUEUE a -> SP (Either a a) (Either a b) -> SP a b
llSP (QUEUE a -> a -> QUEUE a
forall a. QUEUE a -> a -> QUEUE a
enter QUEUE a
q a
loop') SP (Either a a) (Either a b)
sp'
	GetSP Either a a -> SP (Either a a) (Either a b)
xsp ->
	  case QUEUE a -> Maybe (a, QUEUE a)
forall a. QUEUE a -> Maybe (a, QUEUE a)
qremove QUEUE a
q of
	    Just (a
loop',QUEUE a
q') -> QUEUE a -> SP (Either a a) (Either a b) -> SP a b
llSP QUEUE a
q' (Either a a -> SP (Either a a) (Either a b)
xsp (a -> Either a a
forall a b. a -> Either a b
Left a
loop'))
	    Maybe (a, QUEUE a)
Nothing -> (a -> SP a b) -> SP a b
forall a b. (a -> SP a b) -> SP a b
GetSP (SP (Either a a) (Either a b) -> SP a b
loopLeftSP(SP (Either a a) (Either a b) -> SP a b)
-> (a -> SP (Either a a) (Either a b)) -> a -> SP a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Either a a -> SP (Either a a) (Either a b)
xsp(Either a a -> SP (Either a a) (Either a b))
-> (a -> Either a a) -> a -> SP (Either a a) (Either a b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.a -> Either a a
forall a b. b -> Either a b
Right)
	SP (Either a a) (Either a b)
NullSP -> SP a b
forall a b. SP a b
NullSP

loopSP :: SP a a -> SP a a
loopSP SP a a
sp = QUEUE a -> SP a a -> SP a a
lSP QUEUE a
forall a. QUEUE a
empty SP a a
sp
  where
    lSP :: QUEUE a -> SP a a -> SP a a
lSP QUEUE a
q SP a a
sp =
      case SP a a
sp of
	PutSP a
x SP a a
sp' -> a -> SP a a -> SP a a
forall a b. b -> SP a b -> SP a b
PutSP a
x (QUEUE a -> SP a a -> SP a a
lSP (QUEUE a -> a -> QUEUE a
forall a. QUEUE a -> a -> QUEUE a
enter QUEUE a
q a
x) SP a a
sp')
	GetSP a -> SP a a
xsp ->
	  case QUEUE a -> Maybe (a, QUEUE a)
forall a. QUEUE a -> Maybe (a, QUEUE a)
qremove QUEUE a
q of
	    Just (a
x,QUEUE a
q') -> QUEUE a -> SP a a -> SP a a
lSP QUEUE a
q' (a -> SP a a
xsp a
x)
	    Maybe (a, QUEUE a)
Nothing -> (a -> SP a a) -> SP a a
forall a b. (a -> SP a b) -> SP a b
GetSP (SP a a -> SP a a
loopSP(SP a a -> SP a a) -> (a -> SP a a) -> a -> SP a a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.a -> SP a a
xsp)
	SP a a
NullSP -> SP a a
forall a b. SP a b
NullSP

loopOnlySP :: SP a a -> SP a b
loopOnlySP SP a a
sp = QUEUE a -> SP a a -> SP a b
loSP QUEUE a
forall a. QUEUE a
empty SP a a
sp
  where
    loSP :: QUEUE a -> SP a a -> SP a b
loSP QUEUE a
q SP a a
sp =
      case SP a a
sp of
	PutSP a
x SP a a
sp' -> QUEUE a -> SP a a -> SP a b
loSP (QUEUE a -> a -> QUEUE a
forall a. QUEUE a -> a -> QUEUE a
enter QUEUE a
q a
x) SP a a
sp'
	GetSP a -> SP a a
xsp ->
	  case QUEUE a -> Maybe (a, QUEUE a)
forall a. QUEUE a -> Maybe (a, QUEUE a)
qremove QUEUE a
q of
	    Just (a
x,QUEUE a
q') -> QUEUE a -> SP a a -> SP a b
loSP QUEUE a
q' (a -> SP a a
xsp a
x)
	    Maybe (a, QUEUE a)
Nothing -> (a -> SP a b) -> SP a b
forall a b. (a -> SP a b) -> SP a b
GetSP (SP a a -> SP a b
loopOnlySP(SP a a -> SP a b) -> (a -> SP a a) -> a -> SP a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
.a -> SP a a
xsp)
	SP a a
NullSP -> SP a b
forall a b. SP a b
NullSP


{--- old:

loopLeftSP sp =
    case sp of
      PutSP (Right out) sp' -> PutSP out (loopLeftSP sp')
      PutSP (Left loop') sp' -> loopLeftSP (feed1SP (Left loop') sp')
      GetSP xsp -> GetSP (loopLeftSP.xsp.Right)
      NullSP -> NullSP

loopSP sp =
  case sp of
    PutSP x sp' -> PutSP x (loopSP (feed1SP x sp'))
    GetSP xsp -> GetSP (loopSP.xsp)
    NullSP -> NullSP

loopOnlySP sp =
  case sp of
    PutSP x sp' -> loopOnlySP (feed1SP x sp')
    GetSP xsp -> GetSP (loopOnlySP.xsp)
    NullSP -> NullSP

feed1SP x sp =
    case sp of
      PutSP y sp' -> PutSP y (feed1SP x sp')
      GetSP xsp' -> xsp' x
      NullSP -> NullSP
-}