aboutsummaryrefslogtreecommitdiff
path: root/module/datetime
diff options
context:
space:
mode:
authorHugo Hörnquist <hugo@lysator.liu.se>2022-06-12 21:09:35 +0200
committerHugo Hörnquist <hugo@lysator.liu.se>2022-06-13 04:11:35 +0200
commit73a4bfc3d8e9bb5365e33a11a6ad3b8340d5195b (patch)
treee52324edc63a240e5c0b88081c325f789168a4c5 /module/datetime
parentDocument timespec and zic. (diff)
downloadcalp-73a4bfc3d8e9bb5365e33a11a6ad3b8340d5195b.tar.gz
calp-73a4bfc3d8e9bb5365e33a11a6ad3b8340d5195b.tar.xz
Remove custom let*.
While it was nice, the most important part was the multi-valued let from srfi-71 (which is implemented in srfi-71)). The minor pattern matching structures could often be replaced with car+cdr, or a propper match.
Diffstat (limited to 'module/datetime')
-rw-r--r--module/datetime/timespec.scm5
-rw-r--r--module/datetime/zic.scm40
2 files changed, 24 insertions, 21 deletions
diff --git a/module/datetime/timespec.scm b/module/datetime/timespec.scm
index 49a2d90e..9bfcc402 100644
--- a/module/datetime/timespec.scm
+++ b/module/datetime/timespec.scm
@@ -6,10 +6,11 @@
(define-module (datetime timespec)
:export (make-timespec
timespec? timespec-time timespec-sign timespec-type)
- :use-module ((hnh util) :select (set define*-public unless let*))
+ :use-module ((hnh util) :select (set define*-public unless))
:use-module ((hnh util exceptions) :select (warning))
:use-module (datetime)
:use-module (srfi srfi-1)
+ :use-module (srfi srfi-71)
:use-module (srfi srfi-9 gnu)
:use-module (calp translation)
)
@@ -71,7 +72,7 @@
(define*-public (parse-time-spec
string optional: (suffixes '(#\s #\w #\u #\g #\z)))
- (let* ((type string
+ (let ((type string
(cond [(string-rindex string (list->char-set suffixes))
=> (lambda (idx)
(values (string-ref string idx)
diff --git a/module/datetime/zic.scm b/module/datetime/zic.scm
index e8e73977..e5a0706e 100644
--- a/module/datetime/zic.scm
+++ b/module/datetime/zic.scm
@@ -12,7 +12,7 @@
;;; Code:
(define-module (datetime zic)
:use-module ((hnh util)
- :select (awhen group set when sort* iterate group-by let*))
+ :select (awhen group set when sort* iterate group-by))
:use-module ((hnh util exceptions) :select (warning))
:use-module (datetime)
:use-module (datetime timespec)
@@ -20,6 +20,7 @@
:use-module (srfi srfi-1)
:use-module (srfi srfi-9)
:use-module (srfi srfi-9 gnu)
+ :use-module (srfi srfi-71)
:use-module ((vcomponent recurrence internal)
:select (byday make-recur-rule bymonthday))
:use-module (calp translation)
@@ -175,17 +176,16 @@
[(#\u #\g #\z) "UTC"]))))
-(define (parse-zone . args)
- (let* (((stdoff rule format . until) args))
- (make-zone-entry
- (parse-time-spec stdoff) ; stdoff
- (cond [(string=? "-" rule) #f] ; rule
- [(char-alphabetic? (string-ref rule 0))
- (string->symbol rule)]
- [else (parse-time-spec rule)])
- format ; format
- (if (null? until) ; until
- #f (apply parse-until until)))))
+(define (parse-zone stdoff rule format . until)
+ (make-zone-entry
+ (parse-time-spec stdoff) ; stdoff
+ (cond [(string=? "-" rule) #f] ; rule
+ [(char-alphabetic? (string-ref rule 0))
+ (string->symbol rule)]
+ [else (parse-time-spec rule)])
+ format ; format
+ (if (null? until) ; until
+ #f (apply parse-until until))))
@@ -211,11 +211,12 @@
(let ((str (read-line port)))
(if (eof-object? str)
done
- (let* ((tokens (tokenize (strip-comments str))))
+ (let ((tokens (tokenize (strip-comments str))))
(cond [(null? tokens) (loop done continued)]
[continued
;; Zone-continuation
- (let* (((name entries) continued)
+ (let* ((name (car continued))
+ (entries (cadr continued))
(zone-entry (apply parse-zone tokens))
(zone-entries (cons zone-entry entries)))
(if (zone-entry-until zone-entry)
@@ -224,11 +225,11 @@
done)
#f)))]
[else
- (let* (((type . args) tokens))
+ (let ((type args (car+cdr tokens)))
(case (string->symbol type)
[(Rule)
- (let* (((name from to type in on at save letters) args))
+ (let ((name from to type in on at save letters (apply values args)))
(let ((parsed-from (parse-from from)))
(loop
(cons
@@ -257,7 +258,8 @@
#f)))]
[(Link)
- (let* (((target name) args))
+ (let ((target (car args))
+ (name (cadr args)))
(loop (cons (make-link name target)
done) #f))]
@@ -339,7 +341,7 @@
(lambda (d) (eqv? (cadr on) (week-day d)))
(set (day d) (days-in-month d)))]
[else ; < | >
- (let* (((<> wday base-day) on))
+ (let ((<> wday base-day (apply values on)))
(iterate (lambda (d) ((if (eq? '< <>)
date- date+)
d (date day: 1)))
@@ -389,7 +391,7 @@
[else
;; Sun<=25
;; Sun>=8
- (let* (((<> wday base-day) (rule-on rule)))
+ (let ((<> wday base-day (apply values (rule-on rule))))
(when (eq? '< <>)
(warning (_ "Counting backward for RRULES unsupported")))
;; NOTE this only realy works when base-day = 7n + 1, n ∈ N