# LANGUAGE NoImplicitPrelude #
module Coroutine () where

  import Control .  . Freer . Coroutine



 -- First example of coroutines 
 yieldInt : : Member ( Yield Int ( ) ) r = > Int - > Eff r ( ) 
 yieldInt = yield 

 th1 : : Member ( Yield Int ( ) ) r = > Eff r ( ) 
 th1 = yieldInt 1 > > yieldInt 2 


 c1 =  ( loop = < < runC th1 ) 
  where loop ( Y x k ) = trace ( show (  ) ) > > k ( ) > > = loop 
        loop Done     = trace " Done " 
 { - 
 1 
 2 
 Done 


-- First example of coroutines
yieldInt :: Member (Yield Int ()) r => Int -> Eff r ()
yieldInt = yield

th1 :: Member (Yield Int ()) r => Eff r ()
th1 = yieldInt 1 >> yieldInt 2


c1 = runTrace (loop =<< runC th1)
 where loop (Y x k) = trace (show (x::Int)) >> k () >>= loop
       loop Done    = trace "Done"
{-
1
2
Done
-}

-- Add dynamic variables
-- The code is essentially the same as that in transf.hs (only added
-- a type specializtion on yield). The inferred signature is different though.
-- Before it was
--    th2 :: MonadReader Int m => CoT Int m ()
-- Now it is more general:
th2 :: (Member (Yield Int ()) r, Member (Reader Int) r) => Eff r ()
th2 = ask >>= yieldInt >> (ask >>= yieldInt)


-- Code is essentially the same as in transf.hs; no liftIO though
c2 = runTrace $ runReader (loop =<< runC th2) (10::Int)
 where loop (Y x k) = trace (show (x::Int)) >> k () >>= loop
       loop Done    = trace "Done"

 10 
 10 
 Done 

10
10
Done
-}

-- locally changing the dynamic environment for the suspension
c21 = runTrace $ runReader (loop =<< runC th2) (10::Int)
 where loop (Y x k) = trace (show (x::Int)) >> local (+(1::Int)) (k ()) >>= loop
       loop Done    = trace "Done"

 10 
 11 
 Done 

10
11
Done
-}

  Real example , with two sorts of local rebinding
th3 :: (Member (Yield Int ()) r, Member (Reader Int) r) => Eff r ()
th3 = ay >> ay >> local (+(10::Int)) (ay >> ay)
 where ay = ask >>= yieldInt

c3 = runTrace $ runReader (loop =<< runC th3) (10::Int)
 where loop (Y x k) = trace (show (x::Int)) >> k () >>= loop
       loop Done    = trace "Done"

 10 
 10 
 20 
 20 
 Done 

10
10
20
20
Done
-}

-- locally changing the dynamic environment for the suspension
c31 = runTrace $ runReader (loop =<< runC th3) (10::Int)
 where loop (Y x k) = trace (show (x::Int)) >> local (+(1::Int)) (k ()) >>= loop
       loop Done    = trace "Done"

 10 
 11 
 21 
 21 
 Done 

10
11
21
21
Done
-}
-- The result is exactly as expected and desired: the coroutine shares the
-- dynamic environment with its parent; however, when the environment
-- is locally rebound, it becomes private to coroutine.

-- We now make explicit that the client computation, run by th4,
-- is abstract. We abstract it out of th4
c4 = runTrace $ runReader (loop =<< runC (th4 client)) (10::Int)
 where loop (Y x k) = trace (show (x::Int)) >> local (+(1::Int)) (k ()) >>= loop
       loop Done    = trace "Done"

       -- cl, client, ay are monomorphic bindings
       th4 cl = cl >> local (+(10::Int)) cl
       client = ay >> ay
       ay     = ask >>= yieldInt


 10 
 11 
 21 
 21 
 Done 

10
11
21
21
Done
-}

-- Even more dynamic example
c5 = runTrace $ runReader (loop =<< runC (th client)) (10::Int)
 where loop (Y x k) = trace (show (x::Int)) >> local (\y->x+1) (k ()) >>= loop
       loop Done    = trace "Done"

       -- cl, client, ay are monomorphic bindings
       client = ay >> ay >> ay
       ay     = ask >>= yieldInt

       -- There is no polymorphic recursion here
       th cl = do
         cl
         v <- ask
         (if v > (20::Int) then id else local (+(5::Int))) cl
         if v > (20::Int) then return () else local (+(10::Int)) (th cl)

 10 
 11 
 12 
 18 
 18 
 18 
 29 
 29 
 29 
 29 
 29 
 29 
 Done 

