PasteRack.org
Paste # 17650
2023-02-28 00:47:36

Fork as a new paste.

Paste viewed 549 times.


Embed:

coroutines

  1. #lang racket/base
  2. ;; coroutines implementation from https://hillside.net/plop/plop2001/accepted_submissions/PLoP2001/dferguson0/PLoP2001_dferguson0_1.pdf
  3. ;
  4. (define (coroutine-maker proc)
  5.   (define saved-continuation '())
  6.   (define (update-continuation! v)
  7.     (displayln "updating")
  8.     (set! saved-continuation v))
  9.   (define resumer (resume-maker update-continuation!))
  10.   (define first-time #t)
  11.   (define (f value)
  12.     (cond
  13.       [first-time
  14.        (set! first-time #f)
  15.        (proc resumer value)]
  16.       [else (saved-continuation value)]))
  17.   f)
  18.  
  19. (define ((resume-maker update-proc!) next-coroutine value)
  20.   (define (receiver continuation)
  21.     (update-proc! continuation)
  22.     (next-coroutine value))
  23.   (call-with-current-continuation receiver))
  24.  
  25. ;; test
  26.  
  27. (define (ping-procedure resume value)
  28.   (displayln "Pinging 1")
  29.   (resume pong value)
  30.   (displayln "Pinging 2")
  31.   (resume pong value)
  32.   (displayln "Pinging 3")
  33.   (resume pong value))
  34.  
  35. (define ping (coroutine-maker ping-procedure))
  36.  
  37. (define (pong-procedure resume value)
  38.   (displayln "Pinging 1")
  39.   (resume ping value)
  40.   (displayln "Pinging 2")
  41.   (resume ping value)
  42.   (displayln "Pinging 3")
  43.   (resume ping value))
  44.  
  45. (define pong (coroutine-maker pong-procedure))
  46.  
  47. (ping 1)

=>

Pinging 1

updating

Pinging 1

updating

Pinging 2

updating

Pinging 2

updating

Pinging 3

updating

Pinging 3

updating

1