├── .gitignore ├── README.markdown ├── README.org ├── cl-coroutine-test.asd ├── cl-coroutine.asd ├── src └── cl-coroutine.lisp └── t └── cl-coroutine.lisp /.gitignore: -------------------------------------------------------------------------------- 1 | *.fasl 2 | *.dx32fsl 3 | *.dx64fsl 4 | *.lx32fsl 5 | *.lx64fsl 6 | *.x86f 7 | *~ 8 | .#* -------------------------------------------------------------------------------- /README.markdown: -------------------------------------------------------------------------------- 1 | # Cl-Coroutine 2 | 3 | CL-COROUTINE is a coroutine library for Common Lisp. It uses CL-CONT continuations library in its implementation. 4 | 5 | ## Example 6 | 7 | Coroutines can be defined using `defcoroutine` macro. 8 | 9 | To use defined coroutines, first create a coroutine object with calling `make-coroutine` function, then just `funcall` to process it. 10 | 11 | `yield` macro control back to the context which called the coroutine and the coroutine will resume processing at this point when it will be called again. 12 | 13 | ;; define a coroutine using DEFCOROUTINE macro 14 | (defcoroutine example (whom) 15 | (format t "First greeting to: ~A~%" whom) 16 | (yield 1) 17 | (format t "Second greeting to: ~A~%" whom) 18 | (yield 2) 19 | (format t "Third greeting to: ~A~%" whom) 20 | (coexit 3) 21 | (format t "No greeting to: ~A~%" whom) 22 | (yield 4)) 23 | => EXAMPLE 24 | 25 | ;; make a coroutine object 26 | (setf coroutine (make-coroutine 'example)) 27 | => a coroutine object 28 | 29 | ;; funcall it 30 | (funcall coroutine "Smith") 31 | >> First greeting to: Smith 32 | => 1 33 | 34 | ;; funcall again 35 | (funcall coroutine "Johnson") 36 | >> Second greeting to: Johnson 37 | => 2 38 | 39 | ;; funcall again and coexit 40 | (funcall coroutine "Williams") 41 | >> Third greeting to: Williams 42 | => 3 43 | 44 | ;; funcall after coexit just returns no value 45 | (funcall coroutine "Brown") 46 | => No value 47 | 48 | ;; you can also use WITH-COROUTINE macro to set up coroutines, 49 | ;; which provides calling coroutines without explicit FUNCALL 50 | (with-coroutine (example) 51 | (example "Smith") 52 | (example "Johnson")) 53 | >> First greeting to: Smith 54 | >> Second greeting to: Johnson 55 | => 2 56 | 57 | 58 | ## Installation 59 | 60 | You can install `cl-coroutine` via Quicklisp: 61 | 62 | (ql:quickload :cl-coroutine) 63 | 64 | 65 | ## Restrictions 66 | 67 | CL-COROUTINE has some restrictions because of its dependency on CL-CONT library. 68 | * special forms that CL-CONT library does not support with CALL/CC 69 | * coroutines with very long definition might need much time to compile 70 | 71 | 72 | ## API 73 | 74 | ### [Macro] defcoroutine 75 | 76 | DEFCOROUTINE coroutine-name arg &body body => coroutine-name 77 | 78 | Defines a new coroutine named `coroutine-name` that has atmost one argument as `arg`. The definition of coroutine is stored in the property list of `coroutine-name` symbol. Defined coroutines will be created using `make-coroutine` function. 79 | 80 | ### [Macro] yield 81 | 82 | YIELD [result] => | 83 | 84 | Yields control back to the context which called the coroutine, passing along any multiple values that were passed to it. The coroutine will resume processing at this point when it will be called again. Any arguments passed to the next calling will be set to the coroutine's corresponding parameters implicitly. 85 | 86 | ### [Macro] coexit 87 | 88 | COEXIT [result] => | 89 | 90 | Returns control to the context which called the coroutine, passing along any multiple values that were passed to it. The difference from `yield` macro is that the coroutine will never resume processing at this point anymore. If the coroutine will be called again, it will just return no value. 91 | 92 | ### [Function] make-coroutine 93 | 94 | MAKE-COROUTINE coroutine-name => coroutine 95 | 96 | Creates and returns a coroutine corresponding to `coroutine-name`. The returned coroutine can be called with `funcall` or `apply` functions. 97 | 98 | ### [Macro] with-coroutine 99 | 100 | WITH-COROUTINE (coroutine-name) &body body => results 101 | 102 | `with-coroutine` uses `make-coroutine` to create a coroutine with name `coroutine-name` and defines a local macro with name `coroutine-name` binding it with the coroutine. `with-coroutine` evaluates the body as an implicit progn with the macro. 103 | 104 | 105 | ## Author 106 | 107 | * Masayuki Takagi (kamonama@gmail.com) 108 | 109 | 110 | ## Copyright 111 | 112 | Copyright (c) 2014 Masayuki Takagi (kamonama@gmail.com) 113 | 114 | ## License 115 | 116 | Licensed under the LLGPL License. 117 | -------------------------------------------------------------------------------- /README.org: -------------------------------------------------------------------------------- 1 | * Cl-Coroutine 2 | 3 | ** Usage 4 | 5 | ** Dependencies 6 | 7 | ** Installation 8 | 9 | ** Author 10 | 11 | + Masayuki Takagi (kamonama@gmail.com) 12 | 13 | * Copyright 14 | 15 | Copyright (c) 2014 Masayuki Takagi (kamonama@gmail.com) 16 | -------------------------------------------------------------------------------- /cl-coroutine-test.asd: -------------------------------------------------------------------------------- 1 | #| 2 | This file is a part of cl-coroutine project. 3 | Copyright (c) 2014 Masayuki Takagi (kamonama@gmail.com) 4 | |# 5 | 6 | (in-package :cl-user) 7 | (defpackage cl-coroutine-test-asd 8 | (:use :cl :asdf)) 9 | (in-package :cl-coroutine-test-asd) 10 | 11 | (defsystem cl-coroutine-test 12 | :author "Masayuki Takagi" 13 | :license "LLGPL" 14 | :depends-on (:cl-coroutine 15 | :cl-test-more) 16 | :components ((:module "t" 17 | :components 18 | ((:file "cl-coroutine")))) 19 | 20 | :perform (load-op :after (op c) (asdf:clear-system c))) 21 | -------------------------------------------------------------------------------- /cl-coroutine.asd: -------------------------------------------------------------------------------- 1 | #| 2 | This file is a part of cl-coroutine project. 3 | Copyright (c) 2014 Masayuki Takagi (kamonama@gmail.com) 4 | |# 5 | 6 | (in-package :cl-user) 7 | (defpackage cl-coroutine-asd 8 | (:use :cl :asdf)) 9 | (in-package :cl-coroutine-asd) 10 | 11 | (defsystem cl-coroutine 12 | :version "0.1" 13 | :author "Masayuki Takagi" 14 | :license "LLGPL" 15 | :depends-on (:cl-cont :alexandria) 16 | :components ((:module "src" 17 | :components 18 | ((:file "cl-coroutine")))) 19 | :description "" 20 | :long-description 21 | #.(with-open-file (stream (merge-pathnames 22 | #p"README.markdown" 23 | (or *load-pathname* *compile-file-pathname*)) 24 | :if-does-not-exist nil 25 | :direction :input) 26 | (when stream 27 | (let ((seq (make-array (file-length stream) 28 | :element-type 'character 29 | :fill-pointer t))) 30 | (setf (fill-pointer seq) (read-sequence seq stream)) 31 | seq))) 32 | :in-order-to ((test-op (load-op cl-coroutine-test)))) 33 | -------------------------------------------------------------------------------- /src/cl-coroutine.lisp: -------------------------------------------------------------------------------- 1 | #| 2 | This file is a part of cl-coroutine project. 3 | Copyright (c) 2014 Masayuki Takagi (kamonama@gmail.com) 4 | |# 5 | 6 | (in-package :cl-user) 7 | (defpackage cl-coroutine 8 | (:use :cl :cl-cont) 9 | (:export :defcoroutine 10 | :yield 11 | :coexit 12 | :make-coroutine 13 | :with-coroutine) 14 | (:import-from :alexandria 15 | :with-gensyms)) 16 | (in-package :cl-coroutine) 17 | 18 | 19 | ;;; 20 | ;;; DEFCOROUTINE macro 21 | ;;; 22 | 23 | (defmacro defcoroutine (name (&optional arg) &body body) 24 | (if arg 25 | (defcoroutine/arg name arg body) 26 | (defcoroutine/no-arg name body))) 27 | 28 | (defun defcoroutine/arg (name arg body) 29 | (alexandria:with-gensyms (cont) 30 | `(progn 31 | (setf (get ',name 'make-coroutine) 32 | #'(lambda () 33 | (let (,cont) 34 | #'(lambda (,arg) 35 | (if ,cont 36 | (funcall ,cont ,arg) 37 | (cl-cont:with-call/cc 38 | (macrolet ((yield (&optional result) 39 | (with-gensyms (cc) 40 | `(setf ,',arg 41 | (cl-cont:let/cc ,cc 42 | (setf ,',cont ,cc) 43 | ,result)))) 44 | (coexit (&optional result) 45 | `(cl-cont:let/cc _ 46 | (declare (ignorable _)) 47 | (setf ,',cont 48 | #'(lambda (_) 49 | (declare (ignorable _)) 50 | (values))) 51 | ,result))) 52 | ,@body 53 | (coexit nil)))))))) 54 | ',name))) 55 | 56 | (defun defcoroutine/no-arg (name body) 57 | (alexandria:with-gensyms (cont) 58 | `(progn 59 | (setf (get ',name 'make-coroutine) 60 | #'(lambda () 61 | (let (,cont) 62 | #'(lambda () 63 | (if ,cont 64 | (funcall ,cont) 65 | (cl-cont:with-call/cc 66 | (macrolet ((yield (&optional result) 67 | (with-gensyms (cc) 68 | `(cl-cont:let/cc ,cc 69 | (setf ,',cont ,cc) 70 | ,result))) 71 | (coexit (&optional result) 72 | `(cl-cont:let/cc _ 73 | (declare (ignorable _)) 74 | (setf ,',cont 75 | #'(lambda () 76 | (values))) 77 | ,result))) 78 | ,@body 79 | (coexit nil)))))))) 80 | ',name))) 81 | 82 | 83 | ;;; 84 | ;;; MAKE-COROUTINE function 85 | ;;; 86 | 87 | (defun make-coroutine (name) 88 | (let ((func (get name 'make-coroutine))) 89 | (unless func 90 | (error "The coroutine ~S is undefined." name)) 91 | (funcall func))) 92 | 93 | 94 | ;;; 95 | ;;; WITH-COROUTINE macro 96 | ;;; 97 | 98 | (defmacro with-coroutine ((name) &body body) 99 | (with-gensyms (coroutine) 100 | `(let ((,coroutine (make-coroutine ',name))) 101 | (macrolet ((,name (&rest args) 102 | `(funcall ,',coroutine ,@args))) 103 | ,@body)))) 104 | -------------------------------------------------------------------------------- /t/cl-coroutine.lisp: -------------------------------------------------------------------------------- 1 | #| 2 | This file is a part of cl-coroutine project. 3 | Copyright (c) 2014 Masayuki Takagi (kamonama@gmail.com) 4 | |# 5 | 6 | (in-package :cl-user) 7 | (defpackage cl-coroutine-test 8 | (:use :cl 9 | :cl-coroutine 10 | :cl-test-more)) 11 | (in-package :cl-coroutine-test) 12 | 13 | (plan nil) 14 | 15 | 16 | ;;; 17 | ;;; Test basic case 18 | ;;; 19 | 20 | (diag "Test basic case") 21 | 22 | (defcoroutine test-case1 () 23 | (yield 1) 24 | (yield 2) 25 | (coexit 3) 26 | (yield 4)) 27 | 28 | (let ((coroutine (make-coroutine 'test-case1))) 29 | (is (funcall coroutine) 1 "basic case 1") 30 | (is (funcall coroutine) 2 "basic case 2") 31 | (is (funcall coroutine) 3 "basic case 3") 32 | (is (funcall coroutine) nil "basic case 4")) 33 | 34 | (with-coroutine (test-case1) 35 | (is (test-case1) 1 "basic case 5")) 36 | 37 | (is-error (make-coroutine 'coroutine-not-exists) simple-error 38 | "basic case 6") 39 | 40 | 41 | ;;; 42 | ;;; Test coroutine which yields multiple values 43 | ;;; 44 | 45 | (diag "Test coroutine which yields multiple values") 46 | 47 | (defcoroutine test-case2 () 48 | (yield (values 1 2)) 49 | (yield (values 3 4))) 50 | 51 | (let ((coroutine (make-coroutine 'test-case2))) 52 | (multiple-value-bind (x y) (funcall coroutine) 53 | (is x 1 "basic case 1") 54 | (is y 2 "basic case 2")) 55 | (multiple-value-bind (x y) (funcall coroutine) 56 | (is x 3 "basic case 3") 57 | (is y 4 "basic case 4"))) 58 | 59 | 60 | ;;; 61 | ;;; Test coroutine which has parameters 62 | ;;; 63 | 64 | (diag "Test coroutine which has parameters") 65 | 66 | (defcoroutine test-case3 (foo) 67 | (is foo 1 "basic case 1") 68 | (yield) 69 | (is foo 2 "basic case 2")) 70 | 71 | (let ((coroutine (make-coroutine 'test-case3))) 72 | (funcall coroutine 1) 73 | (funcall coroutine 2)) 74 | 75 | 76 | ;;; 77 | ;;; Test coroutine with let binding 78 | ;;; 79 | 80 | (diag "Test coroutine with let binding") 81 | 82 | (defcoroutine test-case4 (foo) 83 | (is foo 1 "basic case 1") 84 | (let ((foo 2)) 85 | (yield) 86 | ;; FOO is 3, not 2 87 | (is foo 3 "basic case 2"))) 88 | 89 | (let ((coroutine (make-coroutine 'test-case4))) 90 | (funcall coroutine 1) 91 | (funcall coroutine 3)) 92 | 93 | 94 | ;;; 95 | ;;; Test coroutine which uses UNWIND-PROTECT 96 | ;;; 97 | 98 | (diag "Test coroutine which uses UNWIND-PROTECT") 99 | 100 | (defcoroutine test-case5 () 101 | (unwind-protect 102 | (yield 1) 103 | (yield 2))) 104 | 105 | (let ((coroutine (make-coroutine 'test-case5))) 106 | (is-error (funcall coroutine) simple-error "basic case 1")) 107 | 108 | 109 | ;;; 110 | ;;; Test coroutine which uses CATCH/THROW 111 | ;;; 112 | 113 | (diag "Test coroutine which uses CATCH/THROW") 114 | 115 | (defcoroutine test-case6 () 116 | (catch 'result 117 | (yield 1) 118 | (throw 'result 1) 119 | (yield 2)) 120 | (yield 3)) 121 | 122 | (let ((coroutine (make-coroutine 'test-case6))) 123 | (is (funcall coroutine) 1 "basic case 1") 124 | (is-error (funcall coroutine) error "basic case 2")) 125 | 126 | 127 | (finalize) 128 | --------------------------------------------------------------------------------