felix/slime
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

hashmaps test

Browse Source
This commit is contained in:
Felix Brendel
2019-09-29 23:20:37 +02:00
parent 97f45f166f
commit 1c31749875
12 changed files with 346 additions and 367 deletions
Download Patch File Download Diff File Expand all files Collapse all files
bin/alist.slime
+166 -167
View File
@@ -1,189 +1,188 @@
(import "cxr.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!)
;; alist:
;; [ |/]
;; |
;; V
;; [ | ]------------->[ | ]-------------> ...
;; | |
;; V V
;; [ | ]->value1 [ | ]->value2
;; | |
;; V V
;; key1 key2
;;
;; '(((key1 . value1) (key2 . value2)))
(define key-not-found-index -1)
;; plist:
;; [ |/]
;; |
;; V
;; [ | ]------------->[ | ]-------------> ...
;; | |
;; V V
;; :key1 value1
;;
;; '((:key1 value1 :key2 value2))
(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 (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
(print " "
(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
(print " "
(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 (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 (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 (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-key-exists? alist key)
(not (= (alist-find alist key)
key-not-found-index)))
(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 (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 (key-exists? alist key)
(not (= (alist-find alist key)
key-not-found-index)))
(define (alist-set! alist key value)
(mutate alist (set-type! (pair (pair (pair key value)
(car alist))
())
:alist)))
(define (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-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 (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) (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-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 (plist-set! plist prop value)
(mutate plist (set-type! (pair (pair prop (pair value (first plist))) ())
:plist)))
(define (make)
(set-type!
'(())
: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 (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 (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 (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-prop-exists? plist prop)
(not (= (plist-find plist prop)
key-not-found-index)))
(define (set plist prop value)
(mutate plist (set-type! (pair (pair prop (pair value (first plist))) ())
:plist)))
(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))))
(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)
(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)
(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 (= (plist-find plist prop)
key-not-found-index)))
(define (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)
)
)
bin/interpolation.slime
-1
View File
@@ -42,7 +42,6 @@
(lambda (t)
(point-lerp (lerper1 t)
(lerper2 t) t))))
)
bin/sets.slime
+1 -2
View File
@@ -1,8 +1,7 @@
(define-module set
:imports ("cxr.slime")
:exports (make find contains? insert!)
(import "cxr.slime")
(define key-not-found-index -1)
(define (make . vals)