Go-like channel in Common Lisp (courtesy of ChanL)

channels.lisp

;; Rob Pike's examples with Common Lisp ChanL
;; Based on "Go Concurrency Patterns" (https://talks.golang.org/2012/concurrency.slide)

(ql:quickload :chanl)

;; Background call example
;; (chanl::pcall #'(lambda () (boring "Yello")))

;; Running function in the background (p.16)
(defun boring (msg)
  (loop
    do (print msg)
       (sleep (random 1.0))))


(defun ignoring-it-a-little-less ()
  (let ((task (chanl::pcall #'(lambda ()
				(boring "Yello!")))))
    (print "I'm listening.")
    (sleep 4)
    (print "You're boring; I'm leaving.~%")
    (chanl::kill (chanl::task-thread task))))

;; Running function in the background with communication via a channel (p.20)
(defun boring-chan (msg chan)
  (loop
    do (chanl::send chan msg)
       (sleep (random 1.0))))

(defun communicate-via-channel ()
  (let* ((c (make-instance 'chanl::channel))
	 (task (chanl::pcall #'(lambda ()
				 (boring-chan "Yello!" c)))))
    (loop
      repeat 10
      do (format t "Coroutine says: ~a~%" (chanl::recv c)))
    (print "You're boring; I'm leaving.~%")
    (chanl::kill (chanl::task-thread task))))

;; Channel generator (p.25)
(defun boring-generator (msg)
  (let* ((c (make-instance 'chanl::channel))
	 (task (chanl::pexec ()
		 (loop
		   for i from 1
		   do (chanl::send c (format nil "~a ~d" msg i))
		      (sleep (random 1.0))))))
    ;; Double return value to give a handle for task->thread
    (values c task)))

(defun communicate-with-generator ()
  (multiple-value-bind (c task) (boring-generator "Yello")
    (loop
      repeat 5
      do (format t "Coroutine says: ~a~%" (chanl::recv c)))
    (print "You're boring; I'm leaving.~%")
    ;; Explicitly kill task-related thread
    (chanl::kill (chanl::task-thread task))))

;; Two service instances (p.26)
(defun communicate-with-two-services ()
  (multiple-value-bind (c1 task1) (boring-generator "Joe")
    (multiple-value-bind (c2 task2) (boring-generator "Ann")
      (loop
	repeat 5
	do
	   (print (chanl::recv c1))
	   (print (chanl::recv c2)))
      (print "You're both boring; I'm leaving.~%")
      (chanl::kill (chanl::task-thread task1))
      (chanl::kill (chanl::task-thread task2)))))

;; Multiplexing
(defun fan-in (input-channel-1 input-channel-2)
  (let ((c (make-instance 'chanl::channel)))
    (chanl::pexec ()
      (loop
	do (chanl::send c (chanl::recv input-channel-1))))
    (chanl::pexec ()
      (loop
	do (chanl::send c (chanl::recv input-channel-2))))
    c))

(defun read-from-fan-in ()
  (let ((c (fan-in (boring-generator "Joe")
		   (boring-generator "Ann"))))
    (loop
      repeat 10
      do (print (chanl::recv c)))
    (print "You're both boring; I'm leaving.~%")))

;; Restoring sequencing
(defstruct message
  (str nil :type string)
  (wait nil :type chanl::channel))

(defun restore-sequencing ()
  (let* ((wait-for-it (make-instance 'chanl::channel))
	 (c (make-instance 'chanl::channel)))
    (chanl::pexec ()
      (loop
	for i from 1 to 5
	do
	   (chanl::send c (make-message :str (format nil "Joe ~d" i) :wait wait-for-it))
	   (sleep (random 1.0))
	   (chanl::recv wait-for-it)))
    (chanl::pexec ()
      (loop
	for i from 1 to 5
	do
	   (chanl::send c (make-message :str (format nil "Ann ~d" i) :wait wait-for-it))
	   (sleep (random 1.0))
	   (chanl::recv wait-for-it)))
    (loop
      repeat 5
      for msg1 = (chanl::recv c)
      for msg2 = (chanl::recv c)
      do
	 (print (message-str msg1))
	 (print (message-str msg2))
	 (chanl::send (message-wait msg1) t)
	 (chanl::send (message-wait msg1) t)
      )))

;; Select
(defun fan-in-select (input-channel-1 input-channel-2)
  (let ((c (make-instance 'chanl::channel)))
    (chanl::pexec ()
      (loop
	do (chanl::select
	     ((chanl::recv input-channel-1 s)
	      (chanl::send c s))
	     ((chanl::recv input-channel-2 s)
	      (chanl::send c s)))))
    c))

(defun read-from-fan-in-select ()
  (let ((c (fan-in-select (boring-generator "Joe")
			  (boring-generator "Ann"))))
    (loop
      repeat 10
      do (print (chanl::recv c)))
    (print "You're both boring; I'm leaving.~%")))

;; Timeout using select - timeout per message
(defun timeout-using-select-per-message ()
  (let ((c (boring-generator "Joe")))
    (loop
      for delay = (make-instance 'chanl::channel)
      do (chanl::pexec ()
	   (sleep 1.0)
	   (chanl::send delay 0))
      do (chanl::select
	   ((chanl::recv c s)
	    (print s))
	   ((chanl::recv delay s)
	    (declare (ignore s))
	    (print "You're too slow")
	    (return-from timeout-using-select-per-message))))))

;; Timeout using select - global timeout
(defun timeout-using-select-global-timeout ()
  (let ((c (boring-generator "Joe"))
	(delay (make-instance 'chanl::channel)))
    (chanl::pexec ()
      (sleep 2.0)
      (chanl::send delay 0))
    (loop
      do (chanl::select
	   ((chanl::recv c s)
	    (print s))
	   ((chanl::recv delay s)
	    (declare (ignore s))
	    (print "You're too slow")
	    (return-from timeout-using-select-global-timeout))))))