Work transfer
This commit is contained in:
Felix Brendel
+190
-190
@@ -1,190 +1,190 @@
|
||||
(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)
|
||||
|
||||
)
|
||||
)
|
||||
(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)
|
||||
|
||||
)
|
||||
)
|
||||
|
||||
Reference in New Issue
Block a user