fork download
copy 
  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
comments (?)
stdin
copy 
Standard input is empty
stdout
copy 
#(((:K2 . 21) (:K1 . 100)) ((:K2 . 200) (:K1 . 12))
  ((:K3 . 300) (:K2 . 23) (:K1 . 13)))
https://ideone.com/9ZrfXW
a-list accessor aget
language:
Common Lisp (sbcl 1.4.16)
created:
3 years ago
visibility:
public

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!