X-Git-Url: https://jxself.org/git/?p=8sync.git;a=blobdiff_plain;f=8sync%2Fagenda.scm;h=4a126a4e1fddbcf140748f62b7b9861f7d5e03e2;hp=8847dc931185a5424b2dd0e71f7d6f14c4875e7c;hb=2255f6996a4fbe708b235760816a6dd49959fb6d;hpb=4118e3306b85390d0564960b92c9f56e202898d0

diff --git a/8sync/agenda.scm b/8sync/agenda.scm
index 8847dc9..4a126a4 100644
--- a/8sync/agenda.scm
+++ b/8sync/agenda.scm
@@ -19,7 +19,6 @@
 (define-module (8sync agenda)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-9)
-  #:use-module (srfi srfi-9 gnu)
   #:use-module (ice-9 q)
   #:use-module (ice-9 match)
   #:use-module (ice-9 receive)
@@ -27,24 +26,13 @@
   #:export (<agenda>
             make-agenda agenda?
             agenda-queue agenda-prompt-tag
-            agenda-read-port-map agenda-write-port-map agenda-except-port-map
+            agenda-read-port-map agenda-write-port-map
             agenda-schedule
             
             make-async-prompt-tag
 
             list->q make-q*
 
-            <time-segment>
-            make-time-segment time-segment?
-            time-segment-time time-segment-queue
-
-            time< time= time<= time-delta+
-            time-minus time-plus
-
-            <time-delta>
-            make-time-delta tdelta time-delta?
-            time-delta-sec time-delta-usec
-
             <schedule>
             make-schedule schedule?
             schedule-add! schedule-empty?
@@ -60,13 +48,9 @@
 
             run-it wrap wrap-apply run run-at run-delay
 
-            8sync 8sync-delay
-            8sync-run 8sync-run-at 8sync-run-delay
-            8sync-nowait
-            8sleep
+            8sync
+            8sleep 8yield
             
-            catch-8sync
-
             ;; used for introspecting the error, but a method for making
             ;; is not exposed
             wrapped-exception?
@@ -77,13 +61,8 @@
 
             stop-on-nothing-to-do
 
-            %current-agenda
-            start-agenda agenda-run-once))
-
-(install-suspendable-ports!)
-
-;; @@: Using immutable agendas here, so wouldn't it make sense to
-;;   replace this queue stuff with using pfds based immutable queues?
+            %current-agenda-prompt
+            run-agenda agenda-run-once!))
 
 
 ;;; Agenda definition
@@ -96,24 +75,26 @@
 ;;;    operation (from which they can be returned later)
 ;;;  - a mapping of ports to various handler procedures
 ;;;
-;;; The goal, eventually, is for this all to be immutable and functional.
+;;; @@: Is this next part deprecated?
+;;; The goal, maybe eventually, is for this all to be immutable and functional.
 ;;; However, we aren't there yet.  Some tricky things:
 ;;;  - The schedule needs to be immutable, yet reasonably efficient.
 ;;;  - Need to use immutable queues (ijp's pfds library?)
 ;;;  - Modeling reading from ports as something repeatable,
 ;;;    and with reasonable separation from functional components?
 
-(define-immutable-record-type <agenda>
+;; TODO: Tear out the immutable agenda aspect until we're actually ready
+;;   to use it.
+(define-record-type <agenda>
   (make-agenda-intern queue prompt-tag
                       read-port-map write-port-map
-                      schedule time catch-handler pre-unwind-handler)
+                      schedule catch-handler pre-unwind-handler)
   agenda?
-  (queue agenda-queue)
+  (queue agenda-queue set-agenda-queue!)
   (prompt-tag agenda-prompt-tag)
   (read-port-map agenda-read-port-map)
   (write-port-map agenda-write-port-map)
   (schedule agenda-schedule)
-  (time agenda-time)
   (catch-handler agenda-catch-handler)
   (pre-unwind-handler agenda-pre-unwind-handler))
 
@@ -129,24 +110,13 @@ Generally done automatically for the user through (make-agenda)."
                       (read-port-map (make-hash-table))
                       (write-port-map (make-hash-table))
                       (schedule (make-schedule))
-                      (time (gettimeofday))
                       (catch-handler #f)
                       (pre-unwind-handler print-error-and-continue))
   ;; TODO: document arguments
   "Make a fresh agenda."
   (make-agenda-intern queue prompt
                       read-port-map write-port-map
-                      schedule time
-                      catch-handler pre-unwind-handler))
-
-(define (current-agenda-prompt)
-  "Get the prompt for the current agenda; signal an error if there isn't one."
-  (let ((current-agenda (%current-agenda)))
-    (if (not current-agenda)
-        (throw
-         'no-current-agenda
-         "Can't get current agenda prompt if there's no current agenda!")
-        (agenda-prompt-tag current-agenda))))
+                      schedule catch-handler pre-unwind-handler))
 
 ;; helper for making queues for an agenda
 (define (list->q lst)
@@ -179,32 +149,6 @@ Generally done automatically for the user through (make-agenda)."
   (time time-segment-time)
   (queue time-segment-queue))
 
