diff options
Diffstat (limited to 'chickadee/scripting/coroutine.scm')
-rw-r--r-- | chickadee/scripting/coroutine.scm | 90 |
1 files changed, 0 insertions, 90 deletions
diff --git a/chickadee/scripting/coroutine.scm b/chickadee/scripting/coroutine.scm deleted file mode 100644 index 642ff83..0000000 --- a/chickadee/scripting/coroutine.scm +++ /dev/null @@ -1,90 +0,0 @@ -;;; Chickadee Game Toolkit -;;; Copyright © 2017 David Thompson <davet@gnu.org> -;;; -;;; Chickadee is free software: you can redistribute it and/or modify -;;; it under the terms of the GNU General Public License as published -;;; by the Free Software Foundation, either version 3 of the License, -;;; or (at your option) any later version. -;;; -;;; Chickadee is distributed in the hope that it will be useful, but -;;; WITHOUT ANY WARRANTY; without even the implied warranty of -;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -;;; General Public License for more details. -;;; -;;; You should have received a copy of the GNU General Public License -;;; along with this program. If not, see -;;; <http://www.gnu.org/licenses/>. - -(define-module (chickadee scripting coroutine) - #:use-module (ice-9 format) - #:use-module (srfi srfi-9) - #:use-module (srfi srfi-9 gnu) - #:export (coroutine? - coroutine-cancelled? - coroutine-running? - coroutine-complete? - spawn-coroutine - coroutine - cancel-coroutine - yield) - #:replace (yield)) - -(define-record-type <coroutine> - (make-coroutine status) - coroutine? - (status coroutine-status set-coroutine-status!)) - -(define (display-coroutine co port) - (format port "<coroutine status: ~a>" (coroutine-status co))) - -(set-record-type-printer! <coroutine> display-coroutine) - -(define (coroutine-cancelled? co) - "Return #t if CO has been cancelled." - (eq? 'cancelled (coroutine-status co))) - -(define (coroutine-running? co) - "Return #t if CO has not yet terminated or been cancelled." - (eq? 'cancelled (coroutine-status co))) - -(define (coroutine-complete? co) - "Return #t if CO has terminated." - (eq? 'cancelled (coroutine-status co))) - -(define (cancel-coroutine co) - "Prevent further execution of CO." - (set-coroutine-status! co 'cancelled) - *unspecified*) - -(define coroutine-prompt (make-prompt-tag 'coroutine)) - -(define (spawn-coroutine thunk) - "Apply THUNK as a coroutine." - (let ((co (make-coroutine 'running))) - (define (handler cont callback . args) - (define (resume . args) - ;; Call continuation that resumes the procedure, unless, of - ;; course, the coroutine has been cancelled in the meantime. - (unless (coroutine-cancelled? co) - (call-with-prompt coroutine-prompt - (lambda () (apply cont args)) - handler))) - (when (procedure? callback) - (apply callback resume args))) - (define task - (let ((dynamic-state (current-dynamic-state))) - (lambda () - (with-dynamic-state dynamic-state thunk) - (set-coroutine-status! co 'complete)))) - ;; Start the coroutine. - (call-with-prompt coroutine-prompt task handler) - co)) - -(define-syntax-rule (coroutine body ...) - "Evaluate BODY in a coroutine." - (spawn-coroutine (lambda () body ...))) - -(define (yield handler) - "Suspend the current coroutine and pass its continuation to the -procedure HANDLER." - (abort-to-prompt coroutine-prompt handler)) |