From 1976e7ad0d5dd32df68c3beff72520bb99813ecc Mon Sep 17 00:00:00 2001 From: Christopher Allan Webber Date: Sun, 22 Nov 2015 12:38:02 -0600 Subject: [PATCH] Time handling improvements - make-time-delta now only needs one argument - time can handle floats/rationals --- eightsync/agenda.scm | 18 +++++++++++++++--- 1 file changed, 15 insertions(+), 3 deletions(-) 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) -- 2.31.1