-;; @@: This seems to be the same as srfi-18's seconds->time procedure?
-;;   Maybe double check and switch to that?  (Thanks amz3!)
-
-(define (time-from-float-or-fraction time)
-  "Produce a (sec . usec) pair from TIME, a float or fraction"
-  (let* ((mixed-whole (floor time))
-         (mixed-rest (- time mixed-whole))  ; float or fraction component
-         (sec mixed-whole)
-         (usec (floor (* 1000000 mixed-rest))))
-    (cons (inexact->exact sec) (inexact->exact usec))))
-
-(define (time-segment-right-format time)
-  "Ensure TIME is in the right format.
-
-The right format means (second . microsecond).
-If an integer, will convert appropriately."
-  ;; TODO: add floating point / rational number support.
-  (match time
-    ;; time is already a cons of second and microsecnd
-    (((? integer? s) . (? integer? u)) time)
-    ;; time was just an integer (just the second)
-    ((? integer? _) (cons time 0))
-    ((or (? rational? _) (? inexact? _))
-     (time-from-float-or-fraction time))
-    (_ (throw 'invalid-time "Invalid time" time))))
-
 (define* (make-time-segment time #:optional (queue (make-q)))
   "Make a time segment of TIME and QUEUE
 
@@ -234,24 +178,7 @@ run (time-segment-right-format) first."
   (or (time< time1 time2)
       (time= time1 time2)))
 
-
-(define-record-type <time-delta>
-  (make-time-delta-intern sec usec)
-  time-delta?
-  (sec time-delta-sec)
-  (usec time-delta-usec))
-
-(define* (make-time-delta time)
-  "Make a <time-delta> of SEC seconds and USEC microseconds.
-
-This is used primarily so the agenda can recognize RUN-REQUEST objects
-which are meant to delay computation"
-  (match (time-segment-right-format time)
-    ((sec . usec)
-     (make-time-delta-intern sec usec))))
-
-(define tdelta make-time-delta)
-
+;; @@: Maybe we should use floor/ here?
 (define (time-carry-correct time)
   "Corrects/handles time microsecond carry.
 Will produce (0 . 0) instead of a negative number, if needed."
@@ -267,25 +194,19 @@ Will produce (0 . 0) instead of a negative number, if needed."
               (+ (cdr time) 1000000))))
         (else time)))
 
-(define (time-delta+ time time-delta)
-  "Increment a TIME by the value of TIME-DELTA"
-  (time-carry-correct
-   (cons (+ (car time) (time-delta-sec time-delta))
-         (+ (cdr time) (time-delta-usec time-delta)))))
-
 (define (time-minus time1 time2)
   "Subtract TIME2 from TIME1"
   (time-carry-correct
    (cons (- (car time1) (car time2))
          (- (cdr time1) (cdr time2)))))
 
+;; @@: Unused?
 (define (time-plus time1 time2)
   "Add TIME1 and TIME2"
   (time-carry-correct
    (cons (+ (car time1) (car time2))
          (+ (cdr time1) (cdr time2)))))
 
-
 (define-record-type <schedule>
   (make-schedule-intern segments)
   schedule?
@@ -308,41 +229,40 @@ Will produce (0 . 0) instead of a negative number, if needed."
 ;;   a more functional setup?
 (define (schedule-add! schedule time proc)
   "Mutate SCHEDULE, adding PROC at an appropriate time segment for TIME"
-  (let ((time (time-segment-right-format time)))
-    (define (new-time-segment)
-      (let ((new-segment
-             (make-time-segment time)))
-        (enq! (time-segment-queue new-segment) proc)
-        new-segment))
-    (define (loop segments)
-      (define (segment-equals-time? segment)
-        (time= time (time-segment-time segment)))
-
-      (define (segment-more-than-time? segment)
-        (time< time (time-segment-time segment)))
-
-      ;; We could switch this out to be more mutate'y
-      ;; and avoid the O(n) of space... is that over-optimizing?
-      (match segments
-        ;; If we're at the end of the list, time to make a new
-        ;; segment...
-        ('() (cons (new-time-segment) '()))
-        ;; If the segment's time is exactly our time, good news
-        ;; everyone!  Let's append our stuff to its queue
-        (((? segment-equals-time? first) rest ...)
-         (enq! (time-segment-queue first) proc)
-         segments)
-        ;; If the first segment is more than our time,
-        ;; ours belongs before this one, so add it and
-        ;; start consing our way back
-        (((? segment-more-than-time? first) rest ...)
-         (cons (new-time-segment) segments))
-        ;; Otherwise, build up recursive result
-        ((first rest ... )
-         (cons first (loop rest)))))
-    (set-schedule-segments!
-     schedule
-     (loop (schedule-segments schedule)))))
+  (define (new-time-segment)
+    (let ((new-segment
+           (make-time-segment time)))
+      (enq! (time-segment-queue new-segment) proc)
+      new-segment))
+  (define (loop segments)
+    (define (segment-equals-time? segment)
+      (time= time (time-segment-time segment)))
+
+    (define (segment-more-than-time? segment)
+      (time< time (time-segment-time segment)))
+
+    ;; We could switch this out to be more mutate'y
+    ;; and avoid the O(n) of space... is that over-optimizing?
+    (match segments
+      ;; If we're at the end of the list, time to make a new
+      ;; segment...
+      ('() (cons (new-time-segment) '()))
+      ;; If the segment's time is exactly our time, good news
+      ;; everyone!  Let's append our stuff to its queue
+      (((? segment-equals-time? first) rest ...)
+       (enq! (time-segment-queue first) proc)
+       segments)
+      ;; If the first segment is more than our time,
+      ;; ours belongs before this one, so add it and
+      ;; start consing our way back
+      (((? segment-more-than-time? first) rest ...)
+       (cons (new-time-segment) segments))
+      ;; Otherwise, build up recursive result
+      ((first rest ... )
+       (cons first (loop rest)))))
+  (set-schedule-segments!
+   schedule
+   (loop (schedule-segments schedule))))
 
 (define (schedule-empty? schedule)
   "Check if the SCHEDULE is currently empty"
@@ -350,31 +270,30 @@ Will produce (0 . 0) instead of a negative number, if needed."
 
 (define (schedule-segments-split schedule time)
   "Does a multiple value return of time segments before/at and after TIME"
-  (let ((time (time-segment-right-format time)))
-    (define (segment-is-now? segment)
-      (time= (time-segment-time segment) time))
-    (define (segment-is-before-now? segment)
-      (time< (time-segment-time segment) time))
-
-    (let loop ((segments-before '())
-               (segments-left (schedule-segments schedule)))
-      (match segments-left
-        ;; end of the line, return
-        ('()
-         (values (reverse segments-before) '()))
-
-        ;; It's right now, so time to stop, but include this one in before
-        ;; but otherwise return
-        (((? segment-is-now? first) rest ...)
-         (values (reverse (cons first segments-before)) rest))
-
-        ;; This is prior or at now, so add it and keep going
-        (((? segment-is-before-now? first) rest ...)
-         (loop (cons first segments-before) rest))
-
-        ;; Otherwise it's past now, just return what we have
-        (segments-after
-         (values segments-before segments-after))))))
+  (define (segment-is-now? segment)
+    (time= (time-segment-time segment) time))
+  (define (segment-is-before-now? segment)
+    (time< (time-segment-time segment) time))
+
+  (let loop ((segments-before '())
+             (segments-left (schedule-segments schedule)))
+    (match segments-left
+      ;; end of the line, return
+      ('()
+       (values (reverse segments-before) '()))
+
+      ;; It's right now, so time to stop, but include this one in before
+      ;; but otherwise return
+      (((? segment-is-now? first) rest ...)
+       (values (reverse (cons first segments-before)) rest))
+
+      ;; This is prior or at now, so add it and keep going
+      (((? segment-is-before-now? first) rest ...)
+       (loop (cons first segments-before) rest))
+
+      ;; Otherwise it's past now, just return what we have
+      (segments-after
+       (values segments-before segments-after)))))
 
 (define (schedule-extract-until! schedule time)
   "Extract all segments until TIME from SCHEDULE, and pop old segments off"
@@ -427,11 +346,19 @@ Will produce (0 . 0) instead of a negative number, if needed."
   "Run BODY at WHEN"
   (make-run-request (wrap body ...) when))
 
-;; @@: Is it okay to overload the term "delay" like this?
-;;   Would `run-in' be better?
 (define-syntax-rule (run-delay body ... delay-time)
   "Run BODY at DELAY-TIME time from now"
-  (make-run-request (wrap body ...) (tdelta delay-time)))
+  (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))
 
 
 
@@ -439,7 +366,7 @@ Will produce (0 . 0) instead of a negative number, if needed."
 ;;; =================================
 
 (define-syntax-rule (8sync-abort-to-prompt async-request)
-  (abort-to-prompt (current-agenda-prompt)
+  (abort-to-prompt (%current-agenda-prompt)
                    async-request))
 
 ;; Async port request and run-request meta-requests
@@ -461,120 +388,57 @@ return the wrong thing via (8sync) and trip themselves up."
               "Invalid request passed back via an (8sync) procedure."
               async-request))))
 
-(define-record-type <wrapped-exception>
-  (make-wrapped-exception key args stacks)
-  wrapped-exception?
-  (key wrapped-exception-key)
-  (args wrapped-exception-args)
-  (stacks wrapped-exception-stacks))
-
-(define-syntax-rule (propagate-%async-exceptions body)
-  (let ((body-result body))
-    (if (wrapped-exception? body-result)
-        (throw '8sync-caught-error
-               (wrapped-exception-key body-result)
-               (wrapped-exception-args body-result)
-               (wrapped-exception-stacks body-result))
-        body-result)))
-
-(define-syntax 8sync
-  (syntax-rules ()
-    "Run BODY asynchronously (8synchronously?) at a prompt, then return.
-
-Possibly specify WHEN as the second argument."
-    ((8sync body)
-     (8sync-run body))
-    ((8sync body when)
-     (8sync-run-at body when))))
-
-(define-syntax-rule (8sync-run body ...)
-  (8sync-run-at body ... #f))
-
-(define-syntax-rule (8sync-run-at body ... when)
-  (propagate-%async-exceptions
-   (8sync-abort-to-prompt
-    ;; Send an asynchronous request to apply a continuation to the
-    ;; following function, then handle that as a request to the agenda
-    (make-async-request
-     (lambda (kont)
-       ;; We're making a run request
-       (make-run-request
-        ;; Wrapping the following execution to run...
-        (wrap
-         ;; Once we get the result from the inner part, we'll resume
-         ;; this continuation, but first
-         ;; @@: Is this running immediately, or queueing the result
-         ;;   after evaluation for the next agenda tick?  It looks
-         ;;   like evaluating immediately.  Is that what we want?
-         (kont
-          ;; Any unhandled errors are caught
-          (let ((exception-stack #f))
-            (catch #t
-              ;; Run the actual code the user requested
-              (lambda ()
-                body ...)
-              ;; If something bad happened and we didn't catch it,
-              ;; we'll wrap it up in such a way that the continuation
-              ;; can address it
-              (lambda (key . args)
-                (cond
-                 ((eq? key '8sync-caught-error)
-                  (match args
-                    ((orig-key orig-args orig-stacks)
-                     (make-wrapped-exception
-                      orig-key orig-args
-                      (cons exception-stack orig-stacks)))))
-                 (else
-                  (make-wrapped-exception key args
-                                          (list exception-stack)))))
-              (lambda _
-                (set! exception-stack (make-stack #t 1 0)))))))
-        when))))))
-
-(define-syntax-rule (8sync-run-delay body ... delay-time)
-  (8sync-run-at body ... (tdelta delay-time)))
-
-(define-syntax-rule (8sync-delay args ...)
-  (8sync-run-delay args ...))
-
-;; TODO: Write (%run-immediately)
-
-(define-syntax-rule (8sync-nowait body)
+(define-syntax-rule (8sync body ...)
   "Run body asynchronously but ignore its result...
 forge ahead in our current function!"
   (8sync-abort-to-prompt
    (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)
-            (make-run-request (lambda () body) #f))))))
-
-(define-syntax-rule (catch-8sync exp (handler-key handler) ...)
-  (catch '8sync-caught-error
-    (lambda ()
-      exp)
-    (lambda (_ orig-key orig-args orig-stacks)
-      (cond
-       ((or (eq? handler-key #t)
-            (eq? orig-key handler-key))
-        (apply handler orig-stacks orig-args)) ...
-       (else (raise '8sync-caught-error
-                    orig-key orig-args orig-stacks))))))
-
-;; This is sugar... and could probably be considerably
-;; simplified and optimized.  But whatever.
-(define-syntax-rule (8sleep time)
-  (8sync-delay 'no-op time))
+             (kontinue kont) #f)
+            (make-run-request (lambda () body ...) #f))))))
+
+(define (delayed-time in-secs)
+  "Calculate a cons of '(sec . usec) of IN-SECS from current time"
+  (define cur-time (gettimeofday))
+  (define cur-secs (car cur-time))
+  (define cur-usecs (cdr cur-time))
+  (define (convert-non-integer)
+    (define next-time-in-usecs
+      (+ (* (+ in-secs cur-secs) ; add our seconds to current seconds
+            1000000)             ; and turn into usecs
+         cur-usecs))             ; then add in current usecs
+    ;; convert into sec / usec pair
+    (receive (secs usecs)
+        (floor/ next-time-in-usecs 1000000)
+      (cons secs (floor usecs))))
+  (define (convert-integer)
+    (cons (+ in-secs cur-secs) cur-usecs))
+  (if (integer? in-secs)
+      (convert-integer)
+      (convert-non-integer)))
+
+;; TODO: Rewrite when we move to this being just `sleep'.
+(define (8sleep secs)
+  "Like sleep, but asynchronous."
+  (8sync-abort-to-prompt
+   (make-async-request
+    (lambda (kont)
+      (make-run-request (kontinue kont) (delayed-time secs))))))
 
+;; Voluntarily yield execution
+(define (8yield)
+  "Voluntarily yield execution to the scheduler."
+  (8sync-abort-to-prompt
+   (make-async-request
+    (lambda (kont)
+      (make-run-request (kontinue kont) #f)))))
 
 
 ;;; Execution of agenda, and current agenda
 ;;; =======================================
 
-(define %current-agenda (make-parameter #f))
+(define %current-agenda-prompt (make-parameter #f))
 
 (define (update-agenda-from-select! agenda)
   "Potentially (select) on ports specified in agenda, adding items to queue.
@@ -590,7 +454,7 @@ Also handles sleeping when all we have to do is wait on the schedule."
        ((not (q-empty? (agenda-queue agenda)))
         (cons 0 0))
        (soonest-time    ; ie, the agenda is non-empty
-        (let* ((current-time (agenda-time agenda)))
+        (let* ((current-time (gettimeofday)))
           (if (time<= soonest-time current-time)
               ;; Well there's something due so let's select
               ;; (this avoids a (possible?) race condition chance)
@@ -650,8 +514,7 @@ Also handles sleeping when all we have to do is wait on the schedule."
                           (selector agenda))
               0)))
     (or (has-items? agenda-read-port-map)
-        (has-items? agenda-write-port-map)
-        (has-items? agenda-except-port-map)))
+        (has-items? agenda-write-port-map)))
 
   (if (or (ports-to-select?)
           ;; select doubles as sleep...
@@ -690,47 +553,25 @@ on suspendable ports."
        (= 0 (hash-count (const #t) (agenda-write-port-map agenda)))))
 
 
-(define* (start-agenda agenda
-                       #:key
-                       ;; @@: Should we make stop-on-nothing-to-do
-                       ;;   the default stop-condition?
-                       (stop-condition stop-on-nothing-to-do)
-                       (get-time gettimeofday)
-                       (handle-ports update-agenda-from-select!)
-                       ;; 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"
-  (let loop ((agenda agenda))
-    (let ((agenda   
-           ;; @@: Hm, maybe here would be a great place to handle
-           ;;   select'ing on ports.
-           ;;   We could compose over agenda-run-once and agenda-read-ports
-           (agenda-run-once agenda)))
-      ;; @@: This relies on mutation at present on the queue, in the rare
-      ;;   event it's used.  If we ever switch to something more immutable,
-      ;;   it should return a new modified agenda instead.
+  (install-suspendable-ports!)
+  (parameterize ((%current-agenda-prompt (agenda-prompt-tag agenda))
+                 (current-read-waiter wait-for-readable)
+                 (current-write-waiter wait-for-writable))
+    (while (not (stop-condition agenda))
+      (agenda-run-once! agenda)
+      (update-agenda-from-select! agenda)
+      (add-segments-contents-to-queue!
+       (schedule-extract-until! (agenda-schedule agenda) (gettimeofday))
+       (agenda-queue agenda))
       (if post-run-hook
-          (post-run-hook agenda))
-      (if (and stop-condition (stop-condition agenda))
-          'done
-          (let* ((agenda
-                  ;; We have to update the time after ports handled, too
-                  ;; because it may have changed after a select
-                  (set-field
-                   (handle-ports
-                    ;; Adjust the agenda's time just in time
-                    ;; We do this here rather than in agenda-run-once to make
-                    ;; agenda-run-once's behavior fairly predictable
-                    (set-field agenda (agenda-time) (get-time)))
-                   (agenda-time) (get-time))))
-            ;; Update the agenda's current queue based on
-            ;; currently applicable time segments
-            (add-segments-contents-to-queue!
-             (schedule-extract-until! (agenda-schedule agenda) (agenda-time agenda))
-             (agenda-queue agenda))
-            (loop agenda))))))
-
+          (post-run-hook agenda))))
+  'done)
 
 (define (print-error-and-continue key . args)
   "Frequently used as pre-unwind-handler for agenda"
@@ -779,22 +620,24 @@ on suspendable ports."
     (lambda (kont)
       (make-write-request port (wrap (kont #f)))))))
 
-(define (agenda-run-once agenda)
+(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 ()
-       (parameterize ((%current-agenda 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))
-         (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))))
 
@@ -805,21 +648,11 @@ based on the results"
              (proc-result (call-proc proc))
              (enqueue
               (lambda (run-request)
-                (define (schedule-at! time proc)
-                  (schedule-add! (agenda-schedule agenda) time proc))
                 (let ((request-time (run-request-when run-request)))
-                  (match request-time
-                    ((? time-delta? time-delta)
-                     (let ((time (time-delta+ (agenda-time agenda)
-                                              time-delta)))
-                       (schedule-at! time (run-request-proc run-request))))
-                    ((? integer? sec)
-                     (let ((time (cons sec 0)))
-                       (schedule-at! time (run-request-proc run-request))))
-                    (((? integer? sec) . (? integer? usec))
-                     (schedule-at! request-time (run-request-proc run-request)))
-                    (#f
-                     (enq! next-queue (run-request-proc run-request))))))))
+                  (if request-time
+                      (schedule-add! (agenda-schedule agenda) request-time
+                                     (run-request-proc run-request))
+                      (enq! next-queue (run-request-proc run-request)))))))
         (define (handle-individual result)
           ;; @@: Could maybe optimize by switching to an explicit cond...
           (match result
@@ -830,14 +663,14 @@ based on the results"
             ((? write-request? write-request)
              (agenda-handle-write-request! agenda write-request))
             ;; do nothing
-            ;; @@: Why not throw an error?
+            ;; Remember, we don't throw an error here because procedures can
+            ;; return a run request, eg with run-it, at the end of their
+            ;; evaluation to keep looping.
+            ;; @@: Though is this really a useful feature?
             (_ #f)))
         ;; @@: We might support delay-wrapped procedures here
         (match proc-result
           ((results ...)
            (for-each handle-individual results))
           (one-result (handle-individual one-result)))))
-    ;; TODO: Alternately, we could return the next-queue
-    ;;   along with changes to be added to the schedule here?
-    ;; Return new agenda, with next queue set
-    (set-field agenda (agenda-queue) next-queue)))
+    (set-agenda-queue! agenda next-queue)))