(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 (first alist))) (define (pprint-intern associations) (when associations (print " " (caar associations) "->" (cdar associations)) (pprint-intern (rest associations)))) (print "(") (when associations (print "\n") (pprint-intern associations)) (print ")\n"))) (define (get alist key) (let ((associations (first 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 (rest associations) key)))) (alist-get-intern associations key))) (define (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 (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 (pair (first associations) (rest (rest associations)))) ;; else cdr-recurse (alist-remove!-internal (rest asociations) (- index 1)))) (cond ((= index key-not-found-index) (error :key-not-found "key to remove was not found")) ((= index 0) (mutate alist (pair (cdar alist) ()))) (else (alist-remove!-internal alist index)))) alist) (define (set! alist key value) (mutate alist (set-type! (pair (pair (pair key value) (car alist)) ()) :alist))) (define (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) (set! alist key value)) (else (alist-set-overwrite-intern (rest 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 (first 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 (first 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! (pair (pair prop (pair value (first plist))) ()) :plist))) (define (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 (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 (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) (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 :key-not-found "prop to remove was not found")) ((= index 0) (mutate plist (pair (cddar plist) ()))) (else (plist-remove!-internal plist index)))) plist) ) )