+;; Generalized variables are provided by gv.el, but some details are
+;; not 100% compatible: not worth the trouble to add them to cl-lib.el, but we
+;; still need to support old users of cl.el.
+
+(defun cl--gv-adapt (cl-gv do)
+ ;; This function is used by all .elc files that use define-setf-expander and
+ ;; were compiled with Emacs>=24.3.
+ (let ((vars (nth 0 cl-gv))
+ (vals (nth 1 cl-gv))
+ (binds ())
+ (substs ()))
+ ;; Use cl-sublis as was done in cl-setf-do-modify.
+ (while vars
+ (if (macroexp-copyable-p (car vals))
+ (push (cons (pop vars) (pop vals)) substs)
+ (push (list (pop vars) (pop vals)) binds)))
+ (macroexp-let*
+ binds
+ (funcall do (cl-sublis substs (nth 4 cl-gv))
+ ;; We'd like to do something like
+ ;; (lambda ,(nth 2 cl-gv) ,(nth 3 cl-gv)).
+ (lambda (exp)
+ (macroexp-let2 macroexp-copyable-p v exp
+ (cl-sublis (cons (cons (car (nth 2 cl-gv)) v)
+ substs)
+ (nth 3 cl-gv))))))))
+
+(defmacro define-setf-expander (name arglist &rest body)
+ "Define a `setf' method.
+This method shows how to handle `setf's to places of the form
+\(NAME ARGS...). The argument forms ARGS are bound according to
+ARGLIST, as if NAME were going to be expanded as a macro, then
+the BODY forms are executed and must return a list of five elements:
+a temporary-variables list, a value-forms list, a store-variables list
+\(of length one), a store-form, and an access- form.
+
+See `gv-define-expander', and `gv-define-setter' for better and
+simpler ways to define setf-methods."
+ (declare (debug
+ (&define name cl-lambda-list cl-declarations-or-string def-body)))
+ `(progn
+ ,@(if (stringp (car body))
+ (list `(put ',name 'setf-documentation ,(pop body))))
+ (gv-define-expander ,name
+ (cl-function
+ (lambda (do ,@arglist)
+ (cl--gv-adapt (progn ,@body) do))))))
+
+(defmacro defsetf (name arg1 &rest args)
+ "Define a `setf' method.
+This macro is an easy-to-use substitute for `define-setf-expander'
+that works well for simple place forms.
+
+In the simple `defsetf' form, `setf's of the form (setf (NAME
+ARGS...) VAL) are transformed to function or macro calls of the
+form (FUNC ARGS... VAL). For example:
+
+ (defsetf aref aset)
+
+You can replace this form with `gv-define-simple-setter'.
+
+Alternate form: (defsetf NAME ARGLIST (STORE) BODY...).
+
+Here, the above `setf' call is expanded by binding the argument
+forms ARGS according to ARGLIST, binding the value form VAL to
+STORE, then executing BODY, which must return a Lisp form that
+does the necessary `setf' operation. Actually, ARGLIST and STORE
+may be bound to temporary variables which are introduced
+automatically to preserve proper execution order of the arguments.
+For example:
+
+ (defsetf nth (n x) (v) `(setcar (nthcdr ,n ,x) ,v))
+
+You can replace this form with `gv-define-setter'.
+
+\(fn NAME [FUNC | ARGLIST (STORE) BODY...])"
+ (declare (debug
+ (&define name
+ [&or [symbolp &optional stringp]
+ [cl-lambda-list (symbolp)]]
+ cl-declarations-or-string def-body)))
+ (if (and (listp arg1) (consp args))
+ ;; Like `gv-define-setter' but with `cl-function'.
+ `(gv-define-expander ,name
+ (lambda (do &rest args)
+ (gv--defsetter ',name
+ (cl-function
+ (lambda (,@(car args) ,@arg1) ,@(cdr args)))
+ do args)))
+ `(gv-define-simple-setter ,name ,arg1 ,(car args))))
+
+;; FIXME: CL used to provide a setf method for `apply', but I haven't been able
+;; to find a case where it worked. The code below tries to handle it as well.
+;; (defun cl--setf-apply (form last-witness last)
+;; (cond
+;; ((not (consp form)) form)
+;; ((eq (ignore-errors (car (last form))) last-witness)
+;; `(apply #',(car form) ,@(butlast (cdr form)) ,last))
+;; ((and (memq (car form) '(let let*))
+;; (rassoc (list last-witness) (cadr form)))
+;; (let ((rebind (rassoc (list last-witness) (cadr form))))
+;; `(,(car form) ,(remq rebind (cadr form))
+;; ,@(mapcar (lambda (form) (cl--setf-apply form (car rebind) last))
+;; (cddr form)))))
+;; (t (mapcar (lambda (form) (cl--setf-apply form last-witness last)) form))))
+;; (gv-define-setter apply (val fun &rest args)
+;; (pcase fun (`#',(and (pred symbolp) f) (setq fun f))
+;; (_ (error "First arg to apply in setf is not #'SYM: %S" fun)))
+;; (let* ((butlast (butlast args))
+;; (last (car (last args)))
+;; (last-witness (make-symbol "--cl-tailarg--"))
+;; (setter (macroexpand `(setf (,fun ,@butlast ,last-witness) ,val)
+;; macroexpand-all-environment)))
+;; (cl--setf-apply setter last-witness last)))
+
+
+;; FIXME: CL used to provide get-setf-method, which was used by some
+;; setf-expanders, but now that we use gv.el, it is a lot more difficult
+;; and in general impossible to provide get-setf-method. Hopefully, it
+;; won't be needed. If needed, we'll have to do something nasty along the
+;; lines of
+;; (defun get-setf-method (place &optional env)
+;; (let* ((witness (list 'cl-gsm))
+;; (expansion (gv-letplace (getter setter) place
+;; `(,witness ,getter ,(funcall setter witness)))))
+;; ...find "let prefix" of expansion, extract getter and setter from
+;; ...the rest, and build the 5-tuple))
+(make-obsolete 'get-setf-method 'gv-letplace "24.3")
+
+(defmacro define-modify-macro (name arglist func &optional doc)
+ "Define a `setf'-like modify macro.
+If NAME is called, it combines its PLACE argument with the other
+arguments from ARGLIST using FUNC. For example:
+
+ (define-modify-macro incf (&optional (n 1)) +)
+
+You can replace this macro with `gv-letplace'."
+ (declare (debug
+ (&define name cl-lambda-list ;; should exclude &key
+ symbolp &optional stringp)))
+ (if (memq '&key arglist)
+ (error "&key not allowed in define-modify-macro"))
+ (let ((place (make-symbol "--cl-place--")))
+ `(cl-defmacro ,name (,place ,@arglist)
+ ,doc
+ (,(if (memq '&rest arglist) #'cl-list* #'list)
+ #'cl-callf ',func ,place
+ ,@(cl--arglist-args arglist)))))
+
+;;; Additional compatibility code.