12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394 |
- (use-modules
- (fibers)
- (fibers channels)
- (ice-9 match))
- ;; Define a procedure to run in a fiber.
- (define fiber1-proc
- (lambda (in-chan out-chan)
- ;; Look for mesages.
- (let loop ([received-proc (lambda (data) 'no-proc-received)])
- (match
- ;; Write arguments to the current output port, and return the last
- ;; argument. This will get the message received and write to current
- ;; output port an information, that the get-message procedure was
- ;; called.
- (pk 'fiber1-proc-called-get-message
- (get-message in-chan))
- ;; Match anything tagged as procedure and store it in the argument for
- ;; the named let.
- [('proc . proc)
- (loop proc)]
- ;; Match anything labeled as data and apply the stored procedure to
- ;; it. If no procedure has been received yet, use the default one.
- [('data . data)
- (put-message out-chan (received-proc data))
- ;; Loop again with the default procedure, awaiting a new procedure and
- ;; data for it.
- (loop (lambda (data) 'no-proc-received))]
- ;; Have a default reaction to anything, but the correctly tagged
- ;; messages.
- [any-other-message
- (put-message out-chan 'unrecognized-message)
- ;; Allow for unrecognized messages in between correct communication.
- (loop received-proc)])
- ;; Continue looking for messages.
- (loop received-proc))))
- (run-fibers
- (lambda ()
- (let ((fiber1-in-chan (make-channel))
- (fiber1-out-chan (make-channel)))
- ;; Spawn a fiber to run fiber1-proc, which internally looks for messages on
- ;; its in-channel.
- (spawn-fiber
- (lambda ()
- (fiber1-proc fiber1-in-chan fiber1-out-chan)))
- ;; Send a mssage to the fiber.
- (put-message fiber1-in-chan
- ;; Send some tagged data, in this case the procedure to use.
- (cons 'proc
- ;; A procedure, which checks all things in data for
- ;; whether they are even numbers and builds a list of
- ;; the answers.
- (lambda (data)
- (let loop ([remaining-data data])
- (cond
- [(null? remaining-data) '()]
- [else
- (cons (even? (car remaining-data))
- (loop (cdr remaining-data)))])))))
- ;; Then put the data on the channel.
- (put-message fiber1-in-chan
- (cons 'data '(0 1 2 3 4 5 6 7 8 9)))
- ;; Look for the answer on the out-channel of the fiber.
- (display
- (simple-format
- #f "~a\n" (pk 'main-thread-called-peek
- (get-message fiber1-out-chan))))
- ;; And then do it again.
- ;; Send a mssage to the fiber.
- (put-message fiber1-in-chan
- ;; Send some tagged data, in this case the procedure to use.
- (cons 'proc
- ;; A procedure, which checks all things in data for
- ;; whether they are even numbers and builds a list of
- ;; the answers.
- (lambda (data)
- (let loop ([remaining-data data])
- (cond
- [(null? remaining-data) '()]
- [else
- (cons (even? (car remaining-data))
- (loop (cdr remaining-data)))])))))
- ;; Then put the data on the channel.
- (put-message fiber1-in-chan
- (cons 'data '(0 1 2 3 4 5 6 7 8 9)))
- ;; Look for the answer on the out-channel of the fiber.
- (display
- (simple-format
- #f "~a\n" (pk 'main-thread-called-peek
- (get-message fiber1-out-chan)))))))
|