Welcome to the CHICKEN Scheme pasting service

Somewhat cleaner channels (now without space leaks!) added by moonsheep on Wed Mar 22 17:05:09 2023

(import
  (srfi 1)
  (srfi 18)
  (srfi 111))

(define-record chan mutex cv data)

(define (new-chan)
  (make-chan (make-mutex) (make-condition-variable) (box (list))))

(define (chan-get! chan)
  (let loop ()
	(let ((data (unbox (chan-data chan)))
		  (m (chan-mutex chan)))
	  (mutex-lock! m)
	  (if (null? data)
		  (begin
			(mutex-unlock! m (chan-cv chan))
			(loop))
		  (begin
			(chan-data-set! chan (cdr data))
			(mutex-unlock! m)
			(car data))))))

(define (chan-put! chan x)
  (let ((tip (box (list))))
	(set-box! (chan-data chan) (cons x tip))
	(chan-data-set! chan tip)
	(condition-variable-broadcast! (chan-cv chan))))

(define (chan-dup chan)
  (make-chan (make-mutex) (chan-cv chan) (chan-data chan)))

(define out-mutex (make-mutex))

(define (consumer chan name)
  (let loop ()
	(let ((data (chan-get! chan)))
	  (mutex-lock! out-mutex)
	  (display name) (display ": ") (display data) (newline)
	  (mutex-unlock! out-mutex)
	  (if (not (null? data))
		  (loop)))))

(define chan (new-chan))

(define threads
  (list
   (thread-start! (make-thread (lambda () (consumer (chan-dup chan) "Alice"))))
   (thread-start! (make-thread (lambda () (consumer (chan-dup chan) "Bob"))))
   (thread-start! (make-thread (lambda () (consumer (chan-dup chan) "Charlie"))))
   (thread-start! (make-thread (lambda () (consumer (chan-dup chan) "Dave"))))
   (thread-start! (make-thread (lambda () (consumer (chan-dup chan) "Eve"))))))

(map (lambda (n) (chan-put! chan n) (thread-sleep! 0.1)) (iota 10))
(chan-put! chan (list))					; nil signals the consumers to quit
(map thread-join! threads)

Your annotation:

Enter a new annotation:

Your nick:
The title of your paste:
Your paste (mandatory) :
Which R5RS procedure returns `'(2 3)' when given `'(1 2 3)' as input?
Visually impaired? Let me spell it for you (wav file) download WAV