agenda: Remove deprecated comment.

[8sync.git] / 8sync / agenda.scm

diff --git a/8sync/agenda.scm b/8sync/agenda.scm
index c177dd2baf6977761662ec0b6b3f0b8bb95b7462..4a126a4e1fddbcf140748f62b7b9861f7d5e03e2 100644 (file)
--- a/8sync/agenda.scm
+++ b/8sync/agenda.scm
@@ -62,7 +62,7 @@
             stop-on-nothing-to-do
 
             %current-agenda-prompt
-            start-agenda agenda-run-once))
+            run-agenda agenda-run-once!))
 
 \f
 ;;; Agenda definition
@@ -350,6 +350,16 @@ Will produce (0 . 0) instead of a negative number, if needed."
   "Run BODY at DELAY-TIME time from now"
   (make-run-request (wrap body ...) (delayed-time delay-time)))
 
+;;; Procedures that are delimited continuations being resumed are
+;;; wrapped in a <kontinue>.  This is so that we don't accidentally
+;;; wrap in another catch statement every time we resume them, which
+;;; would be a drag.
+
+(define-record-type <kontinue>
+  (kontinue kont)
+  kontinue?
+  (kont kontinue-kont))
+
 
 \f
 ;;; Asynchronous escape to run things
@@ -385,10 +395,7 @@ forge ahead in our current function!"
    (make-async-request
     (lambda (kont)
       (list (make-run-request
-             ;; What's with returning #f to kont?
-             ;; Otherwise we sometimes get errors like
-             ;; "Zero values returned to single-valued continuation""
-             (wrap (kont #f)) #f)
+             (kontinue kont) #f)
             (make-run-request (lambda () body ...) #f))))))
 
 (define (delayed-time in-secs)
@@ -417,7 +424,7 @@ forge ahead in our current function!"
   (8sync-abort-to-prompt
    (make-async-request
     (lambda (kont)
-      (make-run-request (lambda () (kont #f)) (delayed-time secs))))))
+      (make-run-request (kontinue kont) (delayed-time secs))))))
 
 ;; Voluntarily yield execution
 (define (8yield)
@@ -425,7 +432,7 @@ forge ahead in our current function!"
   (8sync-abort-to-prompt
    (make-async-request
     (lambda (kont)
-      (make-run-request (lambda () (kont #f)) #f)))))
+      (make-run-request (kontinue kont) #f)))))
 
 \f
 ;;; Execution of agenda, and current agenda
@@ -546,16 +553,14 @@ on suspendable ports."
        (= 0 (hash-count (const #t) (agenda-write-port-map agenda)))))
 
 
-(define* (start-agenda agenda
-                       #:key (stop-condition stop-on-nothing-to-do)
-                       ;; For live hacking madness, etc
-                       (post-run-hook #f))
+(define* (run-agenda agenda
+                     #:key (stop-condition stop-on-nothing-to-do)
+                     ;; For live hacking madness, etc
+                     (post-run-hook #f))
   ;; TODO: Document fields
   "Start up the AGENDA"
   (install-suspendable-ports!)
   (parameterize ((%current-agenda-prompt (agenda-prompt-tag agenda))
-                 ;; @@: Couldn't we just parameterize this at the start of
-                 ;;   the agenda...?
                  (current-read-waiter wait-for-readable)
                  (current-write-waiter wait-for-writable))
     (while (not (stop-condition agenda))
@@ -618,14 +623,21 @@ on suspendable ports."
 (define (agenda-run-once! agenda)
   "Run once through the agenda, and produce a new agenda
 based on the results"
+  ;; @@: Maybe rename proc -> run-this ?
   (define (call-proc proc)
     (call-with-prompt
      (agenda-prompt-tag agenda)
      (lambda ()
-       (maybe-catch-all
-        ((agenda-catch-handler agenda)
-         (agenda-pre-unwind-handler agenda))
-        (proc)))
+       (if (kontinue? proc)
+           ;; Resume continuation.
+           ;; We need to pass in #f, otherwise we sometimes get errors like
+           ;; "Zero values returned to single-valued continuation""
+           ((kontinue-kont proc) #f)
+           ;; Otherwise call the procedure and set up error catching.
+           (maybe-catch-all
+            ((agenda-catch-handler agenda)
+             (agenda-pre-unwind-handler agenda))
+            (proc))))
      (lambda (kont async-request)
        (setup-async-request kont async-request))))