10
11
12
18
18
18
29
29
29
29
29
29
Done
-}

-- And even more
c7 = runTrace $
      runReader (runReader (loop =<< runC (th client)) (10::Int)) (1000::Double)
 where loop (Y x k) = trace (show (x::Int)) >>
                      local (\y->fromIntegral (x+1)::Double) (k ()) >>= loop
       loop Done    = trace "Done"

       -- cl, client, ay are monomorphic bindings
       client = ay >> ay >> ay
       ay     = ask >>= \x -> ask >>=
                 \y -> yieldInt (x + round (y::Double))

       -- There is no polymorphic recursion here
       th cl = do
         cl
         v <- ask
         (if v > (20::Int) then id else local (+(5::Int))) cl
         if v > (20::Int) then return () else local (+(10::Int)) (th cl)


 1010 
 1021 
 1032 
 1048 
 1064 
 1080 
 1101 
 1122 
 1143 
 1169 
 1195 
 1221 
 1252 
 1283 
 1314 
 1345 
 1376 
 1407 
 Done 

1010
1021
1032
1048
1064
1080
1101
1122
1143
1169
1195
1221
1252
1283
1314
1345
1376
1407
Done
-}

c7' = runTrace $
      runReader (runReader (loop =<< runC (th client)) (10::Int)) (1000::Double)
 where loop (Y x k) = trace (show (x::Int)) >>
                      local (\y->fromIntegral (x+1)::Double) (k ()) >>= loop
       loop Done    = trace "Done"

       -- cl, client, ay are monomorphic bindings
       client = ay >> ay >> ay
       ay     = ask >>= \x -> ask >>=
                 \y -> yieldInt (x + round (y::Double))

       -- There is no polymorphic recursion here
       th cl = do
         cl
         v <- ask
         (if v > (20::Int) then id else local (+(5::Double))) cl
         if v > (20::Int) then return () else local (+(10::Int)) (th cl)

 1010 
 1021 
 1032 
 1048 
 1048 
 1048 
 1069 
 1090 
 1111 
 1137 
 1137 
 1137 
 1168 
 1199 
 1230 
 1261 
 1292 
 1323 
 Done 

1010
1021
1032
1048
1048
1048
1069
1090
1111
1137
1137
1137
1168
1199
1230
1261
1292
1323
Done
-}

-}

 First example of coroutines 
 First example of coroutines

1
2
Done

 Add dynamic variables
 The code is essentially the same as that in transf.hs (only added
 a type specializtion on yield). The inferred signature is different though.
 Before it was
    th2 :: MonadReader Int m => CoT Int m ()
 Now it is more general:
 Code is essentially the same as in transf.hs; no liftIO though
 locally changing the dynamic environment for the suspension
 locally changing the dynamic environment for the suspension
 The result is exactly as expected and desired: the coroutine shares the
 dynamic environment with its parent; however, when the environment
 is locally rebound, it becomes private to coroutine.
 We now make explicit that the client computation, run by th4,
 is abstract. We abstract it out of th4
 cl, client, ay are monomorphic bindings
 Even more dynamic example
 cl, client, ay are monomorphic bindings
 There is no polymorphic recursion here
 And even more
 cl, client, ay are monomorphic bindings
 There is no polymorphic recursion here
 cl, client, ay are monomorphic bindings
 There is no polymorphic recursion here
# LANGUAGE NoImplicitPrelude #
module Coroutine () where

  import Control .  . Freer . Coroutine



 yieldInt : : Member ( Yield Int ( ) ) r = > Int - > Eff r ( ) 
 yieldInt = yield 

 th1 : : Member ( Yield Int ( ) ) r = > Eff r ( ) 
 th1 = yieldInt 1 > > yieldInt 2 


 c1 =  ( loop = < < runC th1 ) 
  where loop ( Y x k ) = trace ( show (  ) ) > > k ( ) > > = loop 
        loop Done     = trace " Done " 
 { - 
 1 
 2 
 Done 


yieldInt :: Member (Yield Int ()) r => Int -> Eff r ()
yieldInt = yield

th1 :: Member (Yield Int ()) r => Eff r ()
th1 = yieldInt 1 >> yieldInt 2


c1 = runTrace (loop =<< runC th1)
 where loop (Y x k) = trace (show (x::Int)) >> k () >>= loop
       loop Done    = trace "Done"

th2 :: (Member (Yield Int ()) r, Member (Reader Int) r) => Eff r ()
th2 = ask >>= yieldInt >> (ask >>= yieldInt)


c2 = runTrace $ runReader (loop =<< runC th2) (10::Int)
 where loop (Y x k) = trace (show (x::Int)) >> k () >>= loop
       loop Done    = trace "Done"

 10 
 10 
 Done 

10
10
Done
-}

