From 1c0e76b022e1fc3ec8c32d86c2e54511078a3119 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?= Date: Fri, 7 Jul 2023 12:26:37 +0200 Subject: [PATCH] Remove old ldict implementation. --- doc/utils.md | 117 ----------------- src/util-dict-list.scm | 276 ----------------------------------------- 2 files changed, 393 deletions(-) delete mode 100644 src/util-dict-list.scm diff --git a/doc/utils.md b/doc/utils.md index 881bf7c..3be35ae 100644 --- a/doc/utils.md +++ b/doc/utils.md @@ -8,123 +8,6 @@ well. The modules are listed in alphabetical order. -### Dictionary - - (import util-dict-list) - -This module implements a simple key/value dictionary using lists as -backend. All operations are O(n) with respect to time. - - (make-ldict [equality?/pairs [pairs]]) - -* ```equality?/pairs``` - procedure or list of pairs -* ```pairs``` - list of pairs - -Creates a new ldict with configurable equality procedure, optionally -populating it with initial data. - -If only one argument is given, the procedure checks whether it is a -list of equality procedure and acts accordingly. - - (ldict? v) - -* ```v``` - any value - -Returns ```#t``` if given value is a ldict. - - (ldict-empty? ld) - -* ```ld``` - a ldict instance - -Returns ```#t``` if given dictionary contains no keys. - - (ldict-contains? ld k) - -* ```ld``` - a ldict instance -* ```k``` - a key compatible with given ldict - -Returns ```#t``` if given ```ld``` contains given key ```k```. - - (ldict-ref ld k [default]) - -* ```ld``` - a ldict instance -* ```k``` - a compatible key -* ```default``` - optional fallback value - -Retrieves the value associated with given key in given dictionary. If -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. - - (ldict-set ld k v) - -* ```ld``` - a ldict instance -* ```k``` - a compatible key -* ```v``` - a value to insert - -Sets existing key ```k``` to the new value ```v``` or inserts it if it -is not already present in the dictionary ```ld```. - - (ldict-keys ld) - -* ```ld``` - a ldict instance - -Returns the list of keys stored in given dictionary. - - (ldict-map proc ld) - -* ```proc``` - procedure accepting 1, 2 or 3 arguments -* ```ld``` - a ldict instance - -Returns a new dictionary of the same type with all values processed by -given procedure. - -If it accepts one argument, only the value is passed to it. If it -accepts two values, the key and the value is passed to it. And lastly -if it accepts three arguments, the key, value and numeric index -(starting from 0) are passed to it. - -In all cases the value the procedure returns is taken as the new value -for given key. - - (ldict-filter pred? ld) - -* ```pred?``` - predicate procedure -* ```ld``` -a ldict instance - -Returns a new dictionary containing only key/value pairs matching the -given predicate. The procedure ```pred?``` must accept two arguments - -the key and the value. - - (ldict-reduce init proc ld) - -* ```init``` - initial accumulator value -* ```proc``` - accumulating procedure -* ```ld``` - a ldict instance - -Performs a reduce operation on the pairs of given dictionary using -```init``` as initial accumulator. The accumulating procedure must -accept three arguments: the value accumulated so far, the key and the -value. - - (ldict-equal? d1 d2 [equality?]) - -* ```d1``` - a ldict instance -* ```d2``` - a ldict instance -* ```equality?``` - optional equality? predicate for values - -Returns ```#t``` if both dictionaries contain the same keys and their -values are equal according to the provided ```equality?``` predicate -which defaults to ```equal?```. - ### Set (List) (import util-set-list) diff --git a/src/util-dict-list.scm b/src/util-dict-list.scm deleted file mode 100644 index 55a848d..0000000 --- a/src/util-dict-list.scm +++ /dev/null @@ -1,276 +0,0 @@ -;; -;; util-dict-list.scm -;; -;; Simple dictionary implementation using list backend. -;; -;; ISC License -;; -;; Copyright 2023 Brmlab, z.s. -;; Dominik Pantůček -;; -;; Permission to use, copy, modify, and/or distribute this software -;; for any purpose with or without fee is hereby granted, provided -;; that the above copyright notice and this permission notice appear -;; in all copies. -;; -;; THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL -;; WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED -;; WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE -;; AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR -;; CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS -;; OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, -;; NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN -;; CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -;; - -(declare (unit util-dict-list)) - -(module - util-dict-list - ( - TAG-LDICT - - make-ldict - - ldict? - - ldict-empty? - - ldict-contains? - ldict-ref - - ldict-remove - ldict-set - - ldict-keys - - ldict-map - ldict-filter - ldict-reduce - - ldict-equal? - - ldict-tests! - ) - - (import scheme - (chicken base) - testing - util-tag - util-proc - util-set-list) - - ;; Tag used for identifying list dictionaries from this module - (define TAG-LDICT (make-tag LDICT)) - - ;; Creates an empty dictionary and optionally populates it with - ;; provided pairs. Default equality is eq?, default are '(). - (define (make-ldict . equality?/pairs) - (let ((equality? (if (or (null? equality?/pairs) - (not (procedure? (car equality?/pairs)))) - eq? - (car equality?/pairs))) - (pairs (if (or (null? equality?/pairs) - (procedure? (car equality?/pairs))) - '() - (car equality?/pairs)))) - (let loop ((ld (list TAG-LDICT - (list equality?))) - (pairs pairs)) - (if (null? pairs) - ld - (loop (ldict-set ld (caar pairs) (cdar pairs)) - (cdr pairs)))))) - - ;; Returns true if given value is a ldict - (define (ldict? v) - (and (pair? v) - (eq? (car v) TAG-LDICT))) - - ;; Convenience accessors - (define ldict-meta cadr) - (define ldict-equality? caadr) - (define ldict-pairs cddr) - - ;; Returns true if given dictionary contains no keys - (define (ldict-empty? ld) - (null? (ldict-pairs ld))) - - ;; Checks whether given dictionary d contains the key k. - (define (ldict-contains? ld k) - (let ((equality? (ldict-equality? ld))) - (let loop ((pairs (ldict-pairs ld))) - (if (null? pairs) - #f - (if (equality? (caar pairs) k) - #t - (loop (cdr pairs))))))) - - ;; Retrieves the value for key k from dictionary d. If third argument - ;; is provided it is used as default value in case the key does not - ;; exist. If only two arguments are given and the key does not exist, - ;; raises an error. - (define (ldict-ref ld k . ds) - (let ((equality? (ldict-equality? ld))) - (let loop ((pairs (ldict-pairs ld))) - (if (null? pairs) - (if (null? ds) - (error 'ldict-ref "Key does not exist" k) - (car ds)) - (if (equality? (caar pairs) k) - (cdar pairs) - (loop (cdr pairs))))))) - - ;; Returns a new dictionary based on d with key k removed. If it - ;; doesn't contain the key, an error is raised. - (define (ldict-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)) - (and failure - (not (equality? (caar pairs) k)))))))) - - ;; Adds a new value v under the key k to the dictionary d possibly - ;; overwriting any value which has been stored under the key - ;; before. Returns the updated dictionary. - (define (ldict-set ld k v) - (let ((equality? (ldict-equality? ld))) - (let loop ((pairs (ldict-pairs ld)) - (res '())) - (if (null? pairs) - (cons TAG-LDICT - (cons (ldict-meta ld) - (cons (cons k v) - res))) - (loop (cdr pairs) - (if (equality? (caar pairs) k) - res - (cons (car pairs) res))))))) - - ;; Returns the list of keys stored in given dictionary. - (define (ldict-keys ld) - (map car (ldict-pairs ld))) - - ;; Maps dictionary values, the procedure gets key-value pairs if it - ;; accepts more than one argument. If it accepts a third argument, - ;; index gets passed as well. - (define (ldict-map proc ld) - (let ((both? ((procedure-arity>=? 2) proc)) - (index? ((procedure-arity>=? 3) proc))) - (let loop ((pairs (ldict-pairs ld)) - (res '()) - (i 0)) - (if (null? pairs) - (cons TAG-LDICT - (cons (ldict-meta ld) - res)) - (loop (cdr pairs) - (let ((k (caar pairs)) - (v (cdar pairs))) - (cons (cons k (if both? - (if index? - (proc k v i) - (proc k v)) - (proc v))) - res)) - (add1 i)))))) - - ;; Returns a dictionary containing only kv pairs matching the - ;; predicate which must accept two arguments. Unlike list filter, - ;; does not perform final reverse on the result. - (define (ldict-filter pred? ld) - (let loop ((pairs (ldict-pairs ld)) - (res '())) - (if (null? pairs) - (cons TAG-LDICT - (cons (ldict-meta ld) - res)) - (loop (cdr pairs) - (if (pred? (caar pairs) (cdar pairs)) - (cons (car pairs) res) - res))))) - - ;; Reduce over dictinary, the reducing procedure gets accumulator, - ;; key and value as its three arguments. - (define (ldict-reduce init proc ld) - (let loop ((pairs (ldict-pairs ld)) - (acc init)) - (if (null? pairs) - acc - (loop (cdr pairs) - (proc acc (caar pairs) (cdar pairs)))))) - - ;; Returns true if both dictionaries contain the same keys and - ;; values. - (define (ldict-equal? d1 d2 . equality?) - (let ((e1 (ldict-equality? d1)) - (e2 (ldict-equality? d2))) - (let ((equality? (if (null? equality?) - equal? - (car equality?)))) - (if (not (eq? e1 e2)) - #f - (let ((k1 (list->lset (ldict-keys d1))) - (k2 (list->lset (ldict-keys d2)))) - (if (lset=? k1 k2) - (let loop ((keys (lset->list k1))) - (if (null? keys) - #t - (if (equality? (ldict-ref d1 (car keys)) - (ldict-ref d2 (car keys))) - (loop (cdr keys)) - #f))) - #f)))))) - - ;; Performs self-tests of the dictionary module. - (define (ldict-tests!) - (run-tests - ldict - (test-equal? make-ldict (make-ldict) `(,TAG-LDICT (,eq?))) - (test-exn ldict-ref (ldict-ref (make-ldict) 'nonexistent)) - (test-true ldict-ref (ldict-ref (make-ldict) 'nonexistent #t)) - (test-equal? ldict-set (ldict-set (make-ldict) 'nonexistent 1) - `(,TAG-LDICT (,eq?) (nonexistent . 1))) - (test-equal? ldict-set (ldict-set (ldict-set (make-ldict) 'existent 1) 'existent 2) - `(,TAG-LDICT (,eq?) (existent . 2))) - (test-exn ldict-remove (ldict-remove (make-ldict) 'nonexistent)) - (test-equal? ldict-remove - (ldict-remove (ldict-set (make-ldict) 'existing 1) 'existing) - (make-ldict)) - (test-equal? ldict-keys (ldict-keys (ldict-set (make-ldict) 'existing 1)) '(existing)) - (test-equal? ldict-map - (ldict-map (lambda (v) (* 2 v)) - (make-ldict '((a . 1) - (b . 2)))) - (make-ldict '((b . 4) - (a . 2)))) - (test-equal? ldict-map - (ldict-map (lambda (k v) (* 2 v)) - (make-ldict '((a . 1) - (b . 2)))) - (make-ldict '((b . 4) - (a . 2)))) - (test-equal? ldict-filter - (ldict-filter (lambda (k v) - (odd? v)) - (make-ldict '((a . 1) - (b . 2)))) - (make-ldict '((a . 1)))) - (test-eq? ldict-reduce - (ldict-reduce 0 (lambda (a k v) (+ a v)) - (make-ldict '((a . 1) (b . 2)))) - 3) - )) - - )