(ql:quickload '(:alexandria :place-utils)) (eval-when (:compile-toplevel :load-toplevel :execute) (defun make-gensym-list (n &optional name) (loop :repeat n :collect (if name (gensym name) (gensym))))) (defmacro place-only (specs &body forms) (let ((gensyms (make-gensym-list (length specs) "ONCE-ONLY")) (specs (mapcar (lambda (spec) (etypecase spec (list (destructuring-bind (name form) spec (cons name form))) (symbol (cons spec spec)))) specs))) ;; bind in user-macro `(let ,(mapcar (lambda (g n) `(,g (gensym ,(string (car n))))) gensyms specs) ;; bind in final expansion `(place-utils:with-resolved-places (,,@(mapcar (lambda (g n) ``(,,g ,,(cdr n))) gensyms specs)) ;; bind in user-macro ,(let ,(mapcar (lambda (n g) `(,(car n) ,g)) specs gensyms) ,@forms))))) ;; Multiple evaluation of subforms -- both when getting and setting (defmacro some-macro-0 (place &body body) `(progn (setf ,place (1+ ,place)) (format t "a list: ~a~%" (list ,place ,place ,place)) ,@body)) ;; Multiple evaluation of subforms when setting (defmacro some-macro-10 (place &body body) (alexandria:once-only ((v place)) `(progn (setf ,place (1+ ,v)) (format t "a list: ~a~%" (list ,v ,v ,v)) ,@body))) ;; Everything fine, but has to be done manually by introducing a local place via ;; WITH-RESOLVED-PLACES (the equivalent of a LET with normal expressions) (defmacro some-macro-20 (place &body body) (let ((sym (gensym))) `(place-utils:with-resolved-places ((,sym ,place)) (progn (setf ,sym (1+ ,sym)) (format t "a list: ~a~%" (list ,sym ,sym ,sym)) ,@body)))) ;; Everything fine, the job is done manually by PLACE-ONLY (defmacro some-macro-30 (place &body body) (place-only (place) `(progn (setf ,place (1+ ,place)) (format t "a list: ~a~%" (list ,place ,place ,place)) ,@body))) (flet ((random-cons () (cons 1 2))) (some-macro-0 (car (random-cons)) (format t "yo~%")) (some-macro-10 (car (random-cons)) (format t "yo~%")) (some-macro-20 (car (random-cons)) (format t "yo~%")) (some-macro-30 (car (random-cons)) (format t "yo~%")))