X-Git-Url: https://jxself.org/git/?a=blobdiff_plain;f=loopy.scm;h=cc1ee7889bcfdcb1a253b0ec0049c84a3a730890;hb=bbbf61a9bb88a9a97f987a67f7e06e0febbf0d53;hp=ee1bc8121319943f49271b47b17e495ac92821de;hpb=3d1cf1e79073cdd9c0ecb09ee9e4f7dd29dc4149;p=8sync.git

diff --git a/loopy.scm b/loopy.scm
index ee1bc81..cc1ee78 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 <time-delta> 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)
@@ -174,12 +190,12 @@ Will produce (0 . 0) instead of a negative number, if needed."
 (define (time-minus time1 time2)
   (time-carry-correct
    (cons (- (car time1) (car time2))
-         (- (car time2) (cdr time2)))))
+         (- (cdr time2) (cdr time2)))))
 
 (define (time-plus time1 time2)
   (time-carry-correct
    (cons (+ (car time1) (car time2))
-         (+ (car time2) (cdr time2)))))
+         (+ (cdr time2) (cdr time2)))))
 
 
 (define-record-type <schedule>
@@ -319,24 +335,38 @@ Will produce (0 . 0) instead of a negative number, if needed."
 ;;; Request to run stuff
 ;;; ====================
 
-(define-record-type <run-request>
+(define-immutable-record-type <run-request>
   (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
@@ -356,11 +386,11 @@ Will produce (0 . 0) instead of a negative number, if needed."
         (cons 0 0))
        (soonest-time    ; ie, the agenda is non-empty
         (let* ((current-time (agenda-time agenda)))
-          (if (time<= (pk 'soonest-time soonest-time) (pk 'current-time current-time))
+          (if (time<= soonest-time current-time)
               ;; Well there's something due so let's select
               ;; (this avoids a (possible?) race condition chance)
               (cons 0 0)
-              (pk 'time-minus (time-minus soonest-time current-time)))))
+              (time-minus soonest-time current-time))))
        (else
         (cons #f #f)))))
   (define (do-select)
@@ -432,17 +462,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))))))