Changeset 15751 in project


Ignore:
Timestamp:
09/06/09 05:46:23 (10 years ago)
Author:
Kon Lovett
Message:

Save

Location:
release/4/srfi-19/trunk
Files:
8 edited

Legend:

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

    r15750 r15751  
    4343  time-resolution
    4444  make-time
    45   time?
    4645  time-type
    4746  time-nanosecond
     
    7473  leap-year? ; Actually part of SRFI 19 but not in original document
    7574  date-year-day
     75  days-in-month/year
     76  natural-year
    7677  date-week-day
    7778  date-week-number
     
    141142  milliseconds->seconds
    142143  time->date
    143   make-timezone-locale
    144   timezone-locale?
    145144  timezone-locale-name
    146145  timezone-locale-offset
     
    172171          #;srfi-8
    173172          (only srfi-18 seconds->time time->seconds)
    174           (prefix srfi-18 srfi-18:)
     173          (rename srfi-18 (seconds->time srfi-18:seconds->time) (time->seconds srfi-18:time->seconds))
    175174          (only numbers zero? negative? positive? real?)
    176175          miscmacros
    177           type-checks type-errors
    178           srfi-19-timezone srfi-19-support)
    179 
    180   (require-library scheme chicken #;srfi-8
    181                    srfi-18
    182                    numbers
    183                    miscmacros
     176          (only locale-components check-timezone-components timezone-components?)
     177          type-checks
     178          type-errors
     179          srfi-19-timezone
     180          srfi-19-support)
     181
     182  (require-library #;srfi-8 srfi-18 numbers miscmacros locale-components
     183                   type-checks type-errors
    184184                   srfi-19-timezone srfi-19-support)
    185185
     
    250250  (let-optionals args ((tt 'duration))
    251251    (check-time-type 'seconds->time/type tt)
    252     (receive (ns sec)
    253         (tm:seconds->time-values sec)
    254       (check-time-elements 'seconds->time/type tt ns tsec)
    255       (*make-time tt ns tsec) ) ) )
     252    (tm:seconds->time sec tt) ) )
    256253
    257254;; Time record-type operations
     
    389386          (let ((tim (car ls)))
    390387            (check-time-and-type 'time-max tim tt)
    391             (loop (if (tm:time<? acc tim) tim acc) (cdr ls)) ) ) ) ) )
     388            (loop (tm:time-max acc tim) (cdr ls)) ) ) ) ) )
    392389
    393390(define (time-min tim1 . rest)
     
    398395          (let ((tim (car ls)))
    399396            (check-time-and-type 'time-min tim tt)
    400             (loop (if (tm:time>? acc tim) tim acc) (cdr ls)) ) ) ) ) )
     397            (loop (tm:time-min acc tim) (cdr ls)) ) ) ) ) )
    401398
    402399;; Time Arithmetic
     
    567564;; the optional 2nd argument. The default is #f.
    568565
    569 (define (seconds->date/type sec . tzc)
     566(define (seconds->date/type sec . tzi)
    570567  (check-raw-seconds 'seconds->date/type sec)
    571   (let ((tzc (optional tzc #f)))
    572     (if (boolean? tzc)
    573         (set! tzc ((if tzc local-timezone-locale utc-timezone-locale)))
    574         (check-timezone-components 'seconds->date/type tzc) )
     568  (let ((tzc (checked-optional-timezone-info 'seconds->date/type (optional tzi #t))))
     569    (check-timezone-components 'seconds->date/type tzc)
    575570    (tm:seconds->date/type sec tzc) ) )
    576571
    577572(define (current-date . tzi)
    578   (tm:time-utc->date (tm:current-time-utc)
    579                      (checked-optional-timezone-info 'current-date (optional tzi #f))) )
     573  (tm:current-date (checked-optional-timezone-info 'current-date (optional tzi #t))) )
    580574
    581575;;
     
    626620  (check-date loc dat1)
    627621  (check-date loc dat2)
    628   (check-compatible-timezone-offsets loc dat1 dat2)
     622  (check-date-compatible-timezone-offsets loc dat1 dat2)
    629623  (tm:date-compare dat1 dat2) )
    630624
     
    658652        (let ((dat (car ls)))
    659653          (check-date 'date-max dat)
    660           (check-compatible-timezone-offsets 'date-max acc dat)
     654          (check-date-compatible-timezone-offsets 'date-max acc dat)
    661655          (loop (if (fx> 0 (tm:date-compare acc dat)) dat acc) (cdr ls)) ) ) ) )
    662656
     
    667661        (let ((dat (car ls)))
    668662          (check-date 'date-min dat)
    669           (check-compatible-timezone-offsets 'date-min acc dat)
     663          (check-date-compatible-timezone-offsets 'date-min acc dat)
    670664          (loop (if (fx< 0 (tm:date-compare acc dat)) dat acc) (cdr ls)) ) ) ) )
    671665
     
    702696(define (time-tai->date tim . tzi)
    703697  (check-time-and-type 'time-tai->date tim 'tai)
    704   (tm:time-tai->date tim (checked-optional-timezone-info 'time-tai->date (optional tzi #f))) )
     698  (tm:time-tai->date tim (checked-optional-timezone-info 'time-tai->date (optional tzi #t))) )
    705699
    706700(define (time-utc->date tim . tzi)
    707701  (check-time-and-type 'time-utc->date tim 'utc)
    708   (tm:time-utc->date tim (checked-optional-timezone-info 'time-utc->date (optional tzi #f))) )
     702  (tm:time-utc->date tim (checked-optional-timezone-info 'time-utc->date (optional tzi #t))) )
    709703
    710704(define (time-monotonic->date tim . tzi)
    711705  (check-time-and-type 'time-monotonic->date tim 'monotonic)
    712   (tm:time-utc->date tim (checked-optional-timezone-info 'time-monotonic->date (optional tzi #f))) )
     706  (tm:time-utc->date tim (checked-optional-timezone-info 'time-monotonic->date (optional tzi #t))) )
    713707
    714708(define (time->date tim . tzi)
    715709  (check-time 'time->date tim)
    716   (let ((tzi (checked-optional-timezone-info 'time->date (optional tzi #f))))
    717     (or (tm:time->date tim tzi)
    718         ; This shouldn't happen
    719         (error-clock-type 'time->date tim)) ) )
     710  (or (tm:time->date tim (checked-optional-timezone-info 'time->date (optional tzi #t)))
     711      ; This shouldn't happen
     712      (error-clock-type 'time->date tim)) )
    720713
    721714;; Date to Time
     
    741734;; Given a 'two digit' number, find the year within 50 years +/-
    742735
    743 (define (natural-year n)
     736(define (natural-year n . tzi)
    744737  (check-date-year 'natural-year n)
    745   (tm:natural-year n) )
     738  (tm:natural-year n (checked-optional-timezone-info 'natural-year (optional tzi #t))) )
    746739
    747740;; Leap Year
     
    755748(define (date-year-day dat)
    756749  (check-date 'date-year-day dat)
    757   (or (tm:date-yday dat)
    758       (tm:cache-date-year-day dat) ) )
    759 
    760 (define (month-days yr mn)
    761   (check-date-year 'month-days yr)
    762   (check-date-month 'month-days mn)
     750  (tm:date-year-day dat) )
     751
     752(define (days-in-month/year mn yr)
     753  (check-date-year 'days-in-month/year yr)
     754  (check-date-month 'days-in-month/year mn)
    763755  (tm:days-in-month yr mn) )
    764756
     
    767759(define (date-week-day dat)
    768760  (check-date 'date-week-day dat)
    769   (or (tm:date-wday dat)
    770       (tm:cache-date-week-day dat) ) )
     761  (tm:date-week-day dat) )
    771762
    772763;;
     
    775766  (check-date 'date-week-number dat)
    776767  (let ((day-of-week-starting-week (optional args 0)))
    777     (check-week-day 'date-week-numbe day-of-week-starting-week)
     768    (check-week-day 'date-week-number day-of-week-starting-week)
    778769    (tm:date-week-number dat day-of-week-starting-week) ) )
    779770
     
    843834  (check-julian-day 'julian-day->date jdn)
    844835  (tm:time-utc->date (tm:julian-day->time-utc jdn)
    845                      (checked-optional-timezone-info 'julian-day->date (optional tzi #f))) )
     836                     (checked-optional-timezone-info 'julian-day->date (optional tzi #t))) )
    846837
    847838(define (modified-julian-day->time-utc mjdn)
     
    862853  (check-julian-day 'modified-julian-day->date mjdn)
    863854  (tm:time-utc->date (tm:julian-day->time-utc (tm:modified-julian-day->julian-day mjdn))
    864                      (checked-optional-timezone-info 'modified-julian-day->date (optional tzi #f))) )
     855                     (checked-optional-timezone-info 'modified-julian-day->date (optional tzi #t))) )
    865856
    866857;; The Julian-day
  • release/4/srfi-19/trunk/srfi-19-io.scm

    r15750 r15751  
    4141          #;srfi-6
    4242          (only srfi-13 string-pad)
     43          (only ports with-output-to-string)
     44          (only data-structures noop)
    4345          (only numbers / number->string)
    4446          srfi-29
     
    4648          srfi-19-support)
    4749
    48   (require-library srfi-1 #;srfi-6 srfi-13 srfi-29 locale numbers
     50  (require-library srfi-1 #;srfi-6 srfi-13 ports data-structures srfi-29 locale numbers
    4951                   #;srfi-19-core srfi-19-support)
    5052
     
    277279    (cons #\s
    278280      (lambda (date pad-with port)
    279         (display (time-second (tm:date->time-utc date)) port)))
     281        (display (tm:time-second (tm:date->time-utc date)) port)))
    280282
    281283    (cons #\S
     
    546548        (eireader2 (make-integer-exact-reader 2))
    547549        (eireader4 (make-integer-exact-reader 4))
    548         (locale-reader-abbr-weekday (make-locale-reader tm:locale-abbr-weekday->index))
    549         (locale-reader-long-weekday (make-locale-reader tm:locale-long-weekday->index))
    550         (locale-reader-abbr-month   (make-locale-reader tm:locale-abbr-month->index))
    551         (locale-reader-long-month   (make-locale-reader tm:locale-long-month->index))
     550        (locale-reader-abbr-weekday (make-locale-reader locale-abbr-weekday->index))
     551        (locale-reader-long-weekday (make-locale-reader locale-long-weekday->index))
     552        (locale-reader-abbr-month   (make-locale-reader locale-abbr-month->index))
     553        (locale-reader-long-month   (make-locale-reader locale-long-month->index))
    552554        (char-fail (lambda (ch) #t))
    553555        (do-nothing noop #;(lambda (val object) (void))))
     
    606608              (char=? c #\+)
    607609              (char=? c #\-)))
    608         tm:zone-reader
     610        zone-reader
    609611        (lambda (val object)
    610612          (tm:date-zone-offset-set! object val))) ) ) )
     
    667669            ((port? src)    (set! port src))
    668670            (src            (set! port (current-input-port))))
    669       (tm:date-reader newdate (string->list template-string) (string-length template-string) port)
     671      (date-reader newdate (string->list template-string) (string-length template-string) port)
    670672      (unless (date-complete?)
    671673        (error-bad-date-template 'scan-date "date read incomplete" template-string newdate))
  • release/4/srfi-19/trunk/srfi-19-period.scm

    r15750 r15751  
    22;;;; Chicken port, Kon Lovett, Apr '07
    33
     4(include "chicken-primitive-object-inlines")
    45
    56(module srfi-19-period (;export
    67    time-period?
    78    time-period-null?
    8     time-period-compare
     9    #;time-period-compare
    910    time-period=?
    1011    time-period<?
     
    3940          type-checks
    4041          type-errors
    41           #;srfi-19-core
     42          srfi-19-core
    4243          srfi-19-support)
    4344
    44   (require-library #;srfi-8 srfi-9-ext type-checks type-errors #;srfi-19-core srfi-19-support)
     45  (require-library #;srfi-8 srfi-9-ext type-checks type-errors srfi-19-core srfi-19-support)
    4546
    4647;;;
     
    125126
    126127(define (tm:ensure-compatible-date loc tim dat)
    127   (case (tm:time-type tim)
    128     ((utc)       (date->time-utc dat))
    129     ((tai)       (date->time-tai dat))
    130     ((monotonic) (date->time-monotonic dat))
    131     (else
    132      (error-incompatible-clock-type loc tim))) )
     128  (or (tm:date->time dat (tm:time-type tim))
     129      (error-incompatible-clock-type loc tim)) )
    133130
    134131(define (tm:time-period-type=? per1 per2)
     
    199196
    200197(define (make-null-time-period . args)
    201   (let-optionals args ((timtyp (default-date-clock-type)))
    202     (tm:make-time-period-zero timtyp) ) )
     198  (let-optionals args ((tt (default-date-clock-type)))
     199    (tm:make-time-period-zero tt) ) )
    203200
    204201(define (make-time-period beg end . args)
    205   (let-optionals args ((timtyp (default-date-clock-type)))
     202  (let-optionals args ((tt (default-date-clock-type)))
     203    (check-clock-type 'make-time-period tt)
    206204    ;
    207     (cond ((real? beg)  (set! beg (seconds->time/type beg timtyp)) )
    208           ((date? beg)  (set! beg (date->time beg timtyp)) ) )
     205    (cond ((real? beg)  (set! beg (tm:seconds->time beg tt)) )
     206          ((date? beg)  (set! beg (tm:date->time beg tt)) ) )
    209207    (check-time 'make-time-period beg 'begin)
    210208    (when (tm:time-has-type? (tm:time-type beg) 'duration)
    211209      (error-clock-type 'make-time-period beg 'begin))
    212210    ;
    213     (cond ((real? end)  (set! end (seconds->time/type end 'duration)) )
     211    (cond ((real? end)  (set! end (tm:seconds->time end 'duration)) )
    214212          ((date? end)  (set! end (tm:ensure-compatible-date 'make-time-period beg end)) ) )
    215213    (check-time 'make-time-period end 'end)
     
    221219(define (copy-time-period per)
    222220  (check-time-period 'copy-time-period per)
    223   (*make-time-period (copy-time (*time-period-begin per)) (copy-time (*time-period-end per))) )
     221  (*make-time-period (tm:copy-time (*time-period-begin per)) (copy-time (*time-period-end per))) )
    224222
    225223(define (time-period-type per)
  • release/4/srfi-19/trunk/srfi-19-support.scm

    r15750 r15751  
    7474  date-month?
    7575  date-year?
    76   timezone-name?
    77   timezone-info?
     76  week-day?
    7877  julian-day?
    7978  ;
     
    9998  check-date-month
    10099  check-date-year
    101   check-timezone-name
    102   check-timezone-info
    103100  check-date-elements
    104   check-compatible-timezone-offsets
     101  check-date-compatible-timezone-offsets
     102  check-week-day
    105103  check-julian-day
    106104  ;
     
    119117  error-date-month
    120118  error-date-year
    121   error-timezone-name
    122   error-timezone-info
    123   error-incompatible-timezone
     119  error-date-compatible-timezone
     120  error-week-day
    124121  error-julian-day
    125122  ;
     
    130127  tm:some-time
    131128  tm:as-some-time
     129  tm:time-type
     130  tm:time-nanosecond
     131  tm:time-second
     132  tm:time-type-set!
    132133  tm:time-nanosecond-set!
    133134  tm:time-second-set!
     
    144145  tm:milliseconds->time-values
    145146  tm:seconds->time-values
    146   tm:current-sub-milliseconds
    147   tm:current-nanoseconds
     147  tm:seconds->time
    148148  tm:current-time-values
    149149  tm:current-time-utc
     
    160160  tm:time>?
    161161  tm:time>=?
    162   #;tm:time-max
    163   #;tm:time-min
     162  tm:time-max
     163  tm:time-min
    164164  tm:time-difference
    165165  tm:add-duration
     
    177177  tm:leap-year?
    178178  tm:days-in-month
     179  tm:date-nanosecond
     180  tm:date-second
     181  tm:date-minute
     182  tm:date-hour
     183  tm:date-day
     184  tm:date-month
     185  tm:date-year
     186  tm:date-zone-offset
     187  tm:date-zone-name
     188  tm:date-dst?
     189  tm:date-wday
     190  tm:date-yday
     191  tm:date-jday
    179192  tm:date-nanosecond-set!
    180193  tm:date-second-set!
     
    189202  tm:copy-date
    190203  tm:seconds->date/type
     204  tm:current-date
    191205  tm:date-compare
    192206  tm:decode-julian-day-number
     
    207221  tm:natural-year
    208222  tm:year-day
    209   tm:cache-date-year-day
     223  tm:date-year-day
    210224  tm:week-day
    211225  tm:days-before-first-week
    212   tm:cache-date-week-day
     226  tm:date-week-day
    213227  tm:date-week-number
    214228  tm:julian-day->modified-julian-day
     
    236250                         inexact->exact exact->inexact
    237251                         string->number)
    238           (except chicken time)
     252          chicken
    239253          #;srfi-8
     254          (only posix seconds->utc-time)
    240255          (only extras format read-line)
    241           (only ports with-input-from-port)
     256          (only ports with-input-from-port with-input-from-string)
    242257          (only numbers + - * / remainder quotient
    243258                        abs round floor truncate
    244259                        real? integer? inexact? zero? negative? positive?
    245260                        = <= >= < >
    246                        inexact->exact exact->inexact
    247                        string->number)
     261                        inexact->exact exact->inexact
     262                        string->number)
    248263          locale
    249264          srfi-9-ext
    250           type-checks type-errors
    251           (only srfi-19-timezone timezone-locale-name timezone-locale-offset timezone-locale-dst?))
    252 
    253   (require-library scheme chicken #;srfi-8 srfi-18 extras ports
     265          type-checks
     266          type-errors
     267          srfi-19-timezone)
     268
     269  (require-library #;srfi-8 srfi-18 posix extras ports
    254270                   numbers locale srfi-9-ext type-checks type-errors
    255271                   srfi-19-timezone)
     
    366382       (let ((line (read-line)))
    367383         (if (eof-object? line) ls
    368              (let ((data (with-input-from-string (conc #\( line #\)) read)))
     384             (let ((data (with-input-from-string (string-append "(" line ")") read)))
    369385               (let ((year (car data))
    370386                     (jd   (cadddr (cdr data)))
     
    461477;;
    462478
    463 (define (time-type? obj) (memq? obj '(monotonic utc tai gc duration process thread)))
     479(define (time-type? obj) (memq obj '(monotonic utc tai gc duration process thread)))
    464480(define (time-seconds? obj) (integer? obj))
    465481(define (time-nanoseconds? obj) (and (fixnum? obj) (fx< -NS/S obj) (fx< obj NS/S)))
     
    530546    (values ns sec) ) )
    531547
     548(define (tm:milliseconds->time ms tt)
     549  (receive (ns sec)
     550      (tm:milliseconds->time-values ms)
     551    (tm:make-time tt ns sec) ) )
     552
     553(define (tm:seconds->time sec tt)
     554  (receive (ns sec)
     555      (tm:seconds->time-values sec)
     556    (tm:make-time tt ns sec) ) )
     557
    532558;; Current time routines
    533559
     
    557583
    558584(define (tm:current-time-thread)
    559   (milliseconds->time (current-thread-milliseconds) 'thread) )
     585  (tm:milliseconds->time (current-thread-milliseconds) 'thread) )
    560586
    561587(define (tm:current-time-process)
    562   (milliseconds->time (current-process-milliseconds) 'process) )
     588  (tm:milliseconds->time (current-process-milliseconds) 'process) )
    563589
    564590(define (tm:current-time-gc)
    565   (milliseconds->time (total-gc-milliseconds) 'gc) )
     591  (tm:milliseconds->time (total-gc-milliseconds) 'gc) )
    566592
    567593;; -- Time Resolution
     
    638664           (fx>= (*time-nanosecond tim1) (*time-nanosecond tim2)))) )
    639665
    640 #; ;UNUSED
    641 (define (tm:time-max acc ls)
    642   (if (null? ls) acc
    643       (let ((tim (car ls)))
    644         (tm:time-max (if (tm:time<? acc tim) tim acc) (cdr ls)))) )
    645 
    646 #; ;UNUSED
    647 (define (tm:time-min acc ls)
    648   (if (null? ls) acc
    649       (let ((tim (car ls)))
    650         (tm:time-min (if (tm:time>? acc tim) tim acc) (cdr ls)))) )
     666(define (tm:time-max tim1 tim2)
     667  (if (tm:time>? tim1 tim2) tim1 tim2) )
     668
     669(define (tm:time-min tim1 tim2)
     670  (if (tm:time<? tim1 tim2) tim1 tim2) )
    651671
    652672;; Time Arithmetic
     
    758778;;
    759779
    760 (define (clock-type? obj) (memq? obj '(monotonic tai utc)))
     780(define (clock-type? obj) (memq obj '(monotonic tai utc)))
    761781
    762782;; Leap Year Test
     
    836856(define (date-year? obj) (and (fixnum? obj) (not (fx= 0 obj))))
    837857
    838 (define (timezone-name? obj) (or (not obj) (string? obj)))
    839 
    840 (define (timezone-info? obj)
    841   (or (timezone-components? obj)
    842       (timezone-offset? obj) ) )
    843 
    844858;;
    845859
     
    851865(define-check+error-type date-month)
    852866(define-check+error-type date-year)
    853 
    854 (define-check+error-type timezone-name)
    855 (define-check+error-type timezone-info)
    856867
    857868(define (check-date-elements loc ns sec min hr dy mn yr tzo tzn)
     
    865876  (check-timezone-offset loc tzo "date-timezone-offset")
    866877  (check-timezone-name loc tzn "date-timezone-name") )
     878
     879;;
     880
     881(define (error-date-compatible-timezone loc dat1 dat2)
     882  (signal-type-error loc "not compatible timezones" dat1 dat2) )
     883
     884(define (check-date-compatible-timezone-offsets loc dat1 dat2)
     885  (unless (fx= (*date-zone-offset dat1) (*date-zone-offset dat2))
     886    (error-date-compatible-timezone loc dat1 dat2) ) )
    867887
    868888;;
     
    937957     (vector-ref tv 6) (fx+ 1 (vector-ref tv 7)) #f) ) )
    938958
     959(define (tm:current-date tzi) (tm:time-utc->date (tm:current-time-utc) tzi))
     960
    939961;; Date Comparison
    940 
    941 ;;
    942 
    943 (define (error-incompatible-timezone loc dat1 dat2)
    944   (signal-type-error loc "incompatible timezone" dat1 dat2) )
    945 
    946 (define (check-compatible-timezone-offsets loc dat1 dat2)
    947   (unless (fx= (*date-zone-offset dat1) (*date-zone-offset dat2))
    948     (error-compatible-timezone loc dat1 dat2) ) )
    949 
    950 ;;
    951962
    952963(define (tm:date-compare dat1 dat2)
     
    967978;; Time to Date
    968979
    969 (define ONE-NANOSECOND-DURATION (*make-time 'duration 1 0))
     980(define ONE-SECOND-DURATION (*make-time 'duration 0 1))
    970981
    971982;; Gives the seconds/day/month/year
     
    11421153;; Given a 'two digit' number, find the year within 50 years +/-
    11431154
    1144 (define (tm:natural-year n)
     1155(define (tm:natural-year n tzi)
    11451156  (if (or (fx< n 0) (fx>= n 100)) n
    1146       (let* ((current-year (date-year (current-date)))
     1157      (let* ((current-year (*date-year (tm:current-date tzi)))
    11471158             (current-century (fx* (fx/ current-year 100) 100)))
    11481159        (if (fx<= (fx- (fx+ current-century n) current-year) 50) (fx+ current-century n)
     
    11631174    yrdy ) )
    11641175
     1176(define (tm:date-year-day dat)
     1177  (or (*date-yday dat)
     1178      (tm:cache-date-year-day dat) ) )
     1179
    11651180;; Week Day
     1181
     1182(define (week-day? obj) (and (fixnum? obj) (fx<= 0 obj) (fx<= obj 6)))
     1183
     1184(define-check+error-type week-day)
    11661185
    11671186;; Using Gregorian Calendar (from Calendar FAQ)
     
    11821201    wdy ) )
    11831202
     1203(define (tm:date-week-day dat)
     1204  (or (*date-wday dat)
     1205      (tm:cache-date-week-day dat) ) )
     1206
    11841207(define (tm:days-before-first-week dat day-of-week-starting-week)
    11851208  (fxmod (fx- day-of-week-starting-week (tm:week-day 1 1 (*date-year dat))) DY/WK) )
    11861209
    11871210(define (tm:date-week-number dat day-of-week-starting-week)
    1188   (fx/ (fx- (date-year-day dat) (tm:days-before-first-week dat day-of-week-starting-week))
     1211  (fx/ (fx- (tm:date-year-day dat) (tm:days-before-first-week dat day-of-week-starting-week))
    11891212        DY/WK) )
    11901213
  • release/4/srfi-19/trunk/srfi-19-timezone.scm

    r15750 r15751  
    66  timezone-locale-name
    77  timezone-locale-offset
    8   timezone-locale-dst?)
     8  timezone-locale-dst?
     9  timezone-name?
     10  check-timezone-name
     11  timezone-info?
     12  error-timezone-name
     13  check-timezone-info
     14  error-timezone-info
     15  checked-optional-timezone-info)
    916
    10   (import scheme chicken miscmacros locale type-errors)
     17  (import scheme chicken miscmacros locale type-checks type-errors)
    1118 
    12   (require-library miscmacros locale type-errors)
     19  (require-library miscmacros locale type-checks type-errors)
    1320
    1421  (declare
     
    6471    (timezone-component-ref tzc 'dst?) ) )
    6572
     73;;
     74
     75(define (timezone-name? obj) (or (not obj) (string? obj)))
     76
     77(define-check+error-type timezone-name)
     78
     79(define (timezone-info? obj)
     80  (or (timezone-components? obj)
     81      (timezone-offset? obj) ) )
     82
     83(define-check+error-type timezone-info)
     84
     85;;
     86
     87(define (checked-optional-timezone-info loc tzi)
     88  (cond ((not tzi)                    (utc-timezone-locale))
     89        ((boolean? tzi)               (local-timezone-locale))
     90        ((timezone-components? tzi)   tzi)
     91        ((fixnum? tzi)                tzi)
     92        (else
     93          (error-timezone-info loc tzi)) ) )
     94
    6695) ;module srfi-19-timezone
  • release/4/srfi-19/trunk/srfi-19.meta

    r15750 r15751  
    1313        "srfi-19-common.scm"
    1414        "srfi-19-support.scm"
     15        "srfi-19-timezone.scm"
    1516        "srfi-19-core.scm"
    1617        "srfi-19-io.scm"
  • release/4/srfi-19/trunk/srfi-19.scm

    r15750 r15751  
    147147  scan-date
    148148  ;; SRFI-19 extensions
     149  timezone-name?
     150  timezone-info?
    149151  local-timezone-locale
    150152  utc-timezone-locale
  • release/4/srfi-19/trunk/srfi-19.setup

    r15750 r15751  
    1010
    1111(setup-shared-extension-module 'srfi-19-timezone (extension-version "3.0.0")
    12   #:compile-options '(-inline -local -inline-global -no-procedure-checks))
     12  #:compile-options '(-inline -local -no-procedure-checks))
    1313
    1414(setup-shared-extension-module 'srfi-19-support (extension-version "3.0.0")
    15   ;#:inline? #t
    16   #:compile-options '(-optimize-level 4 -debug-level 0 -inline -local -inline-global))
     15  #:compile-options '(-optimize-level 4 -debug-level 0))
    1716
    1817(setup-shared-extension-module 'srfi-19-core (extension-version "3.0.0")
    19   #:compile-options '(-inline -local -inline-global -no-procedure-checks))
     18  #:compile-options '(-inline -local -no-procedure-checks))
    2019
    2120(setup-shared-extension-module 'srfi-19-io (extension-version "3.0.0")
    22   #:compile-options '(-inline -local -inline-global -no-procedure-checks))
     21  #:compile-options '(-inline -local -no-procedure-checks))
    2322
    2423(setup-shared-extension-module 'srfi-19-period (extension-version "3.0.0")
    25   #:compile-options '(-inline -local -inline-global -no-procedure-checks))
     24  #:compile-options '(-inline -local -no-procedure-checks))
    2625
    2726(setup-shared-extension-module 'srfi-19 (extension-version "3.0.0")
    28   #:compile-options '(-inline -local -inline-global -no-procedure-checks))
     27  #:compile-options '(-inline -local -no-procedure-checks))
Note: See TracChangeset for help on using the changeset viewer.