summary refs log tree commit diff
diff options
context:
space:
mode:
authorLeah Neukirchen <leah@vuxu.org>2022-11-26 00:32:44 +0100
committerLeah Neukirchen <leah@vuxu.org>2022-11-26 00:32:44 +0100
commit3360494dad789393fad412207dfc0b497dac887f (patch)
tree2ac9d91b05b6515fd2833fdd182e0dae8cc9ef20
parent116e3cab66eb8d9d09aca20310a01f544848b7fa (diff)
downloadmew-3360494dad789393fad412207dfc0b497dac887f.tar.gz
mew-3360494dad789393fad412207dfc0b497dac887f.tar.xz
mew-3360494dad789393fad412207dfc0b497dac887f.zip
replace kvs->alist with a generator
-rw-r--r--mew.scm40
1 files changed, 22 insertions, 18 deletions
diff --git a/mew.scm b/mew.scm
index bc03f6d..db53e87 100644
--- a/mew.scm
+++ b/mew.scm
@@ -325,26 +325,30 @@
 
   (define at (getter-with-setter get get-setter))
 
-  (define (kvs->alist kvs)
-    (let loop ((kvs kvs))
-      (match kvs
-        ((k v . kvs2) (cons (cons k v) (loop kvs2)))
-        (()           '())
-        (_            (error "odd key value list")))))
-
-  (define (tbl . kvs)
-    (alist->hash-table (kvs->alist kvs)))
+  (define (plist-generator l)
+    (lambda ()
+      (cond ((null? l)        (eof))
+            ((pair? (cdr l))  (let ((p (cons (car l) (cadr l))))
+                                (set! l (cddr l))
+                                p))
+            (else
+             (error "odd number of elements in key value list")))))
+
+  (define tbl
+    (case-lambda
+      (()   (make-hash-table))
+      (kvs  (into (tbl) (plist-generator kvs)))))
 
   (define (set-at o . rest)
-    (cond ((hash-table? o) (for-each (lambda (kv)
-                                       (hash-table-set! o (car kv) (cdr kv)))
-                                     (kvs->alist rest)))
-          ((vector? o)     (for-each (lambda (kv)
-                                       (vector-set! o (car kv) (cdr kv)))
-                                     (kvs->alist rest)))
-          ((string? o)     (for-each (lambda (kv)
-                                       (string-set! o (car kv) (cdr kv)))
-                                     (kvs->alist rest)))
+    (cond ((hash-table? o) (generator-for-each
+                            (lambda (kv) (hash-table-set! o (car kv) (cdr kv)))
+                            (plist-generator rest)))
+          ((vector? o)     (generator-for-each
+                            (lambda (kv) (vector-set! o (car kv) (cdr kv)))
+                            (plist-generator rest)))
+          ((string? o)     (generator-for-each
+                            (lambda (kv) (string-set! o (car kv) (cdr kv)))
+                            (plist-generator rest)))
           (else            (error "no set-at defined")))
     o)