parent
921bb20f23
commit
482cc64477
|
@ -184,7 +184,7 @@
|
||||||
(if (integer? r)
|
(if (integer? r)
|
||||||
(values (inexact->exact r) 0)
|
(values (inexact->exact r) 0)
|
||||||
(let ((l (truncate r)))
|
(let ((l (truncate r)))
|
||||||
(values (inexact->exact l) (- r l)))))
|
(values l (- r l)))))
|
||||||
|
|
||||||
(define (tm:time-normalize! t)
|
(define (tm:time-normalize! t)
|
||||||
(if (>= (abs (time-nanosecond t)) 1000000000)
|
(if (>= (abs (time-nanosecond t)) 1000000000)
|
||||||
|
@ -209,24 +209,6 @@
|
||||||
(define (make-time type nanosecond second)
|
(define (make-time type nanosecond second)
|
||||||
(tm:time-normalize! (make-time-unnormalized type nanosecond second)))
|
(tm:time-normalize! (make-time-unnormalized type nanosecond second)))
|
||||||
|
|
||||||
;; Helpers
|
|
||||||
;; FIXME: finish this and publish it?
|
|
||||||
'(define (date->broken-down-time date)
|
|
||||||
(let ((result (mktime 0)))
|
|
||||||
;; FIXME: What should we do about leap-seconds which may overflow
|
|
||||||
;; set-tm:sec?
|
|
||||||
(set-tm:sec result (date-second date))
|
|
||||||
(set-tm:min result (date-minute date))
|
|
||||||
(set-tm:hour result (date-hour date))
|
|
||||||
;; FIXME: SRFI day ranges from 0-31. (not compatible with set-tm:mday).
|
|
||||||
(set-tm:mday result (date-day date))
|
|
||||||
(set-tm:month result (- (date-month date) 1))
|
|
||||||
;; FIXME: need to signal error on range violation.
|
|
||||||
(set-tm:year result (+ 1900 (date-year date)))
|
|
||||||
(set-tm:isdst result -1)
|
|
||||||
(set-tm:gmtoff result (- (date-zone-offset date)))
|
|
||||||
result))
|
|
||||||
|
|
||||||
;;; current-time
|
;;; current-time
|
||||||
|
|
||||||
;;; specific time getters.
|
;;; specific time getters.
|
||||||
|
@ -252,9 +234,9 @@
|
||||||
;; SCSH portability
|
;; SCSH portability
|
||||||
(define (tm:current-time-tai)
|
(define (tm:current-time-tai)
|
||||||
(receive (seconds quanta) (time+ticks)
|
(receive (seconds quanta) (time+ticks)
|
||||||
(make-time time-tai
|
(make-time time-tai
|
||||||
(* quanta tm:ns/quantum)
|
(* quanta tm:ns/quantum)
|
||||||
(+ seconds (tm:leap-second-delta seconds)))))
|
(+ seconds (tm:leap-second-delta seconds)))))
|
||||||
|
|
||||||
|
|
||||||
(define (tm:current-time-ms-time time-type proc)
|
(define (tm:current-time-ms-time time-type proc)
|
||||||
|
@ -641,7 +623,7 @@
|
||||||
(date-year date))
|
(date-year date))
|
||||||
tm:tai-epoch-in-jd))
|
tm:tai-epoch-in-jd))
|
||||||
;; jdays is an integer plus 1/2,
|
;; jdays is an integer plus 1/2,
|
||||||
(jdays-1/2 (inexact->exact (- jdays 1/2))))
|
(jdays-1/2 (- jdays 1/2)))
|
||||||
(make-time
|
(make-time
|
||||||
time-utc
|
time-utc
|
||||||
(date-nanosecond date)
|
(date-nanosecond date)
|
||||||
|
@ -806,7 +788,7 @@
|
||||||
|
|
||||||
(define (julian-day->date jdn . tz-offset)
|
(define (julian-day->date jdn . tz-offset)
|
||||||
(let* ((time (julian-day->time-utc jdn))
|
(let* ((time (julian-day->time-utc jdn))
|
||||||
(offset (:optional tz-offset (tm:local-tz-offset time)))
|
(offset (:optional tz-offset (tm:local-tz-offset time))))
|
||||||
(time-utc->date time offset)))
|
(time-utc->date time offset)))
|
||||||
|
|
||||||
(define (modified-julian-day->date jdn . tz-offset)
|
(define (modified-julian-day->date jdn . tz-offset)
|
||||||
|
|
Loading…
Reference in New Issue