c21 = runTrace $ runReader (loop =<< runC th2) (10::Int)
 where loop (Y x k) = trace (show (x::Int)) >> local (+(1::Int)) (k ()) >>= loop
       loop Done    = trace "Done"

 10 
 11 
 Done 

10
11
Done
-}

  Real example , with two sorts of local rebinding
th3 :: (Member (Yield Int ()) r, Member (Reader Int) r) => Eff r ()
th3 = ay >> ay >> local (+(10::Int)) (ay >> ay)
 where ay = ask >>= yieldInt

c3 = runTrace $ runReader (loop =<< runC th3) (10::Int)
 where loop (Y x k) = trace (show (x::Int)) >> k () >>= loop
       loop Done    = trace "Done"

 10 
 10 
 20 
 20 
 Done 

10
10
20
20
Done
-}

c31 = runTrace $ runReader (loop =<< runC th3) (10::Int)
 where loop (Y x k) = trace (show (x::Int)) >> local (+(1::Int)) (k ()) >>= loop
       loop Done    = trace "Done"

 10 
 11 
 21 
 21 
 Done 

10
11
21
21
Done
-}

c4 = runTrace $ runReader (loop =<< runC (th4 client)) (10::Int)
 where loop (Y x k) = trace (show (x::Int)) >> local (+(1::Int)) (k ()) >>= loop
       loop Done    = trace "Done"

       th4 cl = cl >> local (+(10::Int)) cl
       client = ay >> ay
       ay     = ask >>= yieldInt


 10 
 11 
 21 
 21 
 Done 

10
11
21
21
Done
-}

c5 = runTrace $ runReader (loop =<< runC (th client)) (10::Int)
 where loop (Y x k) = trace (show (x::Int)) >> local (\y->x+1) (k ()) >>= loop
       loop Done    = trace "Done"

       client = ay >> ay >> ay
       ay     = ask >>= yieldInt

       th cl = do
         cl
         v <- ask
         (if v > (20::Int) then id else local (+(5::Int))) cl
         if v > (20::Int) then return () else local (+(10::Int)) (th cl)

 10 
 11 
 12 
 18 
 18 
 18 
 29 
 29 
 29 
 29 
 29 
 29 
 Done 

10
11
12
18
18
18
29
29
29
29
29
29
Done
-}

c7 = runTrace $
      runReader (runReader (loop =<< runC (th client)) (10::Int)) (1000::Double)
 where loop (Y x k) = trace (show (x::Int)) >>
                      local (\y->fromIntegral (x+1)::Double) (k ()) >>= loop
       loop Done    = trace "Done"

       client = ay >> ay >> ay
       ay     = ask >>= \x -> ask >>=
                 \y -> yieldInt (x + round (y::Double))

       th cl = do
         cl
         v <- ask
         (if v > (20::Int) then id else local (+(5::Int))) cl
         if v > (20::Int) then return () else local (+(10::Int)) (th cl)


 1010 
 1021 
 1032 
 1048 
 1064 
 1080 
 1101 
 1122 
 1143 
 1169 
 1195 
 1221 
 1252 
 1283 
 1314 
 1345 
 1376 
 1407 
 Done 

1010
1021
1032
1048
1064
1080
1101
1122
1143
1169
1195
1221
1252
1283
1314
1345
1376
1407
Done
-}

c7' = runTrace $
      runReader (runReader (loop =<< runC (th client)) (10::Int)) (1000::Double)
 where loop (Y x k) = trace (show (x::Int)) >>
                      local (\y->fromIntegral (x+1)::Double) (k ()) >>= loop
       loop Done    = trace "Done"

       client = ay >> ay >> ay
       ay     = ask >>= \x -> ask >>=
                 \y -> yieldInt (x + round (y::Double))

       th cl = do
         cl
         v <- ask
         (if v > (20::Int) then id else local (+(5::Double))) cl
         if v > (20::Int) then return () else local (+(10::Int)) (th cl)

 1010 
 1021 
 1032 
 1048 
 1048 
 1048 
 1069 
 1090 
 1111 
 1137 
 1137 
 1137 
 1168 
 1199 
 1230 
 1261 
 1292 
 1323 
 Done 

1010
1021
1032
1048
1048
1048
1069
1090
1111
1137
1137
1137
1168
1199
1230
1261
1292
1323
Done
-}

-}
