summaryrefslogtreecommitdiff
path: root/chickadee/scripting/coroutine.scm
diff options
context:
space:
mode:
Diffstat (limited to 'chickadee/scripting/coroutine.scm')
-rw-r--r--chickadee/scripting/coroutine.scm90
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))