Changeset 13905 in project


Ignore:
Timestamp:
03/24/09 22:39:42 (11 years ago)
Author:
Kon Lovett
Message:

Rmvd timezone locale since dst? now part of timezone-components.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • release/3/srfi-19/trunk/srfi-19-core.scm

    r13900 r13905  
    10251025  (tm:time-monotonic->time-tai tim tim) )
    10261026
    1027 ;;; Timezone Locale Object (Public Immutable)
    1028 
    1029 (define tm:make-timezone-locale cons)
    1030 
    1031 (define %timezone-locale-dst? car)
    1032 (define %timezone-locale-component cdr)
    1033 
     1027;;; Timezone Locale Object (Public Immutable, but not enforced)
     1028
     1029(define-inline (%make-utc-timezone)
     1030  (let ((tz (make-timezone-components "UTC0" BUILTIN-SOURCE)))
     1031    (update-timezone-components! tz 'std-name "UTC" 'std-offset 0) ) )
     1032
     1033(define-inline (%timezone-components-ref/dst? tzc a b)
     1034  (timezone-component-ref tzc (if (timezone-component-ref tzc 'dst?) a b)) )
     1035
     1036;;
     1037
     1038;DEPRECATED
    10341039(define (make-timezone-locale dstf tzc)
    1035   (unless (boolean? dstf)
    1036     (error 'make-timezone-locale "invalid daylight saving time flag" dstf) )
    10371040  (unless (timezone-components? tzc)
    10381041    (error 'make-timezone-locale "invalid timezone components" tzc) )
    1039   (tm:make-timezone-locale dstf tzc) )
    1040 
    1041 (define (timezone-locale? obj)
    1042   (and (pair? obj)
    1043        (boolean? (%timezone-locale-dst? obj))
    1044        (timezone-components? (%timezone-locale-component obj)) ) )
    1045 
    1046 (define (check-timezone-locale loc obj)
    1047   (unless (timezone-locale? obj)
    1048     (error loc "invalid timezone locale" obj) ) )
    1049 
    1050 (define (current-dstflag)
    1051   (vector-ref (seconds->local-time (current-seconds)) 8) )
     1042  (set-timezone-component! tzc 'dst? (%->boolean dstf))
     1043  tzc )
     1044
     1045;DEPRECATED
     1046(define timezone-locale? timezone-components?)
     1047
     1048;;
    10521049
    10531050(define local-timezone-locale
    1054   (make-parameter (make-timezone-locale (current-dstflag) (current-timezone-components))
     1051  (make-parameter (current-timezone-components)
    10551052    (lambda (obj)
    1056       (cond ((timezone-locale? obj) obj)
     1053      (cond ((timezone-components? obj) obj)
    10571054            (else
    1058              (warning 'local-timezone-locale "bad argument type - expected a timezone-locale" obj)
     1055             (warning 'local-timezone-locale "bad argument type - expected a timezone-components object" obj)
    10591056             (local-timezone-locale) ) ) ) ) )
    10601057
    1061 (define (make-utc-timezone)
    1062   (let ((tz (make-timezone-components "UTC0" BUILTIN-SOURCE)))
    1063     (update-timezone-components! tz 'std-name "UTC" 'std-offset 0) ) )
    1064 
    10651058(define utc-timezone-locale
    1066   (make-parameter (make-timezone-locale #f (make-utc-timezone))
     1059  (make-parameter (%make-utc-timezone)
    10671060    (lambda (obj)
    1068       (cond ((timezone-locale? obj) obj)
     1061      (cond ((timezone-components? obj) obj)
    10691062            (else
    1070              (warning 'utc-timezone-locale "bad argument type - expected a timezone-locale" obj)
     1063             (warning 'utc-timezone-locale "bad argument type - expected a timezone-components object" obj)
    10711064             (utc-timezone-locale) ) ) ) ) )
    10721065
    1073 ;; Returns #f or a valid tz-name
     1066;;
    10741067
    10751068(define (timezone-locale-name . args)
    1076   (let-optionals args ((tzi (local-timezone-locale)))
    1077     (check-timezone-locale 'timezone-locale-name tzi)
    1078     (let* ((tzc (%timezone-locale-component tzi))
    1079            (tzn (timezone-component-ref tzc (if (%timezone-locale-dst? tzi) 'dst-name 'std-name))))
     1069  (let-optionals args ((tzc (local-timezone-locale)))
     1070    (check-timezone-components 'timezone-locale-name tzc)
     1071    (let ((tzn (%timezone-components-ref/dst? tzc 'dst-name 'std-name)))
    10801072      ; TZ may not be set
    10811073      (and (not (eq? UNKNOWN-LOCAL-TZ-NAME tzn))
    10821074           tzn ) ) ) )
    10831075
    1084 ;;
    1085 
    10861076(define (timezone-locale-offset . args)
    1087   (let-optionals args ((tzi (local-timezone-locale)))
    1088     (check-timezone-locale 'timezone-locale-offset tzi)
    1089     (let* ((tzc (%timezone-locale-component tzi))
    1090            (tzo (timezone-component-ref tzc (if (%timezone-locale-dst? tzi) 'dst-offset 'std-offset))))
     1077  (let-optionals args ((tzc (local-timezone-locale)))
     1078    (check-timezone-components 'timezone-locale-offset tzc)
     1079    (let ((tzo (%timezone-components-ref/dst? tzc 'dst-offset 'std-offset)))
    10911080      ; TZ may not be set but if it is then convert to ISO 8601
    10921081      (if tzo (fxneg tzo) 0) ) ) )
    10931082
    1094 ;;
    1095 
    10961083(define (timezone-locale-dst? . args)
    1097   (let-optionals args ((tzi (local-timezone-locale)))
    1098     (check-timezone-locale 'timezone-locale-offset tzi)
    1099     (%timezone-locale-dst? tzi) ) )
     1084  (let-optionals args ((tzc (local-timezone-locale)))
     1085    (check-timezone-components 'timezone-locale-offset tzc)
     1086    (timezone-component-ref tzc 'dst?) ) )
    11001087
    11011088;;; Date Object (Public Immutable)
     
    12551242(define (make-date ns sec min hr dy mn yr tzo . rest)
    12561243  (let-optionals rest ((tzn #f) (dstf (void)))
    1257     (if (not (timezone-locale? tzo))
     1244    (if (not (timezone-components? tzo))
    12581245        (when (eq? (void) dstf) (set! dstf #f))
    12591246        (begin
     
    12821269  (unless (number? sec)
    12831270    (error 'seconds->date/type "invalid seconds" sec))
    1284   (let ((tzi (optional r #f)))
    1285     (when (boolean? tzi)
    1286       (set! tzi ((if tzi local-timezone-locale utc-timezone-locale))) )
    1287     (unless (timezone-locale? tzi)
    1288       (error 'seconds->date/type "invalid timezone-locale" tzi) )
     1271  (let ((tzc (optional r #f)))
     1272    (when (boolean? tzc)
     1273      (set! tzc ((if tzc local-timezone-locale utc-timezone-locale))) )
     1274    (unless (timezone-components? tzc)
     1275      (error 'seconds->date/type "invalid timezone-locale" tzc) )
    12891276    (let* ((fsec (exact->inexact sec))
    12901277           (isec (truncate fsec))
    1291            (tzo (timezone-locale-offset tzi))
     1278           (tzo (timezone-locale-offset tzc))
    12921279           (tv (seconds->utc-time (+ isec tzo))))
    12931280      (tm:make-date
     
    12951282       (vector-ref tv 0) (vector-ref tv 1) (vector-ref tv 2)
    12961283       (vector-ref tv 3) (fx+ 1 (vector-ref tv 4)) (fx+ 1900 (vector-ref tv 5))
    1297        tzo (timezone-locale-name tzi) (timezone-locale-dst? tzi)
     1284       tzo (timezone-locale-name tzc) (timezone-locale-dst? tzc)
    12981285       (vector-ref tv 6) (fx+ 1 (vector-ref tv 7)) #f) ) ) )
    12991286
    1300 (define (current-date . tzi) (apply time-utc->date (tm:current-time-utc) tzi))
     1287(define (current-date . tzc) (apply time-utc->date (tm:current-time-utc) tzc))
    13011288
    13021289;;
     
    14441431               (loop (cdr lst)) ) ) ) ) )
    14451432
    1446 (define (tm:time->date loc tim tzi)
     1433(define (tm:time->date loc tim tzc)
    14471434  ; The tz-info is caller's rest parameter
    1448   (let ((tzo (optional tzi (local-timezone-locale)))
     1435  (let ((tzo (optional tzc (local-timezone-locale)))
    14491436        (tzn #f)
    14501437        (dstf #f))
    1451       (when (timezone-locale? tzo)
     1438      (when (timezone-components? tzo)
    14521439        (set! dstf (timezone-locale-dst? tzo))
    14531440        (set! tzn (timezone-locale-name tzo))
     
    14631450            (tm:make-date (%time-nanosecond tim) sec min hr dy mn yr tzo tzn dstf #f #f #f) ) ) ) ) )
    14641451
    1465 (define (tm:time-tai->date loc tim tzi)
     1452(define (tm:time-tai->date loc tim tzc)
    14661453  (let ((tm-utc (tm:time-tai->time-utc tim (tm:as-empty-time tim))))
    14671454    (if (tm:tai-before-leap-second? tim)
    14681455        ; then time is *right* before the leap, we need to pretend to subtract a second ...
    1469         (let ((dat (tm:time->date loc (tm:subtract-duration tm-utc ONE-SECOND-DURATION tm-utc) tzi)))
     1456        (let ((dat (tm:time->date loc (tm:subtract-duration tm-utc ONE-SECOND-DURATION tm-utc) tzc)))
    14701457          (%date-second-set! dat SEC/MIN) ; Note full minute!
    14711458          dat )
    1472         (tm:time->date loc tm-utc tzi) ) ) )
    1473 
    1474 (define (time-tai->date tim . tzi)
     1459        (tm:time->date loc tm-utc tzc) ) ) )
     1460
     1461(define (time-tai->date tim . tzc)
    14751462  (tm:check-time-and-type 'time-tai->date tim 'time-tai)
    1476   (tm:time-tai->date 'time-tai->date tim tzi) )
    1477 
    1478 (define (time-utc->date tim . tzi)
     1463  (tm:time-tai->date 'time-tai->date tim tzc) )
     1464
     1465(define (time-utc->date tim . tzc)
    14791466  (tm:check-time-and-type 'time-utc->date tim 'time-utc)
    1480   (tm:time->date 'time-utc->date tim tzi) )
    1481 
    1482 (define (time-monotonic->date tim . tzi)
     1467  (tm:time->date 'time-utc->date tim tzc) )
     1468
     1469(define (time-monotonic->date tim . tzc)
    14831470  (tm:check-time-and-type 'time-monotonic->date tim 'time-monotonic)
    1484   (tm:time->date 'time-monotonic->date tim tzi) )
    1485 
    1486 (define (time->date tim . tzi)
     1471  (tm:time->date 'time-monotonic->date tim tzc) )
     1472
     1473(define (time->date tim . tzc)
    14871474  (%check-time 'time->date tim)
    14881475  (case (%time-type tim)
    1489     ((time-monotonic) (tm:time->date 'time->date tim tzi))
    1490     ((time-utc)       (tm:time->date 'time->date tim tzi))
    1491     ((time-tai)       (tm:time-tai->date 'time->date tim tzi))
     1476    ((time-monotonic) (tm:time->date 'time->date tim tzc))
     1477    ((time-utc)       (tm:time->date 'time->date tim tzc))
     1478    ((time-tai)       (tm:time-tai->date 'time->date tim tzc))
    14921479    (else ; This shouldn't happen
    14931480     (error 'time->date "invalid clock type" tim))) )
     
    17281715  (time-utc->time-monotonic! (julian-day->time-utc jdn)) )
    17291716
    1730 (define (julian-day->date jdn . tzi)
    1731   (apply time-utc->date (julian-day->time-utc jdn) tzi) )
     1717(define (julian-day->date jdn . tzc)
     1718  (apply time-utc->date (julian-day->time-utc jdn) tzc) )
    17321719
    17331720(define (modified-julian-day->time-utc mjdn)
     
    17401727  (julian-day->time-monotonic (+ mjdn TAI-EPOCH-IN-MODIFIED-JD)) )
    17411728
    1742 (define (modified-julian-day->date mjdn . tzi)
    1743   (apply julian-day->date (+ mjdn TAI-EPOCH-IN-MODIFIED-JD) tzi) )
     1729(define (modified-julian-day->date mjdn . tzc)
     1730  (apply julian-day->date (+ mjdn TAI-EPOCH-IN-MODIFIED-JD) tzc) )
    17441731
    17451732;; The Julian-day
Note: See TracChangeset for help on using the changeset viewer.