diff --git a/doc/utils.md b/doc/utils.md index c992cbf..f94424d 100644 --- a/doc/utils.md +++ b/doc/utils.md @@ -73,6 +73,14 @@ the dictionary does not contain it and no default is given, an exception is raised. Otherwise the default value is returned in case of missing key. + (ldict-remove ld k) + +* ```ld``` - a ldict instance +* ```k``` - a compatible key + +Returns a new dictionary with the record under given key removed. If +the dictionary does not contain the key ```k```, an error is raised. + ### IO (import util-io) diff --git a/src/util-dict.scm b/src/util-dict.scm index 27448f9..e0766ce 100644 --- a/src/util-dict.scm +++ b/src/util-dict.scm @@ -110,17 +110,21 @@ ;; Returns a new dictionary based on d with key k removed. If it ;; doesn't contain the key, an error is raised. - (define (dict-remove d k) - (let loop ((s d) - (r '()) - (e #t)) - (if (null? s) - (if e - (error 'dict-remove "Key does not exist" k) - r) - (if (eq? (caar s) k) - (loop (cdr s) r #f) - (loop (cdr s) (cons (car s) r) e))))) + (define (dict-remove ld k) + (let ((equality? (ldict-equality? ld))) + (let loop ((pairs (ldict-pairs ld)) + (res '()) + (failure #t)) + (if (null? pairs) + (if failure + (error 'dict-remove "Key does not exist" k) + (cons TAG-LDICT + (cons (ldict-meta ld) + res))) + (loop (cdr pairs) + (if (equality? (caar pairs) k) + res + (cons (car pairs) res))))))) ;; Adds a new value v under the key k to the dictionary d possibly ;; overwriting any value which has been stored under the key