Finish dictionary implementation.

brmsaptool.scm

@@ -20,13 +20,30 @@
 ;; NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN
 ;; CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
 ;;
-(import (chicken process-context)
+(import (chicken condition)
+	(chicken process-context)
 	(chicken file)
 	(chicken file posix))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Testing
 
+(define-syntax with-handler
+  (syntax-rules ()
+    ((_ handler body ...)
+     (call-with-current-continuation
+      (lambda (k)
+	(with-exception-handler
+	 (lambda (x) (k (handler x)))
+	 (lambda () body ...)))))))
+
+(define-syntax unit-test
+  (syntax-rules ()
+    ((_ name condition)
+     (if (with-handler (lambda (x) #f)
+		       (lambda () condition))
+	 (display ".")
+	 (error 'unit-test name)))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Dictionary
@@ -38,15 +55,52 @@
   (if (assq k d) #t #f))
 
 (define (dict-ref d k . r)
-  (let ((p (assq d k))
-	(d (if (null? r) #f (car r))))
+  (let ((p (assq k d)))
     (if p
 	(cdr p)
-	d)))
+	(if (null? r)
+	    (error 'dict-ref "Key does not exist" k)
+	    (car r)))))
+
+(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-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)))
+
+(define (dict-keys d)
+  (map car d))
 
 (define (dict-tests!)
   (display "[test] dict ")
-  (newline))
+  (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."))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (define *members-directory* "members")
 
@@ -58,7 +112,17 @@
   (directory *members-directory*))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Run everything
 
+;; Print banner
+(print "brmsaptool 0.1 (c) 2023 Brmlab, z.s.")
+(newline)
+
+;; Run tests
+(print "Running self-tests:")
 (dict-tests!)
+(print "All self-tests ok!")
+(newline)
 
+;; Perform requested action
 (displayln (load-members))