From: Christopher Allan Webber Date: Wed, 28 Dec 2016 16:33:19 +0000 (-0600) Subject: agenda: Fix prompt buildup in agenda. X-Git-Tag: v0.4.0~45 X-Git-Url: https://jxself.org/git/?a=commitdiff_plain;h=8f95d94e4963d0c61a9435a078f2b6496e31c7cf;p=8sync.git agenda: Fix prompt buildup in agenda. Every time a delimited continuation was resumed, we were re-parameterizing. * 8sync/agenda.scm (current-agenda-prompt): Remove. (8sync-abort-to-prompt): Use (%current-agenda-prompt) parameter. (%current-agenda-prompt): New prompt, deprecating %current-agenda. This is a slight optimization; we were only using the agenda for the prompt, so we can remove the indirection of looking up the agenda prompt tag every time. (%current-agenda): Removed, see above. (start-agenda): Move parameterization of %current-agenda-prompt, current-read-waiter, and current-write-waiter here. (agenda-run-once!): Remove parameterization. Also remove comment which is irrelevant now that we're no longer using an immutable-record-type on the agenda. --- diff --git a/8sync/agenda.scm b/8sync/agenda.scm index 0aaae25..c177dd2 100644 --- a/8sync/agenda.scm +++ b/8sync/agenda.scm @@ -61,7 +61,7 @@ stop-on-nothing-to-do - %current-agenda + %current-agenda-prompt start-agenda agenda-run-once)) @@ -118,15 +118,6 @@ Generally done automatically for the user through (make-agenda)." read-port-map write-port-map schedule 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)))) - ;; helper for making queues for an agenda (define (list->q lst) "Makes a queue composed of LST items" @@ -365,7 +356,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 @@ -440,7 +431,7 @@ forge ahead in our current function!" ;;; 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. @@ -562,16 +553,19 @@ on suspendable ports." ;; TODO: Document fields "Start up the AGENDA" (install-suspendable-ports!) - (while (not (stop-condition agenda)) - (agenda-run-once! agenda) - (update-agenda-from-select! agenda) - ;; Update the agenda's current queue based on - ;; currently applicable time segments - (add-segments-contents-to-queue! - (schedule-extract-until! (agenda-schedule agenda) (gettimeofday)) - (agenda-queue agenda)) - (if post-run-hook - (post-run-hook agenda))) + (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)) + (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)))) 'done) (define (print-error-and-continue key . args) @@ -628,15 +622,10 @@ based on the results" (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)))) + (maybe-catch-all + ((agenda-catch-handler agenda) + (agenda-pre-unwind-handler agenda)) + (proc))) (lambda (kont async-request) (setup-async-request kont async-request)))) @@ -672,7 +661,4 @@ based on the results" ((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-agenda-queue! agenda next-queue)))