From 1849a63d36aec112c427e35a4b851f6667bfc053 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?= Date: Mon, 13 Mar 2023 19:53:17 +0100 Subject: [PATCH] Make dictionary a standalone module. --- brmsaptool.scm | 63 ---------------------------- dictionary.scm | 109 +++++++++++++++++++++++++++++++++++++++++++++++++ testing.scm | 3 +- 3 files changed, 111 insertions(+), 64 deletions(-) create mode 100644 dictionary.scm diff --git a/brmsaptool.scm b/brmsaptool.scm index 3fe6b05..56fdc3b 100644 --- a/brmsaptool.scm +++ b/brmsaptool.scm @@ -65,69 +65,6 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Dictionary -;; Returns an empty dictionary represented as empty list. -(define (make-dict) - '()) - -;; Checks whether given dictionary d contains the key k. -(define (dict-has-key? d k) - (if (assq k d) #t #f)) - -;; 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 (dict-ref d k . r) - (let ((p (assq k d))) - (if p - (cdr p) - (if (null? r) - (error 'dict-ref "Key does not exist" k) - (car r))))) - -;; 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))))) - -;; 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 (dict-set d k v) - (let ((dr (let loop ((s d) - (r '())) - (if (null? s) - r - (if (eq? (caar s) k) - (loop (cdr s) r) - (loop (cdr s) (cons (car s) r))))))) - (cons (cons k v) - dr))) - -;; Returns the list of keys stored in given dictionary. -(define (dict-keys d) - (map car d)) - -(define (dict-tests!) - (display "[test] dict ") - (unit-test 'make-dict (null? (make-dict))) - (unit-test 'dict-ref-nonexistent (with-handler (lambda (x) #t) (dict-ref (make-dict) 'nonexistent) #f)) - (unit-test 'dict-ref-default (dict-ref (make-dict) 'nonexistent #t)) - (unit-test 'dict-set-nonexistent (equal? (dict-set (make-dict) 'nonexistent 1) '((nonexistent . 1)))) - (unit-test 'dict-set-existent (equal? (dict-set (dict-set (make-dict) 'existent 1) 'existent 2) '((existent . 2)))) - (unit-test 'dict-remove-nonexistent (with-handler (lambda (x) #t) (dict-remove (make-dict) 'nonexistent) #f)) - (unit-test 'dict-remove-existing (null? (dict-remove (dict-set (make-dict) 'existing 1) 'existing))) - (unit-test 'dict-keys (equal? (dict-keys (dict-set (make-dict) 'existing 1)) '(existing))) - (print " ok.")) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Months support diff --git a/dictionary.scm b/dictionary.scm new file mode 100644 index 0000000..bc1656a --- /dev/null +++ b/dictionary.scm @@ -0,0 +1,109 @@ +;; +;; dictionary.scm +;; +;; Simple dictionary implementation using assq lists. +;; +;; 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. +;; + +(module + dictionary + ( + make-dict + dict-has-key? dict-ref + dict-remove dict-set + dict-keys + dict-tests! + ) + + (import scheme + (chicken base) + testing) + + ;; Returns an empty dictionary represented as empty list. + (define (make-dict) + '()) + + ;; Checks whether given dictionary d contains the key k. + (define (dict-has-key? d k) + (if (assq k d) #t #f)) + + ;; 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 (dict-ref d k . r) + (let ((p (assq k d))) + (if p + (cdr p) + (if (null? r) + (error 'dict-ref "Key does not exist" k) + (car r))))) + + ;; 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))))) + + ;; 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 (dict-set d k v) + (let ((dr (let loop ((s d) + (r '())) + (if (null? s) + r + (if (eq? (caar s) k) + (loop (cdr s) r) + (loop (cdr s) (cons (car s) r))))))) + (cons (cons k v) + dr))) + + ;; Returns the list of keys stored in given dictionary. + (define (dict-keys d) + (map car d)) + + ;; Performs self-tests of the dictionary module. + (define (dict-tests!) + (run-tests + dict + (test-true make-dict (null? (make-dict))) + (test-exn dict-ref (dict-ref (make-dict) 'nonexistent)) + (test-true dict-ref (dict-ref (make-dict) 'nonexistent #t)) + (test-equal? dict-set (dict-set (make-dict) 'nonexistent 1) '((nonexistent . 1))) + (test-equal? dict-set (dict-set (dict-set (make-dict) 'existent 1) 'existent 2) '((existent . 2))) + (test-exn dict-remove (dict-remove (make-dict) 'nonexistent)) + (test-true dict-remove (null? (dict-remove (dict-set (make-dict) 'existing 1) 'existing))) + (test-equal? dict-keys (dict-keys (dict-set (make-dict) 'existing 1)) '(existing)) + )) + + ) + +(import dictionary) +(dict-tests!) diff --git a/testing.scm b/testing.scm index ad2597f..a12c1d1 100644 --- a/testing.scm +++ b/testing.scm @@ -28,7 +28,8 @@ (test-eq? test-equal? test-exn test-true test-false run-tests) (import scheme - (chicken condition)) + (chicken condition) + (chicken format)) ;; Evaluates body ... expressions with exception handler installed. (define-syntax with-handler