send-lambdas.scm 3.8 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394
  1. (use-modules
  2. (fibers)
  3. (fibers channels)
  4. (ice-9 match))
  5. ;; Define a procedure to run in a fiber.
  6. (define fiber1-proc
  7. (lambda (in-chan out-chan)
  8. ;; Look for mesages.
  9. (let loop ([received-proc (lambda (data) 'no-proc-received)])
  10. (match
  11. ;; Write arguments to the current output port, and return the last
  12. ;; argument. This will get the message received and write to current
  13. ;; output port an information, that the get-message procedure was
  14. ;; called.
  15. (pk 'fiber1-proc-called-get-message
  16. (get-message in-chan))
  17. ;; Match anything tagged as procedure and store it in the argument for
  18. ;; the named let.
  19. [('proc . proc)
  20. (loop proc)]
  21. ;; Match anything labeled as data and apply the stored procedure to
  22. ;; it. If no procedure has been received yet, use the default one.
  23. [('data . data)
  24. (put-message out-chan (received-proc data))
  25. ;; Loop again with the default procedure, awaiting a new procedure and
  26. ;; data for it.
  27. (loop (lambda (data) 'no-proc-received))]
  28. ;; Have a default reaction to anything, but the correctly tagged
  29. ;; messages.
  30. [any-other-message
  31. (put-message out-chan 'unrecognized-message)
  32. ;; Allow for unrecognized messages in between correct communication.
  33. (loop received-proc)])
  34. ;; Continue looking for messages.
  35. (loop received-proc))))
  36. (run-fibers
  37. (lambda ()
  38. (let ((fiber1-in-chan (make-channel))
  39. (fiber1-out-chan (make-channel)))
  40. ;; Spawn a fiber to run fiber1-proc, which internally looks for messages on
  41. ;; its in-channel.
  42. (spawn-fiber
  43. (lambda ()
  44. (fiber1-proc fiber1-in-chan fiber1-out-chan)))
  45. ;; Send a mssage to the fiber.
  46. (put-message fiber1-in-chan
  47. ;; Send some tagged data, in this case the procedure to use.
  48. (cons 'proc
  49. ;; A procedure, which checks all things in data for
  50. ;; whether they are even numbers and builds a list of
  51. ;; the answers.
  52. (lambda (data)
  53. (let loop ([remaining-data data])
  54. (cond
  55. [(null? remaining-data) '()]
  56. [else
  57. (cons (even? (car remaining-data))
  58. (loop (cdr remaining-data)))])))))
  59. ;; Then put the data on the channel.
  60. (put-message fiber1-in-chan
  61. (cons 'data '(0 1 2 3 4 5 6 7 8 9)))
  62. ;; Look for the answer on the out-channel of the fiber.
  63. (display
  64. (simple-format
  65. #f "~a\n" (pk 'main-thread-called-peek
  66. (get-message fiber1-out-chan))))
  67. ;; And then do it again.
  68. ;; Send a mssage to the fiber.
  69. (put-message fiber1-in-chan
  70. ;; Send some tagged data, in this case the procedure to use.
  71. (cons 'proc
  72. ;; A procedure, which checks all things in data for
  73. ;; whether they are even numbers and builds a list of
  74. ;; the answers.
  75. (lambda (data)
  76. (let loop ([remaining-data data])
  77. (cond
  78. [(null? remaining-data) '()]
  79. [else
  80. (cons (even? (car remaining-data))
  81. (loop (cdr remaining-data)))])))))
  82. ;; Then put the data on the channel.
  83. (put-message fiber1-in-chan
  84. (cons 'data '(0 1 2 3 4 5 6 7 8 9)))
  85. ;; Look for the answer on the out-channel of the fiber.
  86. (display
  87. (simple-format
  88. #f "~a\n" (pk 'main-thread-called-peek
  89. (get-message fiber1-out-chan)))))))