summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--chickadee/scripting/script.scm34
-rw-r--r--doc/api.texi4
2 files changed, 32 insertions, 6 deletions
diff --git a/chickadee/scripting/script.scm b/chickadee/scripting/script.scm
index a67884f..7ba660c 100644
--- a/chickadee/scripting/script.scm
+++ b/chickadee/scripting/script.scm
@@ -26,14 +26,16 @@
spawn-script
script
cancel-script
- yield)
+ yield
+ join)
#:replace (yield))
(define-record-type <script>
- (make-script status children)
+ (make-script status children joined)
script?
(status script-status set-script-status!)
- (children script-children set-script-children!))
+ (children script-children set-script-children!)
+ (joined script-joined set-script-joined!))
(define current-script (make-parameter #f))
@@ -54,17 +56,30 @@
"Return #t if SCRIPT has terminated."
(eq? 'complete (script-status script)))
+(define (script-terminated? script)
+ "Return #t if SCRIPT is in either the completed or cancelled state."
+ (or (script-complete? script) (script-cancelled? script)))
+
(define (cancel-script script)
"Prevent further execution of SCRIPT."
(set-script-status! script 'cancelled)
(for-each cancel-script (script-children script))
- *unspecified*)
+ (resume-joined-scripts script))
+
+(define (add-join! script cont)
+ "Add CONT to the list of continuations waiting for SCRIPT to finish."
+ (set-script-joined! script (cons cont (script-joined script))))
+
+(define (resume-joined-scripts script)
+ "Resume all scripts waiting on SCRIPT to terminate."
+ (for-each (lambda (cont) (cont))
+ (script-joined script)))
(define script-prompt (make-prompt-tag 'script))
(define (spawn-script thunk)
"Apply THUNK as a script."
- (let ((script (make-script 'running '())))
+ (let ((script (make-script 'running '() '())))
(define (handler cont callback . args)
(define (resume . args)
;; Call the continuation that resumes the script, unless the
@@ -83,7 +98,8 @@
(lambda ()
(current-script script)
(thunk)
- (set-script-status! script 'complete))))))
+ (set-script-status! script 'complete)
+ (resume-joined-scripts script))))))
;; Register child script with parent. Cancelling the parent will
;; cause all children to be cancelled as well.
(when (script? (current-script))
@@ -101,3 +117,9 @@
"Suspend the current script and pass its continuation to the
procedure HANDLER."
(abort-to-prompt script-prompt handler))
+
+(define (join script)
+ "Suspend the current script until SCRIPT has terminated."
+ (unless (script-terminated? script)
+ (yield (lambda (cont)
+ (add-join! script cont)))))
diff --git a/doc/api.texi b/doc/api.texi
index 9ed9eff..e51a81d 100644
--- a/doc/api.texi
+++ b/doc/api.texi
@@ -5120,6 +5120,10 @@ Suspend the current script and pass its continuation to the
procedure @var{handler}.
@end deffn
+@deffn {Procedure} join script
+Suspend the current script until @var{script} has terminated.
+@end deffn
+
@deffn {Procedure} sleep duration
Wait @var{duration} before resuming the current script.
@end deffn