(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~%")))