No puede seleccionar más de 25 temas Los temas deben comenzar con una letra o número, pueden incluir guiones ('-') y pueden tener hasta 35 caracteres de largo.
 
 
 
 
 
 

97 líneas
3.1 KiB

  1. (import "cxr.slime")
  2. ;; alist:
  3. ;; [ |/]
  4. ;; |
  5. ;; V
  6. ;; [ | ]------------->[ | ]-------------> ...
  7. ;; | |
  8. ;; V V
  9. ;; [ | ]->value1 [ | ]->value2
  10. ;; | |
  11. ;; V V
  12. ;; key1 key2
  13. ;;
  14. ;; '(((key1 . value1) (key2 . value2)))
  15. (define key-not-found-index -1)
  16. (define (make-alist)
  17. '(()))
  18. (define (pprint-alist alist)
  19. (let ((associations (first alist)))
  20. (define (pprint-intern associations)
  21. (when associations
  22. (printf " "
  23. (caar associations) "->"
  24. (cdar associations))
  25. (pprint-intern (rest associations))))
  26. (print "(")
  27. (when associations
  28. (print "\n")
  29. (pprint-intern associations))
  30. (print ")\n")))
  31. (define (alist-get alist key)
  32. (let ((associations (first alist)))
  33. (define (alist-get-intern associations key)
  34. (cond ((null? associations)
  35. (error "key was not found in alist"))
  36. ((= (caar associations) key)
  37. (cdar associations))
  38. (else (alist-get-intern (rest alist) key))))
  39. (alist-get-intern associations key)))
  40. (define (alist-find alist key)
  41. (let ((associations (first alist)))
  42. (define (alist-find-intern associations key current-index)
  43. (cond ((null? associations) key-not-found-index)
  44. ((= (caar associations) key) current-index)
  45. (else (alist-find-intern (rest associations)
  46. key
  47. (+ 1 current-index)))))
  48. (alist-find-intern associations key 0)))
  49. (define (alist-key-exists? alist key)
  50. (not (= (alist-find alist key)
  51. key-not-found-index)))
  52. (define (alist-remove! alist key)
  53. (let ((index (alist-find alist key)))
  54. (define (alist-remove!-internal asociations index)
  55. ;; reminder: we only get called if we are not replacing the
  56. ;; first element in the alist
  57. ;; reminder2: we know that the key exists
  58. (if (= index 1)
  59. ;; we want to remove the next one, so we set our
  60. ;; cdr to the next next one
  61. (mutate associations (pair (first associations)
  62. (rest (rest associations))))
  63. ;; else cdr-recurse
  64. (alist-remove!-internal (rest asociations) (- index 1))))
  65. (cond ((= index key-not-found-index) (error "key to remove was not found"))
  66. ((= index 0) (mutate alist (pair (cdar alist) ())))
  67. (else (alist-remove!-internal alist index)))))
  68. (define (alist-set! alist key value)
  69. (mutate alist (pair (pair (pair key value)
  70. (car alist))
  71. ())))
  72. (define (alist-set-overwrite! alist key value)
  73. (let ((associations (first alist)))
  74. (define (alist-set-overwrite-intern associations key value)
  75. (cond ((= (caar associations) key)
  76. (mutate (car associations) (pair key value)))
  77. ((null? associations) (alist-set! alist key value))
  78. (else (alist-set-overwrite-intern
  79. (rest associations) key value))))
  80. (alist-set-overwrite-intern associations key value)))