slime/bin/alist.slime

(define-module ds
  :exports
  (alist::make alist::print alist::get alist::find alist::key-exists?  alist::remove! alist::set! alist::set-overwrite!
   plist::make plist::print plist::get plist::find plist::prop-exists? plist::remove! plist::set! plist::set-overwrite!)


  (define-module alist
    :imports ("cxr.slime")
    :exports (make print get find key-exists? remove! set! set-overwrite!)
    (define key-not-found-index -1)

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

    (define (print alist)
      (let ((associations (car alist)))
        (define (pprint-intern associations)
          (when associations
            (print "  "
                   (caar associations) "->"
                   (cdar associations))
            (pprint-intern (cdr associations))))
        (print "(")
        (when associations
          (print "\n")
          (pprint-intern associations))
        (print ")\n")))


    (define (get alist key)
      (let ((associations (car alist)))
        (define (alist-get-intern associations key)
          (cond ((null? associations)
                 (error :key-not-found "key was not found in alist"))
                ((= (caar associations) key)
                 (cdar associations))
                (else (alist-get-intern (cdr associations) key))))
        (alist-get-intern associations key)))


    (define (find alist key)
      (let ((associations (car 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 (cdr associations)
                                         key
                                         (+ 1 current-index)))))
        (alist-find-intern associations key 0)))


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


    (define (remove! alist key)
      (let ((index (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 (cons (car associations)
                                         (cdr (cdr associations))))
            ;; else cdr-recurse
            (alist-remove!-internal (cdr asociations) (- index 1))))

        (cond ((= index key-not-found-index) (error :key-not-found "key to remove was not found"))
              ((= index 0) (mutate! alist (cons (cdar alist) ())))
              (else (alist-remove!-internal alist index))))
      alist)


    (define (set! alist key value)
      (mutate! alist (set-type! (cons (cons (cons key value)
                                           (car alist))
                                     ())
                               :alist)))

    (define (set-overwrite! alist key value)
      (let ((associations (car alist)))
        (define (alist-set-overwrite-intern associations key value)
          (cond ((= (caar associations) key)
                 (mutate! (car associations) (cons key value)))
                ((null? associations) (set! alist key value))
                (else (alist-set-overwrite-intern
                       (cdr associations) key value))))
        (alist-set-overwrite-intern associations key value))
      alist)
    )

  (define-module plist
    :imports ("cxr.slime")
    :exports (make print get find prop-exists? remove! set! set-overwrite!)
    ;; plist:
    ;;        [ |/]
    ;;         |
    ;;         V
    ;;        [ | ]------------->[ | ]-------------> ...
    ;;         |                  |
    ;;         V                  V
    ;;       :key1              value1
    ;;
    ;;        '((:key1 value1 :key2 value2))

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

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

    (define (print plist)
      (let ((props (car plist)))
        (define (pprint-intern props)
          (when props
            (print "  "
                   (car props) "->"
                   (cadr props))
            (pprint-intern (cddr props))))
        (print "(")
        (when props
          (print "\n")
          (pprint-intern props))
        (print ")\n")))

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

    (define (set! plist prop value)
      (mutate! plist (set-type! (cons (cons prop (cons value (car plist))) ())
                               :plist)))

    (define (set-overwrite! plist prop value)
      (let ((props (car plist)))
        (define (plist-set-overwrite-intern props prop value)
          (cond ((= (car props) prop)
                 (mutate! (cdr props) (cons 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 (find plist prop)
      (let ((props (car 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 (prop-exists? plist prop)
      (not (= (find plist prop)
              key-not-found-index)))

    (define (remove! plist prop)
      (let ((index (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) (cons (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 :key-not-found "prop to remove was not found"))
              ((= index 0) (mutate! plist (cons (cddar plist) ())))
              (else (plist-remove!-internal plist index))))
      plist)

    )
  )