slime/bin/alist.slime

(import "cxr.slime")

;; alist:
;;        [ |/]
;;         |
;;         V
;;        [ | ]------------->[ | ]-------------> ...
;;         |                  |
;;         V                  V
;;        [ | ]->value1      [ | ]->value2
;;         |                  |
;;         V                  V
;;        key1               key2
;;
;;        '(((key1 . value1) (key2 . value2)))

;; plist:
;;        [ |/]
;;         |
;;         V
;;        [ | ]------------->[ | ]-------------> ...
;;         |                  |
;;         V                  V
;;       :key1              value1
;;
;;        '((:key1 value1 :key2 value2))

(define key-not-found-index -1)

(define (make-alist)
  (set-type
   '(())
   :alist))

(define (make-plist)
  (set-type
   '(())
   :plist))

(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 (pprint-plist plist)
  (let ((props (first plist)))
    (define (pprint-intern props)
      (when props
        (printf "  "
                (car props) "->"
                (cadr props))
        (pprint-intern (cddr props))))
    (print "(")
    (when props
      (print "\n")
      (pprint-intern props))
    (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 associations) 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))))
  alist)


(define (alist-set! alist key value)
  (mutate alist (set-type (pair (pair (pair key value)
                                      (car alist))
                                ())
                          :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))
  alist)


(define (plist-get plist prop)
  (let ((props (first plist)))
    (define (plist-get-intern props prop)
      (cond ((null? props)
             (error "property was not found in plist"))
            ((= (car props) prop)
             (cadr props))
            (else (plist-get-intern (cddr props) prop))))
    (plist-get-intern props prop)))

(define (plist-set! plist prop value)
  (mutate plist (set-type (pair (pair prop (pair value (first plist))) ())
                          :plist)))

(define (plist-set-overwrite! plist prop value)
  (let ((props (first plist)))
    (define (plist-set-overwrite-intern props prop value)
      (cond ((= (car props) prop)
             (mutate (cdr props) (pair value (cddr props))))
            ((null? props) (plist-set! plist prop value))
            (else (plist-set-overwrite-intern
                   (cddr props) prop value))))
    (plist-set-overwrite-intern props prop value))
  plist)

(define (plist-find plist prop)
  (let ((props (first plist)))
    (define (plist-find-intern props prop current-index)
      (cond ((null? props) key-not-found-index)
            ((= (car props) prop) current-index)
            (else (plist-find-intern (cddr props) prop
                                     (+ 1 current-index)))))
    (plist-find-intern props prop 0)))

(define (plist-prop-exists? plist prop)
  (not (= (plist-find plist prop)
          key-not-found-index)))

(define (plist-remove! plist prop)
  (let ((index (plist-find plist prop)))
    (define (plist-remove!-internal props 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 (cdar props) (pair (cadar props) ;; xD nice meme dude!!!
                                      (cdr (cdr (cdr (cdar props))))))
        ;; else cdr-recurse
        (plist-remove!-internal (cddr props) (- index 1))))

    (cond ((= index key-not-found-index) (error "prop to remove was not found"))
          ((= index 0) (mutate plist (pair (cddar plist) ())))
          (else (plist-remove!-internal plist index))))
  plist)