mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-04-30 03:40:34 +02:00
Fix typos, indentation and error reporting in SRFI-19.
* module/srfi/srfi-19.scm: Fix typos in comments, indentation, and pass the correct 'caller' name to 'time-error' in several places.
This commit is contained in:
Mark H Weaver
Andy Wingo
parent
d61da427e1
commit
a47a5e6828
1 changed files with 99 additions and 91 deletions
|
|
@ -311,7 +311,7 @@
|
|||
;; (* (remainder current-ms 1000) 10000))))
|
||||
|
||||
;; -- we define it to be the same as TAI.
|
||||
;; A different implemation of current-time-montonic
|
||||
;; A different implemention of current-time-monotonic
|
||||
;; will require rewriting all of the time-monotonic converters,
|
||||
;; of course.
|
||||
|
||||
|
|
@ -323,7 +323,7 @@
|
|||
(time-second tai))))
|
||||
|
||||
(define (current-time-thread)
|
||||
(time-error 'current-time 'unsupported-clock-type 'time-thread))
|
||||
(time-error 'current-time-thread 'unsupported-clock-type 'time-thread))
|
||||
|
||||
(define ns-per-guile-tick (/ 1000000000 internal-time-units-per-second))
|
||||
|
||||
|
|
@ -371,8 +371,13 @@
|
|||
;; also presume it will be rare to check two times of different types.
|
||||
(and (= (time-second t1) (time-second t2))
|
||||
(= (time-nanosecond t1) (time-nanosecond t2))
|
||||
;; XXX The SRFI-19 reference implementation raises an error in
|
||||
;; case of unequal time types. Here we return #false.
|
||||
(eq? (time-type t1) (time-type t2))))
|
||||
|
||||
;; XXX In the following comparison procedures, the SRFI-19 reference
|
||||
;; implementation raises an error in case of unequal time types.
|
||||
|
||||
(define (time>? t1 t2)
|
||||
(or (> (time-second t1) (time-second t2))
|
||||
(and (= (time-second t1) (time-second t2))
|
||||
|
|
@ -395,6 +400,9 @@
|
|||
|
||||
;; -- Time arithmetic
|
||||
|
||||
;; XXX In the following comparison procedures, the SRFI-19 reference
|
||||
;; implementation raises an error in case of unequal time types.
|
||||
|
||||
(define (time-difference! time1 time2)
|
||||
(let ((sec-diff (- (time-second time1) (time-second time2)))
|
||||
(nsec-diff (- (time-nanosecond time1) (time-nanosecond time2))))
|
||||
|
|
@ -409,7 +417,7 @@
|
|||
|
||||
(define (add-duration! t duration)
|
||||
(if (not (eq? (time-type duration) time-duration))
|
||||
(time-error 'add-duration 'not-duration duration)
|
||||
(time-error 'add-duration! 'not-duration duration)
|
||||
(let ((sec-plus (+ (time-second t) (time-second duration)))
|
||||
(nsec-plus (+ (time-nanosecond t) (time-nanosecond duration))))
|
||||
(set-time-second! t sec-plus)
|
||||
|
|
@ -422,7 +430,7 @@
|
|||
|
||||
(define (subtract-duration! t duration)
|
||||
(if (not (eq? (time-type duration) time-duration))
|
||||
(time-error 'add-duration 'not-duration duration)
|
||||
(time-error 'subtract-duration! 'not-duration duration)
|
||||
(let ((sec-minus (- (time-second t) (time-second duration)))
|
||||
(nsec-minus (- (time-nanosecond t) (time-nanosecond duration))))
|
||||
(set-time-second! t sec-minus)
|
||||
|
|
@ -472,7 +480,7 @@
|
|||
(define (time-monotonic->time-utc time-in)
|
||||
(if (not (eq? (time-type time-in) time-monotonic))
|
||||
(time-error 'time-monotonic->time-utc
|
||||
'incompatible-time-types time-in))
|
||||
'incompatible-time-types time-in))
|
||||
(let ((ntime (copy-time time-in)))
|
||||
(set-time-type! ntime time-tai)
|
||||
(priv:time-tai->time-utc! ntime ntime 'time-monotonic->time-utc)))
|
||||
|
|
@ -480,14 +488,14 @@
|
|||
(define (time-monotonic->time-utc! time-in)
|
||||
(if (not (eq? (time-type time-in) time-monotonic))
|
||||
(time-error 'time-monotonic->time-utc!
|
||||
'incompatible-time-types time-in))
|
||||
'incompatible-time-types time-in))
|
||||
(set-time-type! time-in time-tai)
|
||||
(priv:time-tai->time-utc! time-in time-in 'time-monotonic->time-utc))
|
||||
|
||||
(define (time-monotonic->time-tai time-in)
|
||||
(if (not (eq? (time-type time-in) time-monotonic))
|
||||
(time-error 'time-monotonic->time-tai
|
||||
'incompatible-time-types time-in))
|
||||
'incompatible-time-types time-in))
|
||||
(let ((ntime (copy-time time-in)))
|
||||
(set-time-type! ntime time-tai)
|
||||
ntime))
|
||||
|
|
@ -495,14 +503,14 @@
|
|||
(define (time-monotonic->time-tai! time-in)
|
||||
(if (not (eq? (time-type time-in) time-monotonic))
|
||||
(time-error 'time-monotonic->time-tai!
|
||||
'incompatible-time-types time-in))
|
||||
'incompatible-time-types time-in))
|
||||
(set-time-type! time-in time-tai)
|
||||
time-in)
|
||||
|
||||
(define (time-utc->time-monotonic time-in)
|
||||
(if (not (eq? (time-type time-in) time-utc))
|
||||
(time-error 'time-utc->time-monotonic
|
||||
'incompatible-time-types time-in))
|
||||
'incompatible-time-types time-in))
|
||||
(let ((ntime (priv:time-utc->time-tai! time-in (make-time-unnormalized #f #f #f)
|
||||
'time-utc->time-monotonic)))
|
||||
(set-time-type! ntime time-monotonic)
|
||||
|
|
@ -511,7 +519,7 @@
|
|||
(define (time-utc->time-monotonic! time-in)
|
||||
(if (not (eq? (time-type time-in) time-utc))
|
||||
(time-error 'time-utc->time-monotonic!
|
||||
'incompatible-time-types time-in))
|
||||
'incompatible-time-types time-in))
|
||||
(let ((ntime (priv:time-utc->time-tai! time-in time-in
|
||||
'time-utc->time-monotonic!)))
|
||||
(set-time-type! ntime time-monotonic)
|
||||
|
|
@ -520,7 +528,7 @@
|
|||
(define (time-tai->time-monotonic time-in)
|
||||
(if (not (eq? (time-type time-in) time-tai))
|
||||
(time-error 'time-tai->time-monotonic
|
||||
'incompatible-time-types time-in))
|
||||
'incompatible-time-types time-in))
|
||||
(let ((ntime (copy-time time-in)))
|
||||
(set-time-type! ntime time-monotonic)
|
||||
ntime))
|
||||
|
|
@ -528,7 +536,7 @@
|
|||
(define (time-tai->time-monotonic! time-in)
|
||||
(if (not (eq? (time-type time-in) time-tai))
|
||||
(time-error 'time-tai->time-monotonic!
|
||||
'incompatible-time-types time-in))
|
||||
'incompatible-time-types time-in))
|
||||
(set-time-type! time-in time-monotonic)
|
||||
time-in)
|
||||
|
||||
|
|
@ -600,15 +608,15 @@
|
|||
|
||||
(define (time-utc->date time . tz-offset)
|
||||
(if (not (eq? (time-type time) time-utc))
|
||||
(time-error 'time->date 'incompatible-time-types time))
|
||||
(time-error 'time-utc->date 'incompatible-time-types time))
|
||||
(let* ((offset (if (null? tz-offset)
|
||||
(local-tz-offset time)
|
||||
(car tz-offset)))
|
||||
(leap-second? (leap-second? (+ offset (time-second time))))
|
||||
(jdn (time->julian-day-number (if leap-second?
|
||||
(- (time-second time) 1)
|
||||
(time-second time))
|
||||
offset)))
|
||||
(- (time-second time) 1)
|
||||
(time-second time))
|
||||
offset)))
|
||||
|
||||
(call-with-values (lambda () (decode-julian-day-number jdn))
|
||||
(lambda (secs date month year)
|
||||
|
|
@ -630,7 +638,7 @@
|
|||
|
||||
(define (time-tai->date time . tz-offset)
|
||||
(if (not (eq? (time-type time) time-tai))
|
||||
(time-error 'time->date 'incompatible-time-types time))
|
||||
(time-error 'time-tai->date 'incompatible-time-types time))
|
||||
(let* ((offset (if (null? tz-offset)
|
||||
(local-tz-offset (time-tai->time-utc time))
|
||||
(car tz-offset)))
|
||||
|
|
@ -638,9 +646,9 @@
|
|||
(leap-second-delta (time-second time))))
|
||||
(leap-second? (leap-second? (+ offset seconds)))
|
||||
(jdn (time->julian-day-number (if leap-second?
|
||||
(- seconds 1)
|
||||
seconds)
|
||||
offset)))
|
||||
(- seconds 1)
|
||||
seconds)
|
||||
offset)))
|
||||
(call-with-values (lambda () (decode-julian-day-number jdn))
|
||||
(lambda (secs date month year)
|
||||
;; secs is a real because jdn is a real in Guile;
|
||||
|
|
@ -663,7 +671,7 @@
|
|||
;; this is the same as time-tai->date.
|
||||
(define (time-monotonic->date time . tz-offset)
|
||||
(if (not (eq? (time-type time) time-monotonic))
|
||||
(time-error 'time->date 'incompatible-time-types time))
|
||||
(time-error 'time-monotonic->date 'incompatible-time-types time))
|
||||
(let* ((offset (if (null? tz-offset)
|
||||
(local-tz-offset (time-monotonic->time-utc time))
|
||||
(car tz-offset)))
|
||||
|
|
@ -671,9 +679,9 @@
|
|||
(leap-second-delta (time-second time))))
|
||||
(leap-second? (leap-second? (+ offset seconds)))
|
||||
(jdn (time->julian-day-number (if leap-second?
|
||||
(- seconds 1)
|
||||
seconds)
|
||||
offset)))
|
||||
(- seconds 1)
|
||||
seconds)
|
||||
offset)))
|
||||
(call-with-values (lambda () (decode-julian-day-number jdn))
|
||||
(lambda (secs date month year)
|
||||
;; secs is a real because jdn is a real in Guile;
|
||||
|
|
@ -722,8 +730,8 @@
|
|||
;; Map 1-based month number M to number of days in the year before the
|
||||
;; start of month M (in a non-leap year).
|
||||
(define month-assoc '((1 . 0) (2 . 31) (3 . 59) (4 . 90)
|
||||
(5 . 120) (6 . 151) (7 . 181) (8 . 212)
|
||||
(9 . 243) (10 . 273) (11 . 304) (12 . 334)))
|
||||
(5 . 120) (6 . 151) (7 . 181) (8 . 212)
|
||||
(9 . 243) (10 . 273) (11 . 304) (12 . 334)))
|
||||
|
||||
(define (year-day day month year)
|
||||
(let ((days-pr (assoc month month-assoc)))
|
||||
|
|
@ -814,7 +822,7 @@
|
|||
|
||||
(define (time-utc->julian-day time)
|
||||
(if (not (eq? (time-type time) time-utc))
|
||||
(time-error 'time->date 'incompatible-time-types time))
|
||||
(time-error 'time-utc->julian-day 'incompatible-time-types time))
|
||||
(+ (/ (+ (time-second time) (/ (time-nanosecond time) nano))
|
||||
sid)
|
||||
tai-epoch-in-jd))
|
||||
|
|
@ -825,7 +833,7 @@
|
|||
|
||||
(define (time-tai->julian-day time)
|
||||
(if (not (eq? (time-type time) time-tai))
|
||||
(time-error 'time->date 'incompatible-time-types time))
|
||||
(time-error 'time-tai->julian-day 'incompatible-time-types time))
|
||||
(+ (/ (+ (- (time-second time)
|
||||
(leap-second-delta (time-second time)))
|
||||
(/ (time-nanosecond time) nano))
|
||||
|
|
@ -839,7 +847,7 @@
|
|||
;; this is the same as time-tai->julian-day
|
||||
(define (time-monotonic->julian-day time)
|
||||
(if (not (eq? (time-type time) time-monotonic))
|
||||
(time-error 'time->date 'incompatible-time-types time))
|
||||
(time-error 'time-monotonic->julian-day 'incompatible-time-types time))
|
||||
(+ (/ (+ (- (time-second time)
|
||||
(leap-second-delta (time-second time)))
|
||||
(/ (time-nanosecond time) nano))
|
||||
|
|
@ -979,13 +987,13 @@
|
|||
(display (date->string date locale-date-time-format) port)))
|
||||
(cons #\d (lambda (date pad-with port)
|
||||
(display (padding (date-day date)
|
||||
#\0 2)
|
||||
#\0 2)
|
||||
port)))
|
||||
(cons #\D (lambda (date pad-with port)
|
||||
(display (date->string date "~m/~d/~y") port)))
|
||||
(cons #\e (lambda (date pad-with port)
|
||||
(display (padding (date-day date)
|
||||
#\Space 2)
|
||||
#\Space 2)
|
||||
port)))
|
||||
(cons #\f (lambda (date pad-with port)
|
||||
(receive (s ns) (floor/ (+ (* (date-second date) nano)
|
||||
|
|
@ -1000,24 +1008,24 @@
|
|||
(display (date->string date "~b") port)))
|
||||
(cons #\H (lambda (date pad-with port)
|
||||
(display (padding (date-hour date)
|
||||
pad-with 2)
|
||||
pad-with 2)
|
||||
port)))
|
||||
(cons #\I (lambda (date pad-with port)
|
||||
(let ((hr (date-hour date)))
|
||||
(if (> hr 12)
|
||||
(display (padding (- hr 12)
|
||||
pad-with 2)
|
||||
pad-with 2)
|
||||
port)
|
||||
(display (padding hr
|
||||
pad-with 2)
|
||||
pad-with 2)
|
||||
port)))))
|
||||
(cons #\j (lambda (date pad-with port)
|
||||
(display (padding (date-year-day date)
|
||||
pad-with 3)
|
||||
pad-with 3)
|
||||
port)))
|
||||
(cons #\k (lambda (date pad-with port)
|
||||
(display (padding (date-hour date)
|
||||
#\Space 2)
|
||||
#\Space 2)
|
||||
port)))
|
||||
(cons #\l (lambda (date pad-with port)
|
||||
(let ((hr (if (> (date-hour date) 12)
|
||||
|
|
@ -1026,17 +1034,17 @@
|
|||
port))))
|
||||
(cons #\m (lambda (date pad-with port)
|
||||
(display (padding (date-month date)
|
||||
pad-with 2)
|
||||
pad-with 2)
|
||||
port)))
|
||||
(cons #\M (lambda (date pad-with port)
|
||||
(display (padding (date-minute date)
|
||||
pad-with 2)
|
||||
pad-with 2)
|
||||
port)))
|
||||
(cons #\n (lambda (date pad-with port)
|
||||
(newline port)))
|
||||
(cons #\N (lambda (date pad-with port)
|
||||
(display (padding (date-nanosecond date)
|
||||
pad-with 9)
|
||||
pad-with 9)
|
||||
port)))
|
||||
(cons #\p (lambda (date pad-with port)
|
||||
(display (locale-am-string/pm (date-hour date)) port)))
|
||||
|
|
@ -1048,10 +1056,10 @@
|
|||
(if (> (date-nanosecond date)
|
||||
nano)
|
||||
(display (padding (+ (date-second date) 1)
|
||||
pad-with 2)
|
||||
pad-with 2)
|
||||
port)
|
||||
(display (padding (date-second date)
|
||||
pad-with 2)
|
||||
pad-with 2)
|
||||
port))))
|
||||
(cons #\t (lambda (date pad-with port)
|
||||
(display #\Tab port)))
|
||||
|
|
@ -1060,12 +1068,12 @@
|
|||
(cons #\U (lambda (date pad-with port)
|
||||
(if (> (days-before-first-week date 0) 0)
|
||||
(display (padding (+ (date-week-number date 0) 1)
|
||||
#\0 2) port)
|
||||
#\0 2) port)
|
||||
(display (padding (date-week-number date 0)
|
||||
#\0 2) port))))
|
||||
#\0 2) port))))
|
||||
(cons #\V (lambda (date pad-with port)
|
||||
(display (padding (date-week-number date 1)
|
||||
#\0 2) port)))
|
||||
#\0 2) port)))
|
||||
(cons #\w (lambda (date pad-with port)
|
||||
(display (date-week-day date) port)))
|
||||
(cons #\x (lambda (date pad-with port)
|
||||
|
|
@ -1075,14 +1083,14 @@
|
|||
(cons #\W (lambda (date pad-with port)
|
||||
(if (> (days-before-first-week date 1) 0)
|
||||
(display (padding (+ (date-week-number date 1) 1)
|
||||
#\0 2) port)
|
||||
#\0 2) port)
|
||||
(display (padding (date-week-number date 1)
|
||||
#\0 2) port))))
|
||||
#\0 2) port))))
|
||||
(cons #\y (lambda (date pad-with port)
|
||||
(display (padding (last-n-digits
|
||||
(date-year date) 2)
|
||||
pad-with
|
||||
2)
|
||||
(date-year date) 2)
|
||||
pad-with
|
||||
2)
|
||||
port)))
|
||||
(cons #\Y (lambda (date pad-with port)
|
||||
(display (date-year date) port)))
|
||||
|
|
@ -1115,63 +1123,63 @@
|
|||
(date-printer date (+ index 1) format-string str-len port))
|
||||
(if (= (+ index 1) str-len) ; bad format string.
|
||||
(time-error 'date-printer 'bad-date-format-string
|
||||
format-string)
|
||||
format-string)
|
||||
(let ((pad-char? (string-ref format-string (+ index 1))))
|
||||
(cond
|
||||
((char=? pad-char? #\-)
|
||||
(if (= (+ index 2) str-len) ; bad format string.
|
||||
(time-error 'date-printer
|
||||
'bad-date-format-string
|
||||
format-string)
|
||||
'bad-date-format-string
|
||||
format-string)
|
||||
(let ((formatter (get-formatter
|
||||
(string-ref format-string
|
||||
(+ index 2)))))
|
||||
(if (not formatter)
|
||||
(time-error 'date-printer
|
||||
'bad-date-format-string
|
||||
format-string)
|
||||
'bad-date-format-string
|
||||
format-string)
|
||||
(begin
|
||||
(formatter date #f port)
|
||||
(date-printer date
|
||||
(+ index 3)
|
||||
format-string
|
||||
str-len
|
||||
port))))))
|
||||
(+ index 3)
|
||||
format-string
|
||||
str-len
|
||||
port))))))
|
||||
|
||||
((char=? pad-char? #\_)
|
||||
(if (= (+ index 2) str-len) ; bad format string.
|
||||
(time-error 'date-printer
|
||||
'bad-date-format-string
|
||||
format-string)
|
||||
'bad-date-format-string
|
||||
format-string)
|
||||
(let ((formatter (get-formatter
|
||||
(string-ref format-string
|
||||
(+ index 2)))))
|
||||
(if (not formatter)
|
||||
(time-error 'date-printer
|
||||
'bad-date-format-string
|
||||
format-string)
|
||||
'bad-date-format-string
|
||||
format-string)
|
||||
(begin
|
||||
(formatter date #\Space port)
|
||||
(date-printer date
|
||||
(+ index 3)
|
||||
format-string
|
||||
str-len
|
||||
port))))))
|
||||
(+ index 3)
|
||||
format-string
|
||||
str-len
|
||||
port))))))
|
||||
(else
|
||||
(let ((formatter (get-formatter
|
||||
(string-ref format-string
|
||||
(+ index 1)))))
|
||||
(if (not formatter)
|
||||
(time-error 'date-printer
|
||||
'bad-date-format-string
|
||||
format-string)
|
||||
'bad-date-format-string
|
||||
format-string)
|
||||
(begin
|
||||
(formatter date #\0 port)
|
||||
(date-printer date
|
||||
(+ index 2)
|
||||
format-string
|
||||
str-len
|
||||
port))))))))))))
|
||||
(+ index 2)
|
||||
format-string
|
||||
str-len
|
||||
port))))))))))))
|
||||
|
||||
|
||||
(define (date->string date . format-string)
|
||||
|
|
@ -1193,7 +1201,7 @@
|
|||
((#\8) 8)
|
||||
((#\9) 9)
|
||||
(else (time-error 'char->int 'bad-date-template-string
|
||||
(list "Non-integer character" ch)))))
|
||||
(list "Non-integer character" ch)))))
|
||||
|
||||
;; read an integer upto n characters long on port; upto -> #f is any length
|
||||
(define (integer-reader upto port)
|
||||
|
|
@ -1219,7 +1227,7 @@
|
|||
((>= nchars n) accum)
|
||||
((eof-object? ch)
|
||||
(time-error 'string->date 'bad-date-template-string
|
||||
"Premature ending to integer read."))
|
||||
"Premature ending to integer read."))
|
||||
((char-numeric? ch)
|
||||
(set! padding-ok #f)
|
||||
(accum-int port
|
||||
|
|
@ -1230,7 +1238,7 @@
|
|||
(accum-int port accum (+ nchars 1)))
|
||||
(else ; padding where it shouldn't be
|
||||
(time-error 'string->date 'bad-date-template-string
|
||||
"Non-numeric characters in integer read.")))))
|
||||
"Non-numeric characters in integer read.")))))
|
||||
(accum-int port 0 0)))
|
||||
|
||||
|
||||
|
|
@ -1244,7 +1252,7 @@
|
|||
(let ((ch (read-char port)))
|
||||
(if (eof-object? ch)
|
||||
(time-error 'string->date 'bad-date-template-string
|
||||
(list "Invalid time zone +/-" ch)))
|
||||
(list "Invalid time zone +/-" ch)))
|
||||
(if (or (char=? ch #\Z) (char=? ch #\z))
|
||||
0
|
||||
(begin
|
||||
|
|
@ -1253,29 +1261,29 @@
|
|||
((char=? ch #\-) (set! positive? #f))
|
||||
(else
|
||||
(time-error 'string->date 'bad-date-template-string
|
||||
(list "Invalid time zone +/-" ch))))
|
||||
(list "Invalid time zone +/-" ch))))
|
||||
(let ((ch (read-char port)))
|
||||
(if (eof-object? ch)
|
||||
(time-error 'string->date 'bad-date-template-string
|
||||
(list "Invalid time zone number" ch)))
|
||||
(list "Invalid time zone number" ch)))
|
||||
(set! offset (* (char->int ch)
|
||||
10 60 60)))
|
||||
(let ((ch (read-char port)))
|
||||
(if (eof-object? ch)
|
||||
(time-error 'string->date 'bad-date-template-string
|
||||
(list "Invalid time zone number" ch)))
|
||||
(list "Invalid time zone number" ch)))
|
||||
(set! offset (+ offset (* (char->int ch)
|
||||
60 60))))
|
||||
(let ((ch (read-char port)))
|
||||
(if (eof-object? ch)
|
||||
(time-error 'string->date 'bad-date-template-string
|
||||
(list "Invalid time zone number" ch)))
|
||||
(list "Invalid time zone number" ch)))
|
||||
(set! offset (+ offset (* (char->int ch)
|
||||
10 60))))
|
||||
(let ((ch (read-char port)))
|
||||
(if (eof-object? ch)
|
||||
(time-error 'string->date 'bad-date-template-string
|
||||
(list "Invalid time zone number" ch)))
|
||||
(list "Invalid time zone number" ch)))
|
||||
(set! offset (+ offset (* (char->int ch)
|
||||
60))))
|
||||
(if positive? offset (- offset)))))))
|
||||
|
|
@ -1292,8 +1300,8 @@
|
|||
(let* ((str (read-char-string '()))
|
||||
(index (indexer str)))
|
||||
(if index index (time-error 'string->date
|
||||
'bad-date-template-string
|
||||
(list "Invalid string for " indexer)))))
|
||||
'bad-date-template-string
|
||||
(list "Invalid string for " indexer)))))
|
||||
|
||||
(define (make-locale-reader indexer)
|
||||
(lambda (port)
|
||||
|
|
@ -1304,8 +1312,8 @@
|
|||
(if (char=? char (read-char port))
|
||||
char
|
||||
(time-error 'string->date
|
||||
'bad-date-template-string
|
||||
"Invalid character match."))))
|
||||
'bad-date-template-string
|
||||
"Invalid character match."))))
|
||||
|
||||
;; A List of formatted read directives.
|
||||
;; Each entry is a list.
|
||||
|
|
@ -1373,7 +1381,7 @@
|
|||
(char=? c #\+)
|
||||
(char=? c #\-)))
|
||||
zone-reader (lambda (val object)
|
||||
(set-date-zone-offset! object val))))))
|
||||
(set-date-zone-offset! object val))))))
|
||||
|
||||
(define (priv:string->date date index format-string str-len port template-string)
|
||||
(define (skip-until port skipper)
|
||||
|
|
@ -1389,7 +1397,7 @@
|
|||
(if (or (eof-object? port-char)
|
||||
(not (char=? current-char port-char)))
|
||||
(time-error 'string->date
|
||||
'bad-date-format-string template-string))
|
||||
'bad-date-format-string template-string))
|
||||
(priv:string->date date
|
||||
(+ index 1)
|
||||
format-string
|
||||
|
|
@ -1399,12 +1407,12 @@
|
|||
;; otherwise, it's an escape, we hope
|
||||
(if (> (+ index 1) str-len)
|
||||
(time-error 'string->date
|
||||
'bad-date-format-string template-string)
|
||||
'bad-date-format-string template-string)
|
||||
(let* ((format-char (string-ref format-string (+ index 1)))
|
||||
(format-info (assoc format-char read-directives)))
|
||||
(if (not format-info)
|
||||
(time-error 'string->date
|
||||
'bad-date-format-string template-string)
|
||||
'bad-date-format-string template-string)
|
||||
(begin
|
||||
(let ((skipper (cadr format-info))
|
||||
(reader (caddr format-info))
|
||||
|
|
@ -1413,8 +1421,8 @@
|
|||
(let ((val (reader port)))
|
||||
(if (eof-object? val)
|
||||
(time-error 'string->date
|
||||
'bad-date-format-string
|
||||
template-string)
|
||||
'bad-date-format-string
|
||||
template-string)
|
||||
(if actor (actor val date))))
|
||||
(priv:string->date date
|
||||
(+ index 2)
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue