Advertisement
Guest User

Untitled

a guest
May 16th, 2019
137
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 0.92 KB | None | 0 0
  1. (defmacro save-place ((place &optional new) &body body &environment env)
  2. (multiple-value-bind (vars vals store-vars writer-form reader-form) (get-setf-expansion place env)
  3. (when (cdr store-vars) (error "Can't expand this place ~S" place))
  4. (let ((name (gensym)))
  5. `(let* (,@(mapcar (function list) vars vals)
  6. (,(car store-vars) ,reader-form))
  7.  
  8. (let ((,name (or ,new ,(car store-vars))))
  9. (unwind-protect (progn ,@body)
  10. (setf ,(car store-vars) ,name)
  11. ,writer-form))))))
  12.  
  13. (let ((k (vector (cons 42 33)
  14. (cons 0 0)
  15. (cons 1 1)))
  16. (i -1))
  17. (block out
  18. (save-place ((car (aref k (incf i))))
  19. (dotimes (j (length k))
  20. (setf (car (aref k j)) -1
  21. (cdr (aref k j)) -1))
  22. (return-from out 'hi)))
  23. (assert (= 42 (car (aref k 0))))
  24. k)
  25. ; --> #((42 . -1) (-1 . -1) (-1 . -1))
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement