lota things

2019-06-27 11:11:18 +02:00
parent 6f5ecc87b0
commit efded2f9b8
13 changed files with 3211 additions and 199 deletions
@@ -0,0 +1,96 @@
+(import "cxr.slime")
+
+;; alist:
+;;        [ |/]
+;;         |
+;;         V
+;;        [ | ]------------->[ | ]-------------> ...
+;;         |                  |
+;;         V                  V
+;;        [ | ]->value1      [ | ]->value2
+;;         |                  |
+;;         V                  V
+;;        key1               key2
+;;
+;;        '(((key1 . value1) (key2 . value2)))
+(define key-not-found-index -1)
+
+(define (make-alist)
+  '(()))
+
+(define (pprint-alist alist)
+  (let ((associations (first alist)))
+    (define (pprint-intern associations)
+      (when associations
+        (printf "  "
+                (caar associations) "->"
+                (cdar associations))
+        (pprint-intern (rest associations))))
+    (print "(")
+    (when associations
+      (print "\n")
+      (pprint-intern associations))
+    (print ")\n")))
+
+
+(define (alist-get alist key)
+  (let ((associations (first alist)))
+    (define (alist-get-intern associations key)
+      (cond ((null? associations)
+             (error "key was not found in alist"))
+            ((= (caar associations) key)
+             (cdar associations))
+            (else (alist-get-intern (rest alist) key))))
+    (alist-get-intern associations key)))
+
+
+(define (alist-find alist key)
+  (let ((associations (first alist)))
+    (define (alist-find-intern associations key current-index)
+      (cond ((null? associations) key-not-found-index)
+            ((= (caar associations) key) current-index)
+            (else (alist-find-intern (rest associations)
+                                     key
+                                     (+ 1 current-index)))))
+    (alist-find-intern associations key 0)))
+
+
+(define (alist-key-exists? alist key)
+  (not (= (alist-find alist key)
+          key-not-found-index)))
+
+
+(define (alist-remove! alist key)
+  (let ((index (alist-find alist key)))
+    (define (alist-remove!-internal asociations index)
+      ;; reminder: we only get called if we are not replacing the
+      ;; first element in the alist
+      ;; reminder2: we know that the key exists
+      (if (= index 1)
+          ;; we want to remove the next one, so we set our
+          ;; cdr to the next next one
+          (mutate associations (pair (first associations)
+                                     (rest (rest associations))))
+        ;; else cdr-recurse
+        (alist-remove!-internal (rest asociations) (- index 1))))
+
+    (cond ((= index key-not-found-index) (error "key to remove was not found"))
+          ((= index 0) (mutate alist (pair (cdar alist) ())))
+          (else (alist-remove!-internal alist index)))))
+
+
+(define (alist-set! alist key value)
+  (mutate alist (pair (pair (pair key value)
+                       (car alist))
+                      ())))
+
+
+(define (alist-set-overwrite! alist key value)
+  (let ((associations (first alist)))
+    (define (alist-set-overwrite-intern associations key value)
+      (cond ((= (caar associations) key)
+             (mutate (car associations) (pair key value)))
+            ((null? associations) (alist-set! alist key value))
+            (else (alist-set-overwrite-intern
+                   (rest associations) key value))))
+    (alist-set-overwrite-intern associations key value)))