racket/date: change current-date', add date*->seconds'

This commit is contained in:
Matthew Flatt 2013-02-01 14:34:40 -08:00
parent 5dda7c4b14
commit 0583616dd7
5 changed files with 36 additions and 17 deletions

View File

@ -21,12 +21,6 @@
;; A date is always represented by the number of seconds since the platform-specific, UTC epoch ;; A date is always represented by the number of seconds since the platform-specific, UTC epoch
(define (date*->seconds dt [local-time? #t])
(match-define (date* s mn h d m y wd yd dst? tz ns tz-name)
dt)
(+ (date->seconds (date s mn h d m y wd yd dst? tz) local-time?)
(/ ns 1000000000)))
(define (date*->utc-seconds dt) (define (date*->utc-seconds dt)
(- (date*->seconds dt #f) (date-time-zone-offset dt))) (- (date*->seconds dt #f) (date-time-zone-offset dt)))

View File

@ -6,8 +6,9 @@
racket/contract/base) racket/contract/base)
(provide/contract (provide/contract
[current-date (-> date?)] [current-date (-> date*?)]
[date->seconds ((date?) (any/c) . ->* . exact-integer?)] [date->seconds ((date?) (any/c) . ->* . exact-integer?)]
[date*->seconds ((date?) (any/c) . ->* . real?)]
[date->string ((date?) (any/c) . ->* . string?)] [date->string ((date?) (any/c) . ->* . string?)]
[date-display-format (parameter/c (symbols 'american 'chinese 'german 'indian 'irish 'julian 'iso-8601 'rfc2822))] [date-display-format (parameter/c (symbols 'american 'chinese 'german 'indian 'irish 'julian 'iso-8601 'rfc2822))]
[find-seconds (((integer-in 0 61) [find-seconds (((integer-in 0 61)
@ -23,7 +24,7 @@
[julian/scalinger->string (exact-integer? . -> . string?)]) [julian/scalinger->string (exact-integer? . -> . string?)])
(define (current-date) (define (current-date)
(seconds->date (current-seconds))) (seconds->date (* #i1/1000 (current-inexact-milliseconds))))
;; Support for Julian calendar added by Shriram; ;; Support for Julian calendar added by Shriram;
;; current version only works until 2099 CE Gregorian ;; current version only works until 2099 CE Gregorian
@ -263,6 +264,12 @@
(date-year date) (date-year date)
local-time?)) local-time?))
(define (date*->seconds date [local-time? #t])
(define s (date->seconds date local-time?))
(if (date*? date)
(+ s (/ (date*-nanosecond date) 1000000))
s))
(define (find-seconds sec min hour day month year [local-time? #t]) (define (find-seconds sec min hour day month year [local-time? #t])
(define (signal-error msg) (define (signal-error msg)
(error 'find-secs (string-append (error 'find-secs (string-append

View File

@ -154,7 +154,7 @@ result is the result of the last @racket[body].}
@defproc[(current-date) date*?]{ @defproc[(current-date) date*?]{
An abbreviation for @racket[(seconds->date (current-seconds))].} An abbreviation for @racket[(seconds->date (* 0.001 (current-inexact-milliseconds)))].}
@defproc[(date->string [date date?] [time? any/c #f]) string?]{ @defproc[(date->string [date date?] [time? any/c #f]) string?]{
@ -175,12 +175,19 @@ Parameter that determines the date string format. The initial format
is @racket['american].} is @racket['american].}
@defproc[(date->seconds [date date?] [local-time? any/c #t]) exact-integer?]{ @defproc[(date->seconds [date date?] [local-time? any/c #t]) exact-integer?]{
Finds the representation of a date in platform-specific seconds. Finds the representation of a date in platform-specific seconds.
The @racket[time-zone-offset] field of @racket[date] is ignored; If the platform cannot represent the specified date,
the date is assumed to be in local time by default or in UTC @exnraise[exn:fail].
if @racket[local-time?] is @racket[#f]. If
the platform cannot represent the specified date, an error is The @racket[week-day], @racket[year-day] fields of @racket[date] are
signaled, otherwise an integer is returned. } ignored. The @racket[dst?] and @racket[time-zone-offset] fields of
@racket[date] are also ignored; the date is assumed to be in local
time by default or in UTC if @racket[local-time?] is @racket[#f].}
@defproc[(date*->seconds [date date?] [local-time? any/c #t]) real?]{
Like @racket[date->seconds], but returns an exact number that can
include a fraction of a second based on @racket[(date*-nanosecond
date)] if @racket[date] is a @racket[date*] instance.}
@defproc[(find-seconds [second (integer-in 0 61)] @defproc[(find-seconds [second (integer-in 0 61)]
[minute (integer-in 0 59)] [minute (integer-in 0 59)]

View File

@ -3,7 +3,7 @@
(Section 'date) (Section 'date)
(require mzlib/date) (require racket/date)
(test #t date? (date* 0 0 0 1 1 -3000 0 0 #f -1000 0 "AST")) (test #t date? (date* 0 0 0 1 1 -3000 0 0 #f -1000 0 "AST"))
(test #t date? (date* 60 59 23 31 12 3000 6 365 #t 1000 999999999 "ZST")) (test #t date? (date* 60 59 23 31 12 3000 6 365 #t 1000 999999999 "ZST"))
@ -38,12 +38,21 @@
(let* ([secs (find-seconds 1 2 3 4 5 2006)] (let* ([secs (find-seconds 1 2 3 4 5 2006)]
[d-some-tz (seconds->date secs)] [d-some-tz (seconds->date secs)]
[d (struct-copy date d-some-tz [d (struct-copy date d-some-tz
[time-zone-offset -21600])]) [time-zone-offset -21600])]
[d* (date* (date-second d) (date-minute d) (date-hour d)
(date-day d) (date-month d) (date-year d)
(date-week-day d) (date-year-day d) (date-dst? d)
(date-time-zone-offset d)
62500
"MDT")])
(define (test-string fmt time? result) (define (test-string fmt time? result)
(test (parameterize ([date-display-format fmt]) (test (parameterize ([date-display-format fmt])
(date->string d time?)) (date->string d time?))
fmt result)) fmt result))
(test secs date->seconds d) (test secs date->seconds d)
(test secs date*->seconds d)
(test (+ secs #e0.0625) date*->seconds d*)
(test (date->seconds d*) date->seconds (seconds->date (date*->seconds d*)))
(test-string 'american #f "Thursday, May 4th, 2006") (test-string 'american #f "Thursday, May 4th, 2006")
(test-string 'american #t "Thursday, May 4th, 2006 3:02:01am") (test-string 'american #t "Thursday, May 4th, 2006 3:02:01am")

View File

@ -2,6 +2,8 @@ Version 5.3.2.2
Added extflonums Added extflonums
racket/extflonum: added racket/extflonum: added
racket/unsafe/ops: added extflonum operations racket/unsafe/ops: added extflonum operations
racket/date: changed current-date to provide nanoseconds,
added date*->seconds
Version 5.3.2.2 Version 5.3.2.2
Added file-truncate Added file-truncate