fibers.scm 1.5 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546
  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. ;; Some procedure to perform work.
  9. (define perform-calculation
  10. (lambda (data)
  11. (sleep data)
  12. (simple-format #f "slept for ~as\n" data)))
  13. ;; Look for mesages.
  14. (let loop ()
  15. (match
  16. ;; Write arguments to the current output port, and return the last
  17. ;; argument. This will get the message received and write to current
  18. ;; output port an information, that the get-message procedure was
  19. ;; called.
  20. (pk 'fiber1-proc-called-get-message
  21. (get-message in-chan))
  22. ;; Match anything coming in and give it to the procedure which shall
  23. ;; calculate the response message.
  24. [msg (put-message out-chan (perform-calculation msg))])
  25. ;; Continue looking for messages.
  26. (loop))))
  27. (run-fibers
  28. (lambda ()
  29. (let ((fiber1-in-chan (make-channel))
  30. (fiber1-out-chan (make-channel)))
  31. ;; Spawn a fiber to run fiber1-proc, which internally looks for messages on
  32. ;; its in-channel.
  33. (spawn-fiber
  34. (lambda ()
  35. (fiber1-proc fiber1-in-chan fiber1-out-chan)))
  36. ;; Send a mssage to the fiber.
  37. (put-message fiber1-in-chan
  38. 10)
  39. ;; Look for the answer on the out-channel of the fiber.
  40. (display
  41. (simple-format
  42. #f "~a\n" (pk 'main-thread-called-peek
  43. (get-message fiber1-out-chan)))))))