fork download
  1. (defun aget (a-list key)
  2. (cdr (assoc key a-list)))
  3.  
  4. (define-setf-expander aget (a-list-form key-form &environment env)
  5. (multiple-value-bind (vars vals store setter getter) (get-setf-expansion a-list-form env)
  6. (let ((key-var (gensym "KEY-"))
  7. (entry (gensym "ENTRY-"))
  8. (alist (gensym "ALIST-")))
  9. (values (cons key-var vars)
  10. (cons key-form vals)
  11. store
  12. `(let* ((,alist ,getter)
  13. (,entry (assoc ,key-var ,alist)))
  14. (if ,entry
  15. (rplacd ,entry ,(first store))
  16. (setf ,alist (acons ,key-var ,(first store) ,alist)))
  17. (let ((,(first store) ,alist))
  18. ,setter)
  19. ,(first store))
  20. `(cdr (assoc ,key-var ,getter))))))
  21.  
  22. (let ((alists (vector '() () ()))
  23. (i -1))
  24. (setf (aget (aref alists (incf i)) :k1) 11
  25. (aget (aref alists (incf i)) :k1) 12
  26. (aget (aref alists (incf i)) :k1) 13
  27. i -1
  28. (aget (aref alists (incf i)) :k2) 21
  29. (aget (aref alists (incf i)) :k2) 22
  30. (aget (aref alists (incf i)) :k2) 23
  31. i -1
  32. (aget (aref alists (incf i)) :k1) 100
  33. (aget (aref alists (incf i)) :k2) 200
  34. (aget (aref alists (incf i)) :k3) 300)
  35. (print alists))
  36.  
  37.  
Success #stdin #stdout 0.01s 25644KB
stdin
Standard input is empty
stdout
#(((:K2 . 21) (:K1 . 100)) ((:K2 . 200) (:K1 . 12))
  ((:K3 . 300) (:K2 . 23) (:K1 . 13)))