;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; PLUSPLUS
;;;
;;; This macro has a multiple evaluation bug (of the place's subforms)! I is
;;; incremented twice and ends up (1) reading the second element but (2) writing
;;; to the third element.

(defmacro plusplus (place &optional delta-form)
  "Destructively increment place value; However, return the original value."
  (let ((place-before (gensym)))
    `(let ((,place-before ,place))
       (incf ,place ,delta-form)
       ,place-before)))

(let ((list (list 1 2 3))
      (i 0))
  (let ((old (plusplus (nth (incf i) list) 3)))
    (values old i list)))
;; => 2, 2, (1 2 6)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; PLUSPLUS1
;;;
;;; A version that uses DEFINE-MODIFY-MACRO and avoids the multiple evaluation
;;; bug, but returns the new value instead of the old value (DEFINE-MODIFY-MACRO
;;; therefore isn't suitable here).

(defun plusplus1-fn (value delta)
  (+ value delta))

(define-modify-macro plusplus1 (delta) plusplus1-fn)

(let ((list (list 1 2 3))
      (i 0))
  (let ((old (plusplus1 (nth (incf i) list) 3)))
    (values old i list)))
;; => 5, 1, (1 5 3)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; PLUSPLUS2
;;;
;;; A correct version that manually uses GET-SETF-EXPANSION to access the place.

(defmacro plusplus2 (place delta &environment env)
  (let ((old (gensym)))
    (multiple-value-bind (temps exprs stores set get)
        (get-setf-expansion place env)
      `(let* (,@(mapcar #'list temps exprs)
              (,old ,get)
              (,(first stores) (+ ,get ,delta)))
         ,set
         ,old))))

(let ((list (list 1 2 3))
      (i 0))
  (let ((old (plusplus2 (nth (incf i) list) 3)))
    (values old i list)))
;; => 2, 1, (1, 5, 3)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; PLUSPLUS3
;;;
;;; More fun! A version that uses my PLACE-ONLY.

(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)))))

;;; A version of ONCE-ONLY for places, building on the crazily fun PLACE-UTILS
;;; library.

(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)))))

;;; The definition is now trivial and resembles the definition of a "normal"
;;; macro trying to avoid multiple evaluation!

(defmacro plusplus3 (place delta)
  (place-only (place)
    `(prog1 ,place
       (incf ,place ,delta))))

(let ((list (list 1 2 3))
      (i 0))
  (let ((old (plusplus3 (nth (incf i) list) 3)))
    (values old i list)))
;; => 2, 1, (1, 5, 3)