scm: Add assoc-set!
authorJan Nieuwenhuizen <janneke@gnu.org>
Mon, 27 Mar 2017 05:01:15 +0000 (07:01 +0200)
committerJan Nieuwenhuizen <janneke@gnu.org>
Mon, 27 Mar 2017 05:01:15 +0000 (07:01 +0200)
* module/mes/scm.mes (assoc-set!): New function.
* tests/scm.test ("assoc-set!", "assoc-set! new"): New tests.

module/mes/scm.mes
tests/scm.test

index e04e982c03e2476d72f64f2ca69f9b6b0524ccf2..a171da4ebdf449031ffa03c5c3618eea7c74eb86 100644 (file)
     (if entry (cdr entry)
         #f)))
 
     (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
 (define (memq x lst)
   (if (null? lst) #f ;; IF
       (if (eq? x (car lst)) lst
index 904c4b1005f8f93587c8af5b7e2924c819c88826..ee1c38ce437ec853f80e549a860239e30cb4e314 100755 (executable)
@@ -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 "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))
 
 (pass-if "builtin? car" (builtin? car))
 (pass-if "builtin? cdr" (builtin? cdr))