scsh-conservatory
/
scsh-0.6
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

+ removed two bogus inexact->exact 

+ fixed typo
This commit is contained in:
mainzelm 2003-02-07 16:02:11 +00:00
parent 921bb20f23
commit 482cc64477
1 changed files with 6 additions and 24 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

30
scheme/srfi/srfi-19.scm
View File

@ -184,7 +184,7 @@
(if (integer? r)
(values (inexact->exact r) 0)
(let ((l (truncate r)))
(values (inexact->exact l) (- r l)))))
(values l (- r l)))))
(define (tm:time-normalize! t)
(if (>= (abs (time-nanosecond t)) 1000000000)
@ -209,24 +209,6 @@
(define (make-time 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
;;; specific time getters.
@ -252,9 +234,9 @@
;; SCSH portability
(define (tm:current-time-tai)
(receive (seconds quanta) (time+ticks)
(make-time time-tai
(* quanta tm:ns/quantum)
(+ seconds (tm:leap-second-delta seconds)))))
(make-time time-tai
(* quanta tm:ns/quantum)
(+ seconds (tm:leap-second-delta seconds)))))
(define (tm:current-time-ms-time time-type proc)
@ -641,7 +623,7 @@
(date-year date))
tm:tai-epoch-in-jd))
;; jdays is an integer plus 1/2,
(jdays-1/2 (inexact->exact (- jdays 1/2))))
(jdays-1/2 (- jdays 1/2)))
(make-time
time-utc
(date-nanosecond date)
@ -806,7 +788,7 @@
(define (julian-day->date jdn . tz-offset)
(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)))
(define (modified-julian-day->date jdn . tz-offset)