; time arithmetic (define (julian year month day) (let* ((a (quotient (- 14 month) 12)) (y (+ year 4800 (- a))) (m (+ month (* 12 a) -3))) (+ day (quotient (+ (* 153 m) 2) 5) (* 365 y) (quotient y 4) (- (quotient y 100)) (quotient y 400) (- 32045)))) (define (gregorian julian) (let* ((j (+ julian 32044)) (g (quotient j 146097)) (dg (modulo j 146097)) (c (quotient (* (+ (quotient dg 36524) 1) 3) 4)) (dc (- dg (* c 36524))) (b (quotient dc 1461)) (db (modulo dc 1461)) (a (quotient (* (+ (quotient db 365) 1) 3) 4)) (da (- db (* a 365))) (y (+ (* g 400) (* c 100) (* b 4) a)) (m (- (quotient (+ (* da 5) 308) 153) 2)) (d (+ da (- (quotient (* (+ m 4) 153) 5)) 122)) (year (+ y (- 4800) (quotient (+ m 2) 12))) (month (+ (modulo (+ m 2) 12) 1)) (day (+ d 1))) (values year month day))) (define (julian-time year month day hour minute second) (+ (julian year month day) (/ (+ (* hour 60 60) (* minute 60) second) 86400))) (define (gregorian-time time-stamp) (let* ((date (floor time-stamp)) (time (* (- time-stamp date) 86400)) (hour (quotient time 3600)) (minute (modulo (quotient time 60) 60)) (second (modulo time 60))) (call-with-values (lambda () (gregorian date)) (lambda (year month day) (values year month day hour minute second))))) (display (julian-time 2015 9 14 10 39 42)) (newline) (call-with-values (lambda () (gregorian-time (julian-time 2015 9 14 10 39 42))) (lambda (year month day hour minute second) (display year) (newline) (display month) (newline) (display day) (newline) (display hour) (newline) (display minute) (newline) (display second) (newline)))