Changeset 38126 in project


Ignore:
Timestamp:
01/16/20 04:30:28 (5 weeks ago)
Author:
Kon Lovett
Message:

genint - fx or exact (?), check- returns the object

Location:
release/5/srfi-19/trunk
Files:
6 edited

Legend:

Unmodified
Added
Removed
  • release/5/srfi-19/trunk/srfi-19-date.scm

    r38112 r38126  
    213213
    214214(define (copy-date dat)
    215   (check-date 'copy-date dat)
    216   (tm:copy-date dat) )
     215  (tm:copy-date (check-date 'copy-date dat)) )
    217216
    218217;; Converts a seconds value, may be fractional, into a date type.
     
    222221
    223222(define (seconds->date sec . tzi)
    224   (let ((tzc (checked-optional-timezone-info 'seconds->date (optional tzi #t))))
    225     (check-timezone-components 'seconds->date tzc)
    226     (tm:seconds->date/type (check-raw-seconds 'seconds->date sec) tzc) ) )
     223  (tm:seconds->date/type
     224    (check-raw-seconds 'seconds->date sec)
     225    (check-timezone-components 'seconds->date
     226      (checked-optional-timezone-info 'seconds->date
     227        (optional tzi #t)))) )
    227228
    228229(define (date->seconds dat #!optional (tt (default-date-clock-type)))
    229230  (let* (
    230     (dat (check-date 'date->seconds dat))
     231    (dat
     232      (check-date 'date->seconds dat))
    231233    (tim
    232234      (case (check-clock-type 'date->seconds tt)
     
    237239
    238240(define (current-date . tzi)
    239   (tm:current-date (checked-optional-timezone-info 'current-date (optional tzi #t))) )
     241  (tm:current-date
     242    (checked-optional-timezone-info 'current-date
     243      (optional tzi #t))) )
    240244
    241245;;
  • release/5/srfi-19/trunk/srfi-19-support.scm

    r38121 r38126  
    256256;; return fixnums when possible.
    257257;;
    258 ;; ##sys#integer?
    259 ;; returns #t for integer fixnum or flonum
    260 ;;
    261 ;; C_double_to_number
    262 ;; returns a fixnum for the flonum x iff x isa integer in fixnum-range
    263 ;; otherwise the flonum x
    264 ;;
    265 ;; When domain is integer and range is fixnum
    266 ;; Number MUST be a fixnum or flonum
     258;; Number MUST be a fixnum or bignum
    267259
    268260(define-syntax number->genint
     
    270262    ((_ ?x)
    271263      (let ((x ?x))
    272         (if (exact? x)
     264        (if (fixnum? x)
    273265          x
    274266          (inexact->exact (floor x)) ) ) ) ) )
     
    522514(define (normalize-time ns sec min hr)
    523515  (let*-values (
    524       ((ns ns-sec)    (normalize-nanoseconds ns))
    525       ((sec sec-min)  (normalize-timeval (+ sec ns-sec) SEC/MIN))
    526       ((min min-hr)   (normalize-timeval (+ min sec-min) MIN/HR))
    527       ((hr hr-dy)     (normalize-timeval (+ hr min-hr) HR/DY)) )
     516    ((ns ns-sec)    (normalize-nanoseconds ns))
     517    ((sec sec-min)  (normalize-timeval (+ sec ns-sec) SEC/MIN))
     518    ((min min-hr)   (normalize-timeval (+ min sec-min) MIN/HR))
     519    ((hr hr-dy)     (normalize-timeval (+ hr min-hr) HR/DY)) )
    528520    (values ns sec min hr (+ dy hr-dy)) ) )
    529521
     
    679671
    680672(define (tm:milliseconds->seconds ms)
    681   (/ (exact->inexact ms) MS/S) )
     673  (/ ms #;(exact->inexact ms) MS/S) )
    682674
    683675(define-syntax tm:time->seconds
     
    691683          hours minutes seconds
    692684          milliseconds microseconds nanoseconds)
    693         (let ((nanos (+ (* milliseconds NS/MS) (* microseconds NS/MuS) nanoseconds))
    694         (secs (+ (* days SEC/DY) (* hours SEC/HR) (* minutes SEC/MIN) seconds)) )
    695     (let-values (((ns-ns ns-secs)
    696                   (normalize-nanoseconds (+ nanos (* (- secs (floor secs)) NS/S)))))
     685        (let (
     686          (nanos (+ (* milliseconds NS/MS) (* microseconds NS/MuS) nanoseconds))
     687    (secs (+ (* days SEC/DY) (* hours SEC/HR) (* minutes SEC/MIN) seconds)) )
     688    (let-values (
     689      ((ns-ns ns-secs)
     690        (normalize-nanoseconds (+ nanos (* (- secs (floor secs)) NS/S)))) )
    697691      (values ns-ns (+ (floor secs) ns-secs)) ) ) )
    698692
    699693(define (tm:seconds->time-values sec)
    700   (let* ((tsec (number->genint sec))
    701          (ns (number->genint (exact->inexact (round (* (- sec tsec) NS/S))))) )
     694  (let* (
     695    (tsec (number->genint sec))
     696    (ns (number->genint (round (* (- sec tsec) NS/S)))) )
    702697    (values ns tsec) ) )
    703698
    704699(define (tm:milliseconds->time-values ms)
    705   (let ((ns (fx* (number->genint (remainder ms MS/S)) NS/MS))
    706         (sec (quotient ms MS/S)) )
     700  (let (
     701    (ns (fx* (number->genint (remainder ms MS/S)) NS/MS))
     702    (sec (quotient ms MS/S)) )
    707703    (values ns sec) ) )
    708704
     
    14461442(define (tm:seconds->date/type sec tzc)
    14471443  (let* (
    1448     (fsec (exact->inexact sec))
    1449     (isec (number->genint fsec))
     1444    (isec (number->genint sec))
    14501445    (tzo (timezone-locale-offset tzc))
    14511446    (tv (seconds->utc-time (+ isec tzo))) )
    14521447    (tm:make-date
    1453       (round (* (- fsec isec) NS/S))
     1448      (round (* (- sec isec) NS/S))
    14541449      (vector-ref tv 0) (vector-ref tv 1) (vector-ref tv 2)
    14551450      (vector-ref tv 3) (fx+ 1 (vector-ref tv 4)) (fx+ 1900 (vector-ref tv 5))
     
    14591454(define-syntax tm:current-date
    14601455        (syntax-rules ()
    1461                 ((_ ?tzi) (let ((tzi ?tzi)) (tm:time-utc->date (tm:current-time-utc) tzi)) ) ) )
     1456                ((_ ?tzi)
     1457                  (let ((tzi ?tzi))
     1458                    (tm:time-utc->date (tm:current-time-utc) tzi)) ) ) )
    14621459
    14631460;; Date Comparison
     
    17711768;; Date to Julian-day
    17721769
     1770(define (tm:jd-time->seconds ns sec min hr tzo)
     1771  (+
     1772    (fx+
     1773      (fx+
     1774        (fx* hr SEC/HR)
     1775        (fx+ (fx* min SEC/MIN) sec))
     1776      (fxneg tzo))
     1777    (/ ns NS/S)) )
     1778
    17731779; Does the nanoseconds value contribute anything to the julian day?
    17741780; The range is < 1 second here (but not in the reference).
     
    17791785      (tm:encode-julian-day-number dy mn yr))
    17801786    (timsecs
    1781       (+
    1782         (fx+
    1783           (fx+
    1784             (fx* hr SEC/HR)
    1785             (fx+ (fx* min SEC/MIN) sec))
    1786           (fxneg tzo))
    1787         (/ ns NS/S))) )
     1787      (tm:jd-time->seconds ns sec min hr tzo)) )
    17881788    (+ (- jdn ONE-HALF) (/ timsecs SEC/DY)) ) )
    17891789#; ;inexact version
  • release/5/srfi-19/trunk/srfi-19-time.scm

    r38112 r38126  
    138138                (hours 0) (minutes 0) (seconds 0)
    139139                (milliseconds 0) (microseconds 0) (nanoseconds 0))
    140   (check-real 'make-duration days "days")
    141   (check-real 'make-duration hours "hours")
    142   (check-real 'make-duration minutes "minutes")
    143   (check-real 'make-duration seconds "seconds")
    144   (check-real 'make-duration milliseconds "milliseconds")
    145   (check-real 'make-duration microseconds "microseconds")
    146   (check-real 'make-duration nanoseconds "nanoseconds")
    147140  (receive (ns sec)
    148       (tm:duration-elements->time-values days hours minutes seconds
    149                                          milliseconds microseconds nanoseconds)
     141            (tm:duration-elements->time-values
     142              (check-real 'make-duration days 'days)
     143              (check-real 'make-duration hours 'hours)
     144              (check-real 'make-duration minutes 'minutes)
     145              (check-real 'make-duration seconds 'seconds)
     146              (check-real 'make-duration milliseconds 'milliseconds)
     147              (check-real 'make-duration microseconds 'microseconds)
     148              (check-real 'make-duration nanoseconds 'nanoseconds))
    150149    (check-time-elements 'make-duration 'duration ns sec)
    151150    (tm:make-time 'duration ns sec) ) )
     
    192191
    193192(define (milliseconds->time ms . args)
    194   (check-raw-milliseconds 'milliseconds->time ms)
    195193  (let-optionals args ((tt 'duration))
    196     (receive (ns sec) (tm:milliseconds->time-values ms)
     194    (receive (ns sec)
     195                (tm:milliseconds->time-values
     196                  (check-raw-milliseconds 'milliseconds->time ms))
    197197      (check-time-elements 'milliseconds->time tt ns sec)
    198198      (tm:make-time tt ns sec) ) ) )
    199199
    200200(define (milliseconds->seconds ms)
    201   (check-raw-milliseconds 'milliseconds->seconds ms)
    202   (tm:milliseconds->seconds ms) )
     201  (tm:milliseconds->seconds
     202    (check-raw-milliseconds 'milliseconds->seconds ms)) )
    203203
    204204;; Converts a seconds value, may be fractional, into a time type.
  • release/5/srfi-19/trunk/srfi-19-timezone.scm

    r38125 r38126  
    8282
    8383(define (timezone-locale-name . tzc)
    84   (let (
     84  (let* (
    8585    (tzc
    8686      (check-timezone-components 'timezone-locale-name
    8787        (optional tzc (local-timezone-locale*))))
    88     (tzn (timezone-components-ref/dst? tzc 'dst-name 'std-name)) )
     88    (tzn
     89      (timezone-components-ref/dst? tzc 'dst-name 'std-name)) )
    8990    ;TZ may not be set
    9091    (and
     
    105106(define (timezone-locale-dst? . tzc)
    106107  (timezone-component-ref
    107     (check-timezone-components 'timezone-locale-offset
     108    (check-timezone-components 'timezone-locale-dst?
    108109      (optional tzc (local-timezone-locale*)))
    109110    'dst?) )
  • release/5/srfi-19/trunk/srfi-19.egg

    r38121 r38126  
    22
    33((synopsis "Time Data Types and Procedures")
    4  (version "4.1.1")
     4 (version "4.1.2")
    55 (category data)
    66 (author "Will Fitzgerald (for Chicken by [[/users/kon-lovett]])")
  • release/5/srfi-19/trunk/tests/srfi-19-test.scm

    r38121 r38126  
    458458    (seconds->date 250.0) ))
    459459
     460(define-s19-test! "(seconds->date 250) failed"
     461  (lambda ()
     462    (seconds->date 250) ))
     463
     464(define-s19-test! "(current-date) failed"
     465  (lambda ()
     466    (current-date) ))
     467
    460468; Duration
    461469; Time Aritmetic (+ - * /)
Note: See TracChangeset for help on using the changeset viewer.