assoc.scm 938 B

123456789101112131415161718192021222324252627282930313233
  1. (define (assoc key table)
  2. (if (null? table)
  3. #f
  4. (let ((entry (car table)))
  5. (if (equal? key (car entry))
  6. entry
  7. (assoc key (cdr table))))))
  8. (define (assoc-split keys table k)
  9. (let loop ((left '()) (right '()) (table table))
  10. (if (null? table)
  11. (k left right)
  12. (let ((entry (car table)))
  13. (if (member (car entry) keys)
  14. (loop (cons entry left) right (cdr table))
  15. (loop left (cons entry right) (cdr table)))))))
  16. (define (assoc-replace table key val)
  17. (if (null? table)
  18. (list (cons key val))
  19. (if (eq? (caar table) key)
  20. (cons (cons key val)
  21. (cdr table))
  22. (cons (car table) (assoc-replace (cdr table) key val)))))
  23. (define (assoc-replace* table table^)
  24. (if (null? table)
  25. table^
  26. (cond ((assoc (caar table) table^) => (lambda (entry)
  27. (cons entry (assoc-replace* (cdr table) table^))))
  28. (else (cons (car table) (assoc-replace* (cdr table) table^))))))