X-Git-Url: https://jxself.org/git/?a=blobdiff_plain;f=loopy.scm;h=b955c4a269d6c4ab5518d4dc682a125d91b8ea68;hb=1585ad786d07390c308145c0683609e3c34aa2e4;hp=5477af677f65d7e8464eb3af686e1a1b591484c8;hpb=9ed57ce7714e4228941d689aa717196d3280db43;p=8sync.git diff --git a/loopy.scm b/loopy.scm index 5477af6..b955c4a 100644 --- a/loopy.scm +++ b/loopy.scm @@ -37,7 +37,7 @@ make-run-request run-request? run-request-proc run-request-when - run wrap run-wrap run-wrap-at + run-it wrap run run-at delay %current-agenda start-agenda agenda-run-once)) @@ -110,6 +110,11 @@ (queue time-segment-queue)) (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) @@ -118,9 +123,14 @@ (_ (throw 'invalid-time "Invalid time" time)))) (define* (make-time-segment time #:optional (queue (make-q))) + "Make a time segment of TIME and QUEUE + +No automatic conversion is done, so you might have to +run (time-segment-right-format) first." (make-time-segment-intern time queue)) (define (time< time1 time2) + "Check if TIME1 is less than TIME2" (cond ((< (car time1) (car time2)) #t) @@ -132,10 +142,12 @@ (else #f))) (define (time= time1 time2) + "Check whether TIME1 and TIME2 are equivalent" (and (= (car time1) (car time2)) (= (cdr time1) (cdr time2)))) (define (time<= time1 time2) + "Check if TIME1 is less than or equal to TIME2" (or (time< time1 time2) (time= time1 time2))) @@ -147,6 +159,10 @@ (usec time-delta-usec)) (define* (make-time-delta sec #:optional usec) + "Make a of SEC seconds and USEC microseconds. + +This is used primarily so the agenda can recognize RUN-REQUEST objects +which are meant " (make-time-delta-intern sec (or usec 0))) (define tdelta make-time-delta) @@ -167,16 +183,19 @@ Will produce (0 . 0) instead of a negative number, if needed." (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 time2) (cdr time2))))) (define (time-plus time1 time2) + "Add TIME1 and TIME2" (time-carry-correct (cons (+ (car time1) (car time2)) (+ (cdr time2) (cdr time2))))) @@ -188,6 +207,7 @@ Will produce (0 . 0) instead of a negative number, if needed." (segments schedule-segments set-schedule-segments!)) (define* (make-schedule #:optional segments) + "Make a schedule, optionally pre-composed of SEGMENTS" (make-schedule-intern (or segments '()))) (define (schedule-soonest-time schedule) @@ -202,6 +222,7 @@ Will produce (0 . 0) instead of a negative number, if needed." ;; but at least it'll be reasonably easy to refactor to ;; 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 @@ -239,6 +260,7 @@ Will produce (0 . 0) instead of a negative number, if needed." (loop (schedule-segments schedule))))) (define (schedule-empty? schedule) + "Check if the SCHEDULE is currently empty" (eq? (schedule-segments schedule) '())) (define (schedule-segments-split schedule time) @@ -319,24 +341,38 @@ Will produce (0 . 0) instead of a negative number, if needed." ;;; Request to run stuff ;;; ==================== -(define-record-type +(define-immutable-record-type (make-run-request proc when) run-request? (proc run-request-proc) (when run-request-when)) -(define* (run proc #:optional when) +(define* (run-it proc #:optional when) + "Make a request to run PROC (possibly at WHEN)" (make-run-request proc when)) (define-syntax-rule (wrap body ...) + "Wrap contents in a procedure" (lambda () body ...)) -(define-syntax-rule (run-wrap body ...) - (run (wrap body ...))) +(define-syntax-rule (run body ...) + "Run everything in BODY but wrap in a convenient procedure" + (make-run-request (wrap body ...) #f)) + +(define-syntax-rule (run-at body ... when) + "Run BODY at WHEN" + (make-run-request (wrap body ...) when)) + +(define-syntax-rule (run-delay body ... delay-time) + "Run BODY at DELAY-TIME time from now" + (make-run-request (wrap body ...) (tdelta delay-time))) -(define-syntax-rule (run-wrap-at body ... when) - (run (wrap body ...) when)) +(define (delay run-request delay-time) + "Delay a RUN-REQUEST by DELAY-TIME" + (set-field run-request + (run-request-when) + (tdelta delay-time))) ;;; Execution of agenda, and current agenda @@ -432,17 +468,20 @@ Will produce (0 . 0) instead of a negative number, if needed." (agenda-run-once agenda)))) (if (and stop-condition (stop-condition agenda)) 'done - (let* ((new-time (get-time)) - (agenda - (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) new-time)))) + (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) new-time) + (schedule-extract-until! (agenda-schedule agenda) (agenda-time agenda)) (agenda-queue agenda)) (loop agenda))))))