Changeset 38275 in project


Ignore:
Timestamp:
03/16/20 04:03:21 (3 weeks ago)
Author:
Kon Lovett
Message:

remove redundant let(s), some syntax back to procedure (smaller binary)

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

Legend:

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

    r38270 r38275  
    359359    (ndat (tm:copy-date dat)) )
    360360    (tm:date-year-set! ndat yr)
    361     (when (and
    362             (tm:leap-day? (tm:date-day dat) (tm:date-month dat))
    363             (not (tm:leap-year? yr)))
     361    (when (and (not (tm:leap-year? yr))
     362               (tm:leap-day? (tm:date-day dat) (tm:date-month dat)))
    364363      (tm:date-day-set! ndat (tm:days-in-month (tm:date-month dat) yr)))
    365364    ndat ) )
  • release/5/srfi-19/trunk/srfi-19-tm.scm

    r38270 r38275  
    148148  tm:time-monotonic->time-utc
    149149  tm:leap-year?
    150   (tm:leap-day? +leap-year-dys/mn+)
    151   (tm:days-in-month +leap-year-dys/mn+ +year-dys/mn+)
     150  tm:leap-day?
     151  tm:days-in-month
    152152  (tm:date-nanosecond %date-nanosecond)
    153153  (tm:date-second %date-second)
     
    457457          (?tst (cadddr form)) )
    458458          `(,_let loop ((lsvar ,?ls))
    459               (,_if (,_null? lsvar) 0
     459              (,_if (,_null? lsvar)
     460                0
    460461                (,_let ((leap-second-item (,_car lsvar)))
    461                     (,_if ,?tst (,_cdr leap-second-item)
     462                    (,_if ,?tst
     463                      (,_cdr leap-second-item)
    462464                      (loop (,_cdr lsvar)) ) ) ) ) ) ) ) ) )
    463465
     
    475477          (?secs (cadr form))
    476478          (?tst (caddr form)) )
    477           `(,_if (,_< ,?secs ,_LEAP-START) 0
     479          `(,_if (,_< ,?secs ,_LEAP-START)
     480            0
    478481            (,_find-leap-second-delta* ,?secs ,_tm:leap-second-table ,?tst) ) ) ) ) ) )
    479482
     
    555558        (syntax-rules ()
    556559                ((tm:some-time ?tt)
    557                   (let ((tt ?tt))
    558         (%make-time tt #f #f) ) ) ) )
     560                  (%make-time ?tt #f #f) ) ) )
    559561
    560562;Used to create a time record where ns & sec fields will be set later
     
    563565        (syntax-rules ()
    564566                ((tm:as-some-time ?tim)
    565                   (let ((tim ?tim))
    566         (%make-time (%time-type tim) #f #f) ) ) ) )
     567                  (%make-time (%time-type ?tim) #f #f) ) ) )
    567568
    568569;;
     
    571572        (syntax-rules ()
    572573                ((tm:time-type ?tim)
    573                   (let ((tim ?tim))
    574         (%time-type tim) ) ) ) )
     574                  (%time-type ?tim) ) ) )
    575575
    576576(define-syntax tm:time-second
    577577        (syntax-rules ()
    578578                ((tm:time-second ?tim)
    579                   (let ((tim ?tim))
    580         (%time-second tim) ) ) ) )
     579                  (%time-second ?tim) ) ) )
    581580
    582581(define-syntax tm:time-nanosecond
    583582        (syntax-rules ()
    584583                ((tm:time-nanosecond ?tim)
    585                   (let ((tim ?tim))
    586         (%time-nanosecond tim) ) ) ) )
     584                  (%time-nanosecond ?tim) ) ) )
    587585
    588586(define-syntax tm:time-type-set!
    589587        (syntax-rules ()
    590588                ((tm:time-type-set! ?tim ?typ)
    591                   (let ((tim ?tim) (typ ?typ))
    592         (%time-type-set! tim typ) ) ) ) )
     589                  (%time-type-set! ?tim ?typ) ) ) )
    593590
    594591(define-syntax tm:time-nanosecond-set!
    595592        (syntax-rules ()
    596593                ((tm:time-nanosecond-set! ?tim ?ns)
    597                   (let ((tim ?tim) (ns ?ns))
    598         (%time-nanosecond-set! tim (number->genint ns)) ) ) ) )
     594                  (%time-nanosecond-set! ?tim (number->genint ?ns)) ) ) )
    599595
    600596(define-syntax tm:time-second-set!
    601597        (syntax-rules ()
    602598                ((tm:time-second-set! ?tim ?sec)
    603                   (let ((tim ?tim) (sec ?sec))
    604         (%time-second-set! tim (number->integer sec)) ) ) ) )
     599                  (%time-second-set! ?tim (number->integer ?sec)) ) ) )
    605600
    606601(define (tm:make-time tt ns sec)
     
    618613        (syntax-rules ()
    619614                ((tm:time-has-type? ?tim ?tt)
    620                   (let ((tim ?tim) (tt ?tt))
    621         (eq? tt (%time-type tim)) ) ) ) )
     615                  (eq? ?tt (%time-type ?tim)) ) ) )
    622616
    623617;; Rem & Quo of nanoseconds per second
     
    645639        (syntax-rules ()
    646640                ((tm:time->seconds ?tim)
    647                   (let ((tim ?tim))
    648                     (tm:nanoseconds->seconds (tm:time->nanoseconds tim)) ) ) ) )
     641                  (tm:nanoseconds->seconds (tm:time->nanoseconds ?tim)) ) ) )
    649642
    650643(define (tm:duration-elements->time-values
     
    675668        (syntax-rules ()
    676669                ((tm:milliseconds->time ?ms ?tt)
    677                   (let ((ms ?ms) (tt ?tt))
    678         (let-values (
    679           ((ns sec) (tm:milliseconds->time-values ms)) )
    680           (tm:make-time tt ns sec) ) ) ) ) )
     670                  (let-values (((ns sec) (tm:milliseconds->time-values ?ms)))
     671        (tm:make-time ?tt ns sec) ) ) ) )
    681672
    682673(define-syntax tm:seconds->time
    683674        (syntax-rules ()
    684675                ((tm:seconds->time ?sec ?tt)
    685                   (let ((sec ?sec) (tt ?tt))
    686         (let-values (((ns sec) (tm:seconds->time-values sec)))
    687           (tm:make-time tt ns sec) ) ) ) ) )
     676                  (let-values (((ns sec) (tm:seconds->time-values ?sec)))
     677        (tm:make-time ?tt ns sec) ) ) ) )
    688678
    689679;; Current time routines
     
    750740(define (tm:time-compare tim1 tim2)
    751741  (let ((dif (- (%time-second tim1) (%time-second tim2))))
    752     (if (not (zero? dif)) dif
     742    (if (not (zero? dif))
     743      dif
    753744      (- (%time-nanosecond tim1) (%time-nanosecond tim2)) ) ) )
    754745
     
    884875  timout )
    885876
    886 (define-syntax tm:time-tai->time-monotonic
    887         (syntax-rules ()
    888                 ((tm:time-tai->time-monotonic ?timin ?timout)
    889                   (let ((timin ?timin) (timout ?timout))
    890         (%time-type-set! timout 'monotonic)
    891         (unless (eq? timin timout)
    892           (tm:time-nanosecond-set! timout (%time-nanosecond timin))
    893           (tm:time-second-set! timout (%time-second timin)))
    894         timout ) ) ) )
     877(define (tm:time-tai->time-monotonic timin timout)
     878  (%time-type-set! timout 'monotonic)
     879  (unless (eq? timin timout)
     880    (tm:time-nanosecond-set! timout (%time-nanosecond timin))
     881    (tm:time-second-set! timout (%time-second timin)))
     882  timout )
    895883
    896884(define (tm:time-utc->time-tai timin timout)
     
    901889  timout )
    902890
    903 (define-syntax tm:time-utc->time-monotonic
    904         (syntax-rules ()
    905                 ((tm:time-utc->time-monotonic ?timin ?timout)
    906                   (let ((timin ?timin) (timout ?timout))
    907         (let ((ntim (tm:time-utc->time-tai timin timout)))
    908           (%time-type-set! ntim 'monotonic)
    909           ntim ) ) ) ) )
    910 
    911 (define-syntax tm:time-monotonic->time-tai
    912         (syntax-rules ()
    913                 ((tm:time-monotonic->time-tai ?timin ?timout)
    914                   (let ((timin ?timin) (timout ?timout))
    915         (%time-type-set! timout 'tai)
    916         (unless (eq? timin timout)
    917           (tm:time-nanosecond-set! timout (%time-nanosecond timin))
    918           (tm:time-second-set! timout (%time-second timin)))
    919         timout ) ) ) )
    920 
    921 (define-syntax tm:time-monotonic->time-utc
    922         (syntax-rules ()
    923                 ((tm:time-monotonic->time-utc ?timin ?timout)
    924                   (let ((timin ?timin) (timout ?timout))
    925         #;(%time-type-set! timin 'tai) ;fool converter (unnecessary)
    926         (tm:time-tai->time-utc timin timout) ) ) ) )
     891(define (tm:time-utc->time-monotonic timin timout)
     892  (let ((ntim (tm:time-utc->time-tai timin timout)))
     893    (%time-type-set! ntim 'monotonic)
     894    ntim ) )
     895
     896(define (tm:time-monotonic->time-tai timin timout)
     897  (%time-type-set! timout 'tai)
     898  (unless (eq? timin timout)
     899    (tm:time-nanosecond-set! timout (%time-nanosecond timin))
     900    (tm:time-second-set! timout (%time-second timin)))
     901  timout )
     902
     903(define (tm:time-monotonic->time-utc timin timout)
     904  #;(%time-type-set! timin 'tai) ;fool converter (unnecessary)
     905  (tm:time-tai->time-utc timin timout) )
    927906
    928907;;; Date Object (Public Immutable)
     
    935914;; Part II, volume 58, number 2, pages 79-87 (April 1964).
    936915
    937 (define-syntax tm:leap-year?
    938         (syntax-rules ()
    939                 ((tm:leap-year? ?yr)
    940                   (let ((yr ?yr))
    941         (and
    942           #; ;!NOT Officially Adopted!
    943           (not (zero? (modulo yr 4000)))
    944           (or
    945             (zero? (modulo yr 400))
    946             (and
    947               (zero? (modulo yr 4))
    948               (not (zero? (modulo yr 100)))))) ) ) ) )
     916(define (tm:leap-year? yr)
     917  (and
     918    #; ;!NOT Officially Adopted!
     919    (not (zero? (modulo yr 4000)))
     920    (or
     921      (zero? (modulo yr 400))
     922      (and
     923        (zero? (modulo yr 4))
     924        (not (zero? (modulo yr 100)))))) )
    949925
    950926;; Days per Month
     
    954930(define +leap-year-dys/mn+ #(0 31 29 31 30 31 30 31 31 30 31 30 31))
    955931
    956 (define-syntax tm:leap-day?
    957         (syntax-rules ()
    958                 ((tm:leap-day? ?dy ?mn)
    959                   (let ((dy ?dy) (mn ?mn))
    960         (= dy (vector-ref +leap-year-dys/mn+ mn)) ) ) ) )
    961 
    962 (define-syntax tm:days-in-month
    963         (syntax-rules ()
    964                 ((tm:days-in-month ?yr ?mn)
    965                   (let ((yr ?yr) (mn ?mn))
    966         (vector-ref
    967           (if (tm:leap-year? yr) +leap-year-dys/mn+ +year-dys/mn+)
    968           mn) ) ) ) )
     932(define-inline (days/month yr)
     933  (if (tm:leap-year? yr) +leap-year-dys/mn+ +year-dys/mn+) )
     934
     935(define (tm:leap-day? dy mn)
     936  (= dy (vector-ref +leap-year-dys/mn+ mn)) )
     937
     938(define (tm:days-in-month yr mn)
     939  (vector-ref (days/month yr) mn) )
    969940
    970941;;; Date Object (Public Mutable)
     
    1016987        (syntax-rules ()
    1017988                ((tm:date-nanosecond ?dat)
    1018                   (let ((dat ?dat))
    1019         (%date-nanosecond dat) ) ) ) )
     989                  (%date-nanosecond ?dat) ) ) )
    1020990
    1021991(define-syntax tm:date-second
    1022992        (syntax-rules ()
    1023993                ((tm:date-second ?dat)
    1024                   (let ((dat ?dat))
    1025         (%date-second dat) ) ) ) )
     994                  (%date-second ?dat) ) ) )
    1026995
    1027996(define-syntax tm:date-minute
    1028997        (syntax-rules ()
    1029998                ((tm:date-minute ?dat)
    1030                   (let ((dat ?dat))
    1031         (%date-minute dat) ) ) ) )
     999                  (%date-minute ?dat) ) ) )
    10321000
    10331001(define-syntax tm:date-hour
    10341002        (syntax-rules ()
    10351003                ((tm:date-hour ?dat)
    1036                   (let ((dat ?dat))
    1037         (%date-hour dat) ) ) ) )
     1004                  (%date-hour ?dat) ) ) )
    10381005
    10391006(define-syntax tm:date-day
    10401007        (syntax-rules ()
    10411008                ((tm:date-day ?dat)
    1042                   (let ((dat ?dat))
    1043         (%date-day dat) ) ) ) )
     1009                  (%date-day ?dat) ) ) )
    10441010
    10451011(define-syntax tm:date-month
    10461012        (syntax-rules ()
    10471013                ((tm:date-month ?dat)
    1048                   (let ((dat ?dat))
    1049         (%date-month dat) ) ) ) )
     1014                  (%date-month ?dat) ) ) )
    10501015
    10511016(define-syntax tm:date-year
    10521017        (syntax-rules ()
    10531018                ((tm:date-year ?dat)
    1054                   (let ((dat ?dat))
    1055         (%date-year dat) ) ) ) )
     1019                  (%date-year ?dat) ) ) )
    10561020
    10571021(define-syntax tm:date-zone-offset
    10581022        (syntax-rules ()
    10591023                ((tm:date-zone-offset ?dat)
    1060                   (let ((dat ?dat))
    1061         (%date-zone-offset dat) ) ) ) )
     1024                  (%date-zone-offset ?dat) ) ) )
    10621025
    10631026(define-syntax tm:date-zone-name
    10641027        (syntax-rules ()
    10651028                ((tm:date-zone-name ?dat)
    1066                   (let ((dat ?dat))
    1067         (%date-zone-name dat) ) ) ) )
     1029                  (%date-zone-name ?dat) ) ) )
    10681030
    10691031(define-syntax tm:date-dst?
    10701032        (syntax-rules ()
    10711033                ((tm:date-dst? ?dat)
    1072                   (let ((dat ?dat))
    1073         (%date-dst? dat) ) ) ) )
     1034                  (%date-dst? ?dat) ) ) )
    10741035
    10751036(define-syntax tm:date-wday
    10761037        (syntax-rules ()
    10771038                ((tm:date-wday ?dat)
    1078                   (let ((dat ?dat))
    1079         (%date-wday dat) ) ) ) )
     1039                  (%date-wday ?dat) ) ) )
    10801040
    10811041(define-syntax tm:date-yday
    10821042        (syntax-rules ()
    10831043                ((tm:date-yday ?dat)
    1084                   (let ((dat ?dat))
    1085         (%date-yday dat) ) ) ) )
     1044                  (%date-yday ?dat) ) ) )
    10861045
    10871046(define-syntax tm:date-jday
    10881047        (syntax-rules ()
    10891048                ((tm:date-jday ?dat)
    1090                   (let ((dat ?dat))
    1091         (%date-jday dat) ) ) ) )
     1049                  (%date-jday ?dat) ) ) )
    10921050
    10931051;;; Setters
     
    10961054        (syntax-rules ()
    10971055                ((tm:date-nanosecond-set! ?dat ?x)
    1098                   (let ((dat ?dat) (x ?x))
    1099         (%date-nanosecond-set! dat (number->genint x)) ) ) ) )
     1056                  (%date-nanosecond-set! ?dat (number->genint ?x)) ) ) )
    11001057
    11011058(define-syntax tm:date-second-set!
    11021059        (syntax-rules ()
    11031060                ((tm:date-second-set! ?dat ?x)
    1104                   (let ((dat ?dat) (x ?x))
    1105         (%date-second-set! dat (number->genint x)) ) ) ) )
     1061                  (%date-second-set! ?dat (number->genint ?x)) ) ) )
    11061062
    11071063(define-syntax tm:date-minute-set!
    11081064        (syntax-rules ()
    11091065                ((tm:date-minute-set! ?dat ?x)
    1110                   (let ((dat ?dat) (x ?x))
    1111         (%date-minute-set! dat (number->genint x)) ) ) ) )
     1066                  (%date-minute-set! ?dat (number->genint ?x)) ) ) )
    11121067
    11131068(define-syntax tm:date-hour-set!
    11141069        (syntax-rules ()
    11151070                ((tm:date-hour-set! ?dat ?x)
    1116                   (let ((dat ?dat) (x ?x))
    1117         (%date-hour-set! dat (number->genint x)) ) ) ) )
     1071                  (%date-hour-set! ?dat (number->genint ?x)) ) ) )
    11181072
    11191073(define-syntax tm:date-day-set!
    11201074        (syntax-rules ()
    11211075                ((tm:date-day-set! ?dat ?x)
    1122                   (let ((dat ?dat) (x ?x))
    1123         (%date-day-set! dat (number->genint x)) ) ) ) )
     1076                  (%date-day-set! ?dat (number->genint ?x)) ) ) )
    11241077
    11251078(define-syntax tm:date-month-set!
    11261079        (syntax-rules ()
    11271080                ((tm:date-month-set! ?dat ?x)
    1128                   (let ((dat ?dat) (x ?x))
    1129         (%date-month-set! dat (number->genint x)) ) ) ) )
     1081                  (%date-month-set! ?dat (number->genint ?x)) ) ) )
    11301082
    11311083(define-syntax tm:date-year-set!
    11321084        (syntax-rules ()
    11331085                ((tm:date-year-set! ?dat ?x)
    1134                   (let ((dat ?dat) (x ?x))
    1135         (%date-year-set! dat (number->genint x)) ) ) ) )
     1086                  (%date-year-set! ?dat (number->genint ?x)) ) ) )
    11361087
    11371088(define-syntax tm:date-zone-offset-set!
    11381089        (syntax-rules ()
    11391090                ((tm:date-zone-offset-set! ?dat ?x)
    1140                   (let ((dat ?dat) (x ?x))
    1141         (%date-zone-offset-set! dat (number->genint x)) ) ) ) )
     1091                  (%date-zone-offset-set! ?dat (number->genint ?x)) ) ) )
    11421092
    11431093;; Date TZ information extract
     
    11671117        (syntax-rules ()
    11681118                ((tm:make-date ?ns ?sec ?min ?hr ?dy ?mn ?yr ?tzo ?tzn ?dstf ?wdy ?ydy ?jdy)
    1169                   (let ((ns ?ns) (sec ?sec) (min ?min) (hr ?hr) (dy ?dy) (mn ?mn) (yr ?yr) (tzo ?tzo) (tzn ?tzn) (dstf ?dstf) (wdy ?wdy) (ydy ?ydy) (jdy ?jdy))
    1170         (%make-date
    1171           (number->genint ns)
    1172           (number->genint sec) (number->genint min) (number->genint hr)
    1173           (number->genint dy) (number->genint mn) (number->genint yr)
    1174           (number->genint tzo) tzn dstf
    1175           wdy ydy jdy) ) ) ) )
     1119                  (%make-date
     1120        (number->genint ?ns)
     1121        (number->genint ?sec) (number->genint ?min) (number->genint ?hr)
     1122        (number->genint ?dy) (number->genint ?mn) (number->genint ?yr)
     1123        (number->genint ?tzo) ?tzn ?dstf
     1124        ?wdy ?ydy ?jdy) ) ) )
    11761125
    11771126(define-syntax tm:copy-date
     
    11991148      (vector-ref tv 6) (+ 1 (vector-ref tv 7)) #f) ) )
    12001149
    1201 (define-syntax tm:current-date
    1202         (syntax-rules ()
    1203                 ((tm:current-date ?tzi)
    1204                   (let ((tzi ?tzi))
    1205                     (tm:time-utc->date (tm:current-time-utc) tzi)) ) ) )
     1150(define (tm:current-date tzi)
     1151  (tm:time-utc->date (tm:current-time-utc) tzi) )
    12061152
    12071153;; Date Comparison
     
    14951441      (tm:jd-time->seconds ns sec min hr tzo)) )
    14961442    (+ (- jdn ONE-HALF) (/ timsecs SEC/DY)) ) )
     1443
    14971444#; ;inexact version
    14981445(define (tm:julian-day ns sec min hr dy mn yr tzo)
     
    15801527  (+ mjdn TAI-EPOCH-IN-MODIFIED-JD) )
    15811528
    1582 (define-syntax tm:julian-day->time-utc
    1583         (syntax-rules ()
    1584                 ((tm:julian-day->time-utc ?jdn)
    1585                   (let ((jdn ?jdn))
    1586         (let-values (((ns sec) (tm:julian-day->time-values jdn)))
    1587           (tm:make-time 'time-utc ns sec) ) ) ) ) )
     1529(define (tm:julian-day->time-utc jdn)
     1530  (let-values (((ns sec) (tm:julian-day->time-values jdn)))
     1531    (tm:make-time 'time-utc ns sec) ) )
    15881532
    15891533(define (tm:modified-julian-day->time-utc mjdn)
Note: See TracChangeset for help on using the changeset viewer.