Changeset 40001 in project


Ignore:
Timestamp:
04/14/21 16:46:43 (4 weeks ago)
Author:
Kon Lovett
Message:

fix time-period-null test (st & ed must be same - using 2 calls may or may not work), date-adjust* WIP, add C5.3 cond-ex for time-period printer set

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

Legend:

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

    r39871 r40001  
    330330;; Date Arithmetic
    331331
     332(define (date-key-order x) (list-index (cut eq? x <>) +date-key-lexical-order+))
     333
     334(define (date-key-compare a b)
     335  (if (eq? a b) 0 (- (date-key-order a) (date-key-order b))) )
     336
     337(define (date-key=? a b) (zero? (date-key-compare a b)))
     338(define (date-key<? a b) (negative? (date-key-compare a b)))
     339
     340(define (sort-date-keys keys #!optional (lt date-key<?))
     341  (import (chicken sort))
     342  (sort keys lt) )
     343
     344;date-adjust* date key # ...
     345;key = year ... nanosecond
     346(define (date-adjust* dat . adjs)
     347  (define (adjustments->alist ls)
     348    ;map kwd amt pair;
     349    ;kwd->sym sym->key -> (key . amt) ... - resolve synonyms
     350    '() )
     351  (define (date-key-alist<? a b)
     352    (date-key<? (car a) (car b)) )
     353  (let* (
     354    (tt (default-date-clock-type))              ;don't bother w/ arg
     355    (al (adjustments->alist adjs))              ;(kwds->syms . #) ...
     356    (al (sort-date-keys al date-key-alist<?)) ) ;smallest unit to largest
     357    (foldl (lambda (d c) (date-adjust d (cdr c) (car c))) dat al) ) )
     358
    332359(define (date-adjust dat amt key . args)
    333360  (let-optionals args ((tt (default-date-clock-type)))
     
    428455(define +date-adjust-synonym-map+ (make-hash-table eq? symbol-hash))
    429456(define +date-adjuster-map+ (make-hash-table eq? symbol-hash))
     457(define +date-key-lexical-order+ '())
    430458
    431459(define (date-adjust-key? obj)
     
    440468
    441469(define (date-adjuster-set! key syns hdlr)
     470  ;-set! in ascending order
     471  (set! +date-key-lexical-order+ (cons key +date-key-lexical-order+))
    442472  ;all are key
    443473  (hash-table-set! +date-adjust-synonym-map+ key key)
     
    635665  nanoseconds     (nanosecond nanos nano ns)       date-adjuster-duration)
    636666
    637 ;UNUSED
    638 #|
    639 (define +date-key-lexical-order+ '(
    640   years
    641   quarters
    642   months
    643   weeks
    644   days
    645   hours
    646   minutes
    647   seconds
    648   milliseconds
    649   microseconds
    650   nanoseconds))
    651 
    652 (define (date-key-order x) (list-index (cut eq? x <>) +date-key-lexical-order+))
    653 
    654 (define (date-key-compare a b)
    655   (if (eq? a b) 0 (- (date-key-order a) (date-key-order b))) )
    656 
    657 (define (date-key=? a b) (zero? (date-key-compare a b)))
    658 (define (date-key<? a b) (negative? (date-key-compare a b)))
    659 |#
    660 
    661667) ;module srfi-19-date
  • release/5/srfi-19/trunk/srfi-19-period.scm

    r38295 r40001  
    9898(define (srfi-10-literal)
    9999  ;
    100   (##sys#register-record-printer *time-period-tag*
    101     (lambda (per out)
    102       (format out "#,(time-period ~A ~A)"
    103         (%time-period-begin per)
    104         (%time-period-end per))))
     100  (cond-expand
     101    (chicken-5.3
     102      (set! (record-printer *time-period-tag*)
     103        (lambda (per out)
     104          (format out "#,(time-period ~A ~A)"
     105            (%time-period-begin per)
     106            (%time-period-end per)))) )
     107    (else
     108      (##sys#register-record-printer *time-period-tag*
     109        (lambda (per out)
     110          (format out "#,(time-period ~A ~A)"
     111            (%time-period-begin per)
     112            (%time-period-end per)))) ) )
    105113  ;
    106114  (define-reader-ctor 'srfi-19-time-period
  • release/5/srfi-19/trunk/srfi-19.egg

    r39921 r40001  
    22
    33((synopsis "Time Data Types and Procedures")
    4  (version "4.4.4")
     4 (version "4.4.5")
    55 (category data)
    66 (author "Will Fitzgerald (for CHICKEN by Kon Lovett)")
  • release/5/srfi-19/trunk/tests/srfi-19-test.scm

    r38336 r40001  
    476476
    477477(let* (
    478   (tp (make-time-period (current-date) (current-date))) )
     478  (dt (current-date))
     479  (tp (make-time-period dt dt)) )
    479480  (test-assert "Current time-period null" (time-period-null? tp)) )
    480481
Note: See TracChangeset for help on using the changeset viewer.