diff options
| -rw-r--r-- | chickadee/scripting/script.scm | 34 | ||||
| -rw-r--r-- | doc/api.texi | 4 |
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 |