scm: Add assoc-set!

* module/mes/scm.mes (assoc-set!): New function.
* tests/scm.test ("assoc-set!", "assoc-set! new"): New tests.

diff --git a/module/mes/scm.mes b/module/mes/scm.mes
index e04e982c03e2476d72f64f2ca69f9b6b0524ccf2..a171da4ebdf449031ffa03c5c3618eea7c74eb86 100644 (file)
--- a/module/mes/scm.mes
+++ b/module/mes/scm.mes
@@ -120,6 +120,12 @@
     (if entry (cdr entry)
         #f)))
 
+(define (assoc-set! alist key value)
+  (let ((entry (assoc key alist)))
+    (if (not entry) (acons key value alist)
+        (let ((entry (set-cdr! entry value)))
+          alist))))
+
 (define (memq x lst)
   (if (null? lst) #f ;; IF
       (if (eq? x (car lst)) lst

diff --git a/tests/scm.test b/tests/scm.test
index 904c4b1005f8f93587c8af5b7e2924c819c88826..ee1c38ce437ec853f80e549a860239e30cb4e314 100755 (executable)
--- a/tests/scm.test
+++ b/tests/scm.test
@@ -90,6 +90,8 @@ exit $?
 (pass-if "assq-set!" (sequal? (assq-set! '((b . 1)) 'a 0) '((a . 0) (b . 1))))
 (pass-if "assq-set! 2" (sequal? (assq-set! '((a . 0)) 'a 1) '((a . 1))))
 (pass-if "assoc" (sequal? (assoc '(a . 0) '((a . 0) (b . 1) ((a . 0) aa))) '((a . 0) aa)))
+(pass-if-equal "assoc-set!" '((a . 0) (b . 2)) (assoc-set! '((a . 0) (b . 1)) 'b 2))
+(pass-if-equal "assoc-set! new" '((b . 2) (a . 0)) (assoc-set! '((a . 0)) 'b 2))
 
 (pass-if "builtin? car" (builtin? car))
 (pass-if "builtin? cdr" (builtin? cdr))