Changeset 38295 in project


Ignore:
Timestamp:
03/17/20 08:28:02 (2 weeks ago)
Author:
Kon Lovett
Message:

Fix {{time-period}} record tag, null period

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

Legend:

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

    r38290 r38295  
    3838(define-constant *date-timezone-info-tag* 'srfi-19#date-timezone-info)
    3939
     40(define-constant *time-period-tag* 'srfi-19#time-period)
     41
    4042;; misc-utils
    4143
  • release/5/srfi-19/trunk/srfi-19-period.scm

    r38153 r38295  
    88;; - Use a half-closed interval - [begin end)? Currently [B E]!
    99
     10(declare (bound-to-procedure ##sys#register-record-printer))
     11
    1012(module srfi-19-period
    1113
     
    1416  check-time-period
    1517  error-time-period
    16   #;time-period-null?
    1718  time-period-compare
    1819  time-period=?
     
    2526  time-period-end
    2627  time-period-last
    27   time-period-length
    28   #;make-null-time-period
     28  time-period-duration
     29  make-time-period-null
     30  time-period-null?
    2931  make-time-period
    3032  copy-time-period
     
    8688;;; Time Period
    8789
    88 ;#| ;dependency
    89 (define-constant time-period 'time-period)
    90 (define-record-type-variant time-period (unchecked #;inline unsafe)
     90(define-record-type-variant *time-period-tag* (unchecked inline unsafe)
    9191  (%make-time-period beg end)
    9292  %time-period?
    9393  (beg %time-period-begin)
    9494  (end %time-period-end) )
    95 ;|#
    96 #; ;no dependency
    97 (define-record-type time-period
    98   (%make-time-period beg end)
    99   %time-period?
    100   (beg %time-period-begin)
    101   (end %time-period-end) )
    102 
    103 (define-check+error-type time-period %time-period?)
    104 
    105 (define-record-printer (time-period per out)
    106   (format out
    107     "#,(time-period ~A ~A)"
    108     (%time-period-begin per)
    109     (%time-period-end per)) )
    110 
    111 (define-reader-ctor 'time-period
    112   (lambda (beg end)
    113     (%make-time-period beg end)))
     95
     96(define-check+error-type time-period (cut %time-period? <>))
     97
     98(define (srfi-10-literal)
     99  ;
     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))))
     105  ;
     106  (define-reader-ctor 'srfi-19-time-period
     107    (lambda (beg end)
     108      (%make-time-period beg end))) )
    114109
    115110(define (check-time-period-binop loc obj1 obj2)
     
    120115  (tm:time-type (%time-period-begin per)))
    121116
    122 #; ;BAD IDEA
    123117(define (tm:time-period-null? per)
    124   (tm:time<=? (%time-period-end per) (%time-period-begin per)) )
     118  (tm:time=? (%time-period-end per) (%time-period-begin per)) )
    125119
    126120(define (tm:make-time-period-zero obj)
     
    213207;;
    214208
    215 #; ;BAD IDEA
    216 (define (make-null-time-period . args)
     209(define (make-time-period-null . args)
    217210  (let-optionals args ((tt (default-date-clock-type)))
    218211    (tm:make-time-period-zero tt) ) )
    219212
    220 #; ;BAD IDEA
    221213(define (time-period-null? per)
    222   (check-time-period 'time-period-null? per)
    223   (tm:time-period-null? per) )
     214  (tm:time-period-null? (check-time-period 'time-period-null? per)) )
    224215
    225216(define (make-time-period beg end . args)
     
    244235    (when (tm:time<? end beg)
    245236      (signal-type-error 'make-time-period "inverted time period" beg end) )
     237    #; ;not until half-closed-right
     238    (when (tm:time=? end beg)
     239      (signal-type-error 'make-time-period "null time period" beg end) )
    246240    ;
    247241    (%make-time-period beg (tm:ensure-compatible-time 'make-time-period beg end)) ) )
     
    275269  #;
    276270  (let ((diff (tm:time-period-subtract per1 per2)))
    277     (cond ((negative? diff) -1)
    278           ((zero? diff)     0)
    279           (else             1 ) ) ) )
     271    (cond
     272      ((negative? diff) -1)
     273      ((zero? diff)     0)
     274      (else             1 ) ) ) )
    280275
    281276(define (time-period=? per1 per2)
     
    311306    (make-time-period (%time-period-end per2) (%time-period-end per1)) ) )
    312307
     308;umm, this doesn't make sense, unless half-closed
    313309(define (time-period-last per)
    314310  (check-time-period 'time-period-last per)
     
    316312    (tm:subtract-duration end ONE-NANOSECOND-DURATION (tm:as-some-time end)) ) )
    317313
    318 (define (time-period-length per)
    319   (check-time-period 'time-period-length per)
     314(define (time-period-duration per)
     315  (check-time-period 'time-period-duration per)
    320316  (let ((dur (zero-time 'duration)))
    321     (tm:time-difference (%time-period-begin per) (%time-period-end per) dur)
    322     #; ;BAD IDEA
    323     (if (tm:time-period-null? per)
    324       dur
    325       (tm:time-difference (%time-period-begin per) (%time-period-end per) dur)) ) )
     317    (tm:time-difference (%time-period-begin per) (%time-period-end per) dur) ) )
    326318
    327319(define (time-period-contains/period? per1 per2)
     
    416408  (tm:time-period-shift per dur per) )
    417409
     410;;; Initialize
     411
     412(srfi-10-literal)
     413
    418414) ;srfi-19-period
  • release/5/srfi-19/trunk/srfi-19.egg

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

    r38290 r38295  
    99(test-begin "SRFI 19")
    1010
     11(import srfi-19)
     12
    1113;;;
    1214
    13 (import srfi-19)
    14 #;(import locale)    ;To force a locale
    15 (import srfi-1)    ;For current-date w/o tz-locale test
    16 (import format)    ;For conversion test
     15(import (srfi 1))   ;For current-date w/o tz-locale test
     16(import format)     ;For conversion test
    1717
    1818;;
    1919
    20 #; ;Unused
    21 (define-syntax with-locale
    22   (syntax-rules ()
    23     ((with-locale ?loc ?thunk)
    24       (let (
    25         (curloc (current-locale)) )
    26         (dynamic-wind
    27           (lambda () (current-locale ?loc))
    28           ?thunk
    29           (lambda () (current-locale curloc))) ) ) ) )
     20#| ;Unused
     21(import locale)
     22(define (with-locale lcl thunk)
     23  (let (
     24    (cur (current-locale)) )
     25    (dynamic-wind
     26      (lambda () (current-locale lcl))
     27      thunk
     28      (lambda () (current-locale cur))) ) )
     29|#
    3030
    3131;;
     
    457457    (with-input-from-string "2020-03-16T18:28:16-0700" read-date-literal)))
    458458
     459;; Time Period
     460
     461(import srfi-19-period)
     462
     463(let* (
     464  (tp (make-time-period (current-date) (current-date))) )
     465  (test-assert "Current time-period null" (time-period-null? tp)) )
     466
    459467;; TBD
    460 
    461 (import srfi-19-literals)
    462468
    463469; Duration
     
    465471; Date Comparision
    466472; Date Aritmetic
    467 ; Time Period
    468 
    469 (import srfi-19-period)
    470473
    471474;;;
Note: See TracChangeset for help on using the changeset viewer.