Hi all, I'd like to continue with Christian's initiative. Find attached a simple patch that adds a non-destructive version of alist-update! named (obviously) alist-update to the data-structures unit. It also updates the manual accordingly and adds a few test cases for both alist-update! and alist-update. Since the patch is so trivial I won't discuss it in detail, just take a look and you'll get the idea :-)
Regards Moritz
>From 58fde20c0eefd7527886bb5342ac1489b805f4bc Mon Sep 17 00:00:00 2001 From: Moritz Heidkamp <mor...@twoticketsplease.de> Date: Tue, 6 Sep 2011 15:03:06 +0200 Subject: [PATCH] add non-destructive version of alist-update! named alist-update and add some tests for both of them --- data-structures.import.scm | 1 + data-structures.scm | 3 +++ manual/Unit data-structures | 7 ++++--- tests/data-structures-tests.scm | 18 ++++++++++++++++++ tests/runtests.sh | 3 +++ 5 files changed, 29 insertions(+), 3 deletions(-) create mode 100644 tests/data-structures-tests.scm diff --git a/data-structures.import.scm b/data-structures.import.scm index 245c7c4..2fd71bf 100644 --- a/data-structures.import.scm +++ b/data-structures.import.scm @@ -29,6 +29,7 @@ '(->string alist-ref alist-update! + alist-update always? ; DEPRECATED any? atom? diff --git a/data-structures.scm b/data-structures.scm index 7da3698..7cb8e98 100644 --- a/data-structures.scm +++ b/data-structures.scm @@ -231,6 +231,9 @@ EOF lst) (cons (cons x y) lst) ) ) ) +(define (alist-update k v lst #!optional (cmp eqv?)) + (alist-update! k v (map (lambda (elt) (cons (car elt) (cdr elt))) lst) cmp)) + (define (alist-ref x lst #!optional (cmp eqv?) (default #f)) (let* ([aq (cond [(eq? eq? cmp) assq] [(eq? eqv? cmp) assv] diff --git a/manual/Unit data-structures b/manual/Unit data-structures index 6f3e8c1..5412ea4 100644 --- a/manual/Unit data-structures +++ b/manual/Unit data-structures @@ -19,15 +19,16 @@ Looks up {{KEY}} in {{ALIST}} using {{TEST}} as the comparison function (or {{eq no test was given) and returns the cdr of the found pair, or {{DEFAULT}} (which defaults to {{#f}}). -==== alist-update! +==== alist-update +<procedure>(alist-update KEY VALUE ALIST [TEST])</procedure> <procedure>(alist-update! KEY VALUE ALIST [TEST])</procedure> If the list {{ALIST}} contains a pair of the form {{(KEY . X)}}, then this procedure replaces {{X}} with {{VALUE}} and returns {{ALIST}}. If {{ALIST}} contains no such item, then -{{alist-update!}} returns {{((KEY . VALUE) . ALIST)}}. The optional argument +{{alist-update}} returns {{((KEY . VALUE) . ALIST)}}. The optional argument {{TEST}} specifies the comparison procedure to search a matching pair in {{ALIST}} -and defaults to {{eqv?}}. +and defaults to {{eqv?}}. {{alist-update!}} is the destructive version of {{alist-update}}. ==== atom? diff --git a/tests/data-structures-tests.scm b/tests/data-structures-tests.scm new file mode 100644 index 0000000..df4b559 --- /dev/null +++ b/tests/data-structures-tests.scm @@ -0,0 +1,18 @@ +;;;; data-structures-tests.scm + + +(use data-structures) + +(let ((alist '((foo . 123) ("bar" . "baz")))) + (alist-update! 'foo 999 alist) + (assert (= (alist-ref 'foo alist) 999)) + (alist-update! 'qux 'nope alist) + (assert (not (alist-ref 'qux alist))) + (assert (eq? 'yep (alist-ref 'qux (alist-update! 'qux 'yep alist)))) + (assert (eq? 'ok (alist-ref "bar" (alist-update! "bar" 'ok alist equal?) equal?)))) + +(let ((alist '((foo . 123) ("bar" . "baz")))) + (alist-update 'foo 999 alist) + (assert (= (alist-ref 'foo alist) 123)) + (assert (eq? 'yep (alist-ref 'qux (alist-update 'qux 'yep alist)))) + (assert (eq? 'ok (alist-ref "bar" (alist-update "bar" 'ok alist equal?) equal?)))) \ No newline at end of file diff --git a/tests/runtests.sh b/tests/runtests.sh index 4a24457..f0c19ce 100644 --- a/tests/runtests.sh +++ b/tests/runtests.sh @@ -294,6 +294,9 @@ echo "======================================== srfi-18 tests ..." $interpret -s simple-thread-test.scm $interpret -s mutex-test.scm +echo "======================================== data-structures tests ..." +$interpret -s data-structures-tests.scm + echo "======================================== path tests ..." $interpret -bnq path-tests.scm -- 1.7.6.1
_______________________________________________ Chicken-hackers mailing list Chicken-hackers@nongnu.org https://lists.nongnu.org/mailman/listinfo/chicken-hackers