From: Christopher Allan Webber Date: Sun, 22 Nov 2015 18:38:02 +0000 (-0600) Subject: Time handling improvements X-Git-Tag: v0.1.0~106 X-Git-Url: https://jxself.org/git/?a=commitdiff_plain;h=1976e7ad0d5dd32df68c3beff72520bb99813ecc;p=8sync.git Time handling improvements - make-time-delta now only needs one argument - time can handle floats/rationals --- diff --git a/eightsync/agenda.scm b/eightsync/agenda.scm index 8ffe6f1..e4cb1df 100644 --- a/eightsync/agenda.scm +++ b/eightsync/agenda.scm @@ -150,6 +150,14 @@ Generally done automatically for the user through (make-agenda)." (time time-segment-time) (queue time-segment-queue)) +(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. @@ -161,6 +169,8 @@ If an integer, will convert appropriately." (((? 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))) @@ -199,12 +209,14 @@ run (time-segment-right-format) first." (sec time-delta-sec) (usec time-delta-usec)) -(define* (make-time-delta sec #:optional (usec 0)) +(define* (make-time-delta time) "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 usec)) +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)