X-Git-Url: http://git.hcoop.net/bpt/emacs.git/blobdiff_plain/ac1a0ce1c6ba60a3faddc64463cb7a697b9d8fd2..1088b9226e7dac7314dab52ef0696a5f540900cd:/lisp/emacs-lisp/cl-macs.el

diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index 375a974db8..9a59aa0c6d 100644
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -45,6 +45,8 @@
 
 (require 'cl-lib)
 (require 'macroexp)
+;; `gv' is required here because cl-macs can be loaded before loaddefs.el.
+(require 'gv)
 
 (defmacro cl-pop2 (place)
   (declare (debug edebug-sexps))
@@ -108,20 +110,6 @@
 (defun cl--const-expr-val (x)
   (and (macroexp-const-p x) (if (consp x) (nth 1 x) x)))
 
-(defun cl-expr-access-order (x v)
-  ;; This apparently tries to return nil iff the expression X evaluates
-  ;; the variables V in the same order as they appear in V (so as to
-  ;; be able to replace those vars with the expressions they're bound
-  ;; to).
-  ;; FIXME: This is very naive, it doesn't even check to see if those
-  ;; variables appear more than once.
-  (if (macroexp-const-p x) v
-    (if (consp x)
-	(progn
-	  (while (setq x (cdr x)) (setq v (cl-expr-access-order (car x) v)))
-	  v)
-      (if (eq x (car v)) (cdr v) '(t)))))
-
 (defun cl--expr-contains (x y)
   "Count number of times X refers to Y.  Return nil for 0 times."
   ;; FIXME: This is naive, and it will cl-count Y as referred twice in
@@ -262,7 +250,7 @@ and BODY is implicitly surrounded by (cl-block NAME ...).
 \(fn NAME ARGLIST [DOCSTRING] BODY...)"
   (declare (debug
             ;; Same as defun but use cl-lambda-list.
-            (&define [&or name ("cl-setf" :name cl-setf name)]
+            (&define [&or name ("setf" :name setf name)]
                      cl-lambda-list
                      cl-declarations-or-string
                      [&optional ("interactive" interactive)]
@@ -362,28 +350,36 @@ its argument list allows full Common Lisp conventions."
    (t x)))
 
 (defun cl--make-usage-args (arglist)
-  ;; `orig-args' can contain &cl-defs (an internal
-  ;; CL thingy I don't understand), so remove it.
-  (let ((x (memq '&cl-defs arglist)))
-    (when x (setq arglist (delq (car x) (remq (cadr x) arglist)))))
-  (let ((state nil))
-    (mapcar (lambda (x)
-              (cond
-               ((symbolp x)
-                (if (eq ?\& (aref (symbol-name x) 0))
-                    (setq state x)
-                  (make-symbol (upcase (symbol-name x)))))
-               ((not (consp x)) x)
-               ((memq state '(nil &rest)) (cl--make-usage-args x))
-               (t        ;(VAR INITFORM SVAR) or ((KEYWORD VAR) INITFORM SVAR).
-                (cl-list*
-                 (if (and (consp (car x)) (eq state '&key))
-                     (list (caar x) (cl--make-usage-var (nth 1 (car x))))
-                   (cl--make-usage-var (car x)))
-                 (nth 1 x)                          ;INITFORM.
-                 (cl--make-usage-args (nthcdr 2 x)) ;SVAR.
-                 ))))
-            arglist)))
+  (if (cdr-safe (last arglist))         ;Not a proper list.
+      (let* ((last (last arglist))
+             (tail (cdr last)))
+        (unwind-protect
+            (progn
+              (setcdr last nil)
+              (nconc (cl--make-usage-args arglist) (cl--make-usage-var tail)))
+          (setcdr last tail)))
+    ;; `orig-args' can contain &cl-defs (an internal
+    ;; CL thingy I don't understand), so remove it.
+    (let ((x (memq '&cl-defs arglist)))
+      (when x (setq arglist (delq (car x) (remq (cadr x) arglist)))))
+    (let ((state nil))
+      (mapcar (lambda (x)
+                (cond
+                 ((symbolp x)
+                  (if (eq ?\& (aref (symbol-name x) 0))
+                      (setq state x)
+                    (make-symbol (upcase (symbol-name x)))))
+                 ((not (consp x)) x)
+                 ((memq state '(nil &rest)) (cl--make-usage-args x))
+                 (t      ;(VAR INITFORM SVAR) or ((KEYWORD VAR) INITFORM SVAR).
+                  (cl-list*
+                   (if (and (consp (car x)) (eq state '&key))
+                       (list (caar x) (cl--make-usage-var (nth 1 (car x))))
+                     (cl--make-usage-var (car x)))
+                   (nth 1 x)                        ;INITFORM.
+                   (cl--make-usage-args (nthcdr 2 x)) ;SVAR.
+                   ))))
+              arglist))))
 
 (defun cl--do-arglist (args expr &optional num)   ; uses bind-*
   (if (nlistp args)
@@ -628,7 +624,7 @@ Key values are compared by `eql'.
 
 ;;;###autoload
 (defmacro cl-ecase (expr &rest clauses)
-  "Like `cl-case', but error if no cl-case fits.
+  "Like `cl-case', but error if no case fits.
 `otherwise'-clauses are not allowed.
 \n(fn EXPR (KEYLIST BODY...)...)"
   (declare (indent 1) (debug cl-case))
@@ -735,7 +731,21 @@ Valid clauses are:
   finally return EXPR, named NAME.
 
 \(fn CLAUSE...)"
-  (declare (debug (&rest &or symbolp form)))
+  (declare (debug (&rest &or
+                         ;; These are usually followed by a symbol, but it can
+                         ;; actually be any destructuring-bind pattern, which
+                         ;; would erroneously match `form'.
+                         [[&or "for" "as" "with" "and"] sexp]
+                         ;; These are followed by expressions which could
+                         ;; erroneously match `symbolp'.
+                         [[&or "from" "upfrom" "downfrom" "to" "upto" "downto"
+                               "above" "below" "by" "in" "on" "=" "across"
+                               "repeat" "while" "until" "always" "never"
+                               "thereis" "collect" "append" "nconc" "sum"
+                               "count" "maximize" "minimize" "if" "unless"
+                               "return"] form]
+                         ;; Simple default, which covers 99% of the cases.
+                         symbolp form)))
   (if (not (memq t (mapcar 'symbolp (delq nil (delq t (cl-copy-list loop-args))))))
       `(cl-block nil (while t ,@loop-args))
     (let ((cl--loop-args loop-args) (cl--loop-name nil) (cl--loop-bindings nil)
@@ -1486,31 +1496,11 @@ Then evaluate RESULT to get return value, default nil.
 An implicit nil block is established around the loop.
 
 \(fn (VAR LIST [RESULT]) BODY...)"
-  (declare (debug ((symbolp form &optional form) cl-declarations body)))
-  (let ((temp (make-symbol "--cl-dolist-temp--")))
-    ;; FIXME: Copy&pasted from subr.el.
-    `(cl-block nil
-       ;; This is not a reliable test, but it does not matter because both
-       ;; semantics are acceptable, tho one is slightly faster with dynamic
-       ;; scoping and the other is slightly faster (and has cleaner semantics)
-       ;; with lexical scoping.
-       ,(if lexical-binding
-            `(let ((,temp ,(nth 1 spec)))
-               (while ,temp
-                 (let ((,(car spec) (car ,temp)))
-                   ,@body
-                   (setq ,temp (cdr ,temp))))
-               ,@(if (cdr (cdr spec))
-                     ;; FIXME: This let often leads to "unused var" warnings.
-                     `((let ((,(car spec) nil)) ,@(cdr (cdr spec))))))
-          `(let ((,temp ,(nth 1 spec))
-                 ,(car spec))
-             (while ,temp
-               (setq ,(car spec) (car ,temp))
-               ,@body
-               (setq ,temp (cdr ,temp)))
-             ,@(if (cdr (cdr spec))
-                   `((setq ,(car spec) nil) ,@(cddr spec))))))))
+  (declare (debug ((symbolp form &optional form) cl-declarations body))
+           (indent 1))
+  `(cl-block nil
+     (,(if (eq 'cl-dolist (symbol-function 'dolist)) 'cl--dolist 'dolist)
+      ,spec ,@body)))
 
 ;;;###autoload
 (defmacro cl-dotimes (spec &rest body)
@@ -1520,31 +1510,10 @@ to COUNT, exclusive.  Then evaluate RESULT to get return value, default
 nil.
 
 \(fn (VAR COUNT [RESULT]) BODY...)"
-  (declare (debug cl-dolist))
-  (let ((temp (make-symbol "--cl-dotimes-temp--"))
-	(end (nth 1 spec)))
-    ;; FIXME: Copy&pasted from subr.el.
-    `(cl-block nil
-       ;; This is not a reliable test, but it does not matter because both
-       ;; semantics are acceptable, tho one is slightly faster with dynamic
-       ;; scoping and the other has cleaner semantics.
-       ,(if lexical-binding
-            (let ((counter '--dotimes-counter--))
-              `(let ((,temp ,end)
-                     (,counter 0))
-                 (while (< ,counter ,temp)
-                   (let ((,(car spec) ,counter))
-                     ,@body)
-                   (setq ,counter (1+ ,counter)))
-                 ,@(if (cddr spec)
-                       ;; FIXME: This let often leads to "unused var" warnings.
-                       `((let ((,(car spec) ,counter)) ,@(cddr spec))))))
-          `(let ((,temp ,end)
-                 (,(car spec) 0))
-             (while (< ,(car spec) ,temp)
-               ,@body
-               (cl-incf ,(car spec)))
-             ,@(cdr (cdr spec)))))))
+  (declare (debug cl-dolist) (indent 1))
+  `(cl-block nil
+     (,(if (eq 'cl-dotimes (symbol-function 'dotimes)) 'cl--dotimes 'dotimes)
+      ,spec ,@body)))
 
 ;;;###autoload
 (defmacro cl-do-symbols (spec &rest body)
@@ -1592,10 +1561,19 @@ second list (or made unbound if VALUES is shorter than SYMBOLS); then the
 BODY forms are executed and their result is returned.  This is much like
 a `let' form, except that the list of symbols can be computed at run-time."
   (declare (indent 2) (debug (form form body)))
-  `(let ((cl--progv-save nil))
-     (unwind-protect
-         (progn (cl--progv-before ,symbols ,values) ,@body)
-       (cl--progv-after))))
+  (let ((bodyfun (make-symbol "cl--progv-body"))
+        (binds (make-symbol "binds"))
+        (syms (make-symbol "syms"))
+        (vals (make-symbol "vals")))
+    `(progn
+       (defvar ,bodyfun)
+       (let* ((,syms ,symbols)
+              (,vals ,values)
+              (,bodyfun (lambda () ,@body))
+              (,binds ()))
+         (while ,syms
+           (push (list (pop ,syms) (list 'quote (pop ,vals))) ,binds))
+         (eval (list 'let ,binds '(funcall ,bodyfun)))))))
 
 (defvar cl--labels-convert-cache nil)
 
@@ -1616,7 +1594,6 @@ a `let' form, except that the list of symbols can be computed at run-time."
           (setq cl--labels-convert-cache (cons f res))
           res))))))
 
-;;; This should really have some way to shadow 'byte-compile properties, etc.
 ;;;###autoload
 (defmacro cl-flet (bindings &rest body)
   "Make temporary function definitions.
@@ -1641,10 +1618,23 @@ Like `cl-labels' but the definitions are not recursive.
            (if (assq 'function newenv) newenv
              (cons (cons 'function #'cl--labels-convert) newenv)))))))
 
+;;;###autoload
+(defmacro cl-flet* (bindings &rest body)
+  "Make temporary function definitions.
+Like `cl-flet' but the definitions can refer to previous ones.
+
+\(fn ((FUNC ARGLIST BODY...) ...) FORM...)"
+  (declare (indent 1) (debug cl-flet))
+  (cond
+   ((null bindings) (macroexp-progn body))
+   ((null (cdr bindings)) `(cl-flet ,bindings ,@body))
+   (t `(cl-flet (,(pop bindings)) (cl-flet* ,bindings ,@body)))))
+
 ;;;###autoload
 (defmacro cl-labels (bindings &rest body)
   "Make temporary function bindings.
-The bindings can be recursive.  Assumes the use of `lexical-binding'.
+The bindings can be recursive and the scoping is lexical, but capturing them
+in closures will only work if `lexical-binding' is in use.
 
 \(fn ((FUNC ARGLIST BODY...) ...) FORM...)"
   (declare (indent 1) (debug cl-flet))
@@ -1692,43 +1682,98 @@ This is like `cl-flet', but for macros instead of functions.
       cl--old-macroexpand
     (symbol-function 'macroexpand)))
 
-(defun cl--sm-macroexpand (cl-macro &optional cl-env)
+(defun cl--sm-macroexpand (exp &optional env)
   "Special macro expander used inside `cl-symbol-macrolet'.
 This function replaces `macroexpand' during macro expansion
 of `cl-symbol-macrolet', and does the same thing as `macroexpand'
 except that it additionally expands symbol macros."
-  (let ((macroexpand-all-environment cl-env))
+  (let ((macroexpand-all-environment env))
     (while
         (progn
-          (setq cl-macro (funcall cl--old-macroexpand cl-macro cl-env))
-          (cond
-           ((symbolp cl-macro)
-            ;; Perform symbol-macro expansion.
-            (when (cdr (assq (symbol-name cl-macro) cl-env))
-              (setq cl-macro (cadr (assq (symbol-name cl-macro) cl-env)))))
-           ((eq 'setq (car-safe cl-macro))
-            ;; Convert setq to cl-setf if required by symbol-macro expansion.
-            (let* ((args (mapcar (lambda (f) (cl--sm-macroexpand f cl-env))
-                                 (cdr cl-macro)))
-                   (p args))
-              (while (and p (symbolp (car p))) (setq p (cddr p)))
-              (if p (setq cl-macro (cons 'cl-setf args))
-                (setq cl-macro (cons 'setq args))
-                ;; Don't loop further.
-                nil))))))
-    cl-macro))
+          (setq exp (funcall cl--old-macroexpand exp env))
+          (pcase exp
+            ((pred symbolp)
+             ;; Perform symbol-macro expansion.
+             (when (cdr (assq (symbol-name exp) env))
+               (setq exp (cadr (assq (symbol-name exp) env)))))
+            (`(setq . ,_)
+             ;; Convert setq to setf if required by symbol-macro expansion.
+             (let* ((args (mapcar (lambda (f) (cl--sm-macroexpand f env))
+                                  (cdr exp)))
+                    (p args))
+               (while (and p (symbolp (car p))) (setq p (cddr p)))
+               (if p (setq exp (cons 'setf args))
+                 (setq exp (cons 'setq args))
+                 ;; Don't loop further.
+                 nil)))
+            (`(,(or `let `let*) . ,(or `(,bindings . ,body) dontcare))
+             ;; CL's symbol-macrolet treats re-bindings as candidates for
+             ;; expansion (turning the let into a letf if needed), contrary to
+             ;; Common-Lisp where such re-bindings hide the symbol-macro.
+             (let ((letf nil) (found nil) (nbs ()))
+               (dolist (binding bindings)
+                 (let* ((var (if (symbolp binding) binding (car binding)))
+                        (sm (assq (symbol-name var) env)))
+                   (push (if (not (cdr sm))
+                             binding
+                           (let ((nexp (cadr sm)))
+                             (setq found t)
+                             (unless (symbolp nexp) (setq letf t))
+                             (cons nexp (cdr-safe binding))))
+                         nbs)))
+               (when found
+                 (setq exp `(,(if letf
+                                  (if (eq (car exp) 'let) 'cl-letf 'cl-letf*)
+                                (car exp))
+                             ,(nreverse nbs)
+                             ,@body)))))
+            ;; FIXME: The behavior of CL made sense in a dynamically scoped
+            ;; language, but for lexical scoping, Common-Lisp's behavior might
+            ;; make more sense (and indeed, CL behaves like Common-Lisp w.r.t
+            ;; lexical-let), so maybe we should adjust the behavior based on
+            ;; the use of lexical-binding.
+            ;; (`(,(or `let `let*) . ,(or `(,bindings . ,body) dontcare))
+            ;;  (let ((nbs ()) (found nil))
+            ;;    (dolist (binding bindings)
+            ;;      (let* ((var (if (symbolp binding) binding (car binding)))
+            ;;             (name (symbol-name var))
+            ;;             (val (and found (consp binding) (eq 'let* (car exp))
+            ;;                       (list (macroexpand-all (cadr binding)
+            ;;                                              env)))))
+            ;;        (push (if (assq name env)
+            ;;                  ;; This binding should hide its symbol-macro,
+            ;;                  ;; but given the way macroexpand-all works, we
+            ;;                  ;; can't prevent application of `env' to the
+            ;;                  ;; sub-expressions, so we need to α-rename this
+            ;;                  ;; variable instead.
+            ;;                  (let ((nvar (make-symbol
+            ;;                               (copy-sequence name))))
+            ;;                    (setq found t)
+            ;;                    (push (list name nvar) env)
+            ;;                    (cons nvar (or val (cdr-safe binding))))
+            ;;                (if val (cons var val) binding))
+            ;;              nbs)))
+            ;;    (when found
+            ;;      (setq exp `(,(car exp)
+            ;;                  ,(nreverse nbs)
+            ;;                  ,@(macroexp-unprogn
+            ;;                     (macroexpand-all (macroexp-progn body)
+            ;;                                      env)))))
+            ;;    nil))
+            )))
+    exp))
 
 ;;;###autoload
 (defmacro cl-symbol-macrolet (bindings &rest body)
   "Make symbol macro definitions.
 Within the body FORMs, references to the variable NAME will be replaced
-by EXPANSION, and (setq NAME ...) will act like (cl-setf EXPANSION ...).
+by EXPANSION, and (setq NAME ...) will act like (setf EXPANSION ...).
 
 \(fn ((NAME EXPANSION) ...) FORM...)"
   (declare (indent 1) (debug ((&rest (symbol sexp)) cl-declarations body)))
   (cond
    ((cdr bindings)
-      `(cl-symbol-macrolet (,(car bindings))
+    `(cl-symbol-macrolet (,(car bindings))
        (cl-symbol-macrolet ,(cdr bindings) ,@body)))
    ((null bindings) (macroexp-progn body))
    (t
@@ -1738,8 +1783,8 @@ by EXPANSION, and (setq NAME ...) will act like (cl-setf EXPANSION ...).
             (fset 'macroexpand #'cl--sm-macroexpand)
             ;; FIXME: For N bindings, this will traverse `body' N times!
             (macroexpand-all (cons 'progn body)
-			  (cons (list (symbol-name (caar bindings))
-				      (cl-cadar bindings))
+                             (cons (list (symbol-name (caar bindings))
+                                         (cl-cadar bindings))
                                    macroexpand-all-environment)))
         (fset 'macroexpand previous-macroexpand))))))
 
@@ -1862,408 +1907,18 @@ See Info node `(cl)Declarations' for details."
 
 
 
-;;; Generalized variables.
-
-;;;###autoload
-(defmacro cl-define-setf-expander (func args &rest body)
-  "Define a `cl-setf' method.
-This method shows how to handle `cl-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 `cl-defsetf' for a simpler way to define most setf-methods.
-
-\(fn NAME ARGLIST BODY...)"
-  (declare (debug
-            (&define name cl-lambda-list cl-declarations-or-string def-body)))
-  `(cl-eval-when (compile load eval)
-     ,@(if (stringp (car body))
-           (list `(put ',func 'setf-documentation ,(pop body))))
-     (put ',func 'setf-method (cl-function (lambda ,args ,@body)))))
-
-;;;###autoload
-(defmacro cl-defsetf (func arg1 &rest args)
-  "Define a `cl-setf' method.
-This macro is an easy-to-use substitute for `cl-define-setf-expander' that works
-well for simple place forms.  In the simple `cl-defsetf' form, `cl-setf's of
-the form (cl-setf (NAME ARGS...) VAL) are transformed to function or macro
-calls of the form (FUNC ARGS... VAL).  Example:
-
-  (cl-defsetf aref aset)
-
-Alternate form: (cl-defsetf NAME ARGLIST (STORE) BODY...).
-Here, the above `cl-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 `cl-setf' operation.
-Actually, ARGLIST and STORE may be bound to temporary variables which are
-introduced automatically to preserve proper execution order of the arguments.
-Example:
-
-  (cl-defsetf nth (n x) (v) `(setcar (nthcdr ,n ,x) ,v))
-
-\(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))
-      (let* ((largs nil) (largsr nil)
-	     (temps nil) (tempsr nil)
-	     (restarg nil) (rest-temps nil)
-	     (store-var (car (prog1 (car args) (setq args (cdr args)))))
-	     (store-temp (intern (format "--%s--temp--" store-var)))
-	     (lets1 nil) (lets2 nil)
-	     (docstr nil) (p arg1))
-	(if (stringp (car args))
-	    (setq docstr (prog1 (car args) (setq args (cdr args)))))
-	(while (and p (not (eq (car p) '&aux)))
-	  (if (eq (car p) '&rest)
-	      (setq p (cdr p) restarg (car p))
-	    (or (memq (car p) '(&optional &key &allow-other-keys))
-		(setq largs (cons (if (consp (car p)) (car (car p)) (car p))
-				  largs)
-		      temps (cons (intern (format "--%s--temp--" (car largs)))
-				  temps))))
-	  (setq p (cdr p)))
-	(setq largs (nreverse largs) temps (nreverse temps))
-	(if restarg
-	    (setq largsr (append largs (list restarg))
-		  rest-temps (intern (format "--%s--temp--" restarg))
-		  tempsr (append temps (list rest-temps)))
-	  (setq largsr largs tempsr temps))
-	(let ((p1 largs) (p2 temps))
-	  (while p1
-	    (setq lets1 (cons `(,(car p2)
-				(make-symbol ,(format "--cl-%s--" (car p1))))
-			      lets1)
-		  lets2 (cons (list (car p1) (car p2)) lets2)
-		  p1 (cdr p1) p2 (cdr p2))))
-	(if restarg (setq lets2 (cons (list restarg rest-temps) lets2)))
-	`(cl-define-setf-expander ,func ,arg1
-	   ,@(and docstr (list docstr))
-	   (let*
-	       ,(nreverse
-		 (cons `(,store-temp
-			 (make-symbol ,(format "--cl-%s--" store-var)))
-		       (if restarg
-			   `((,rest-temps
-			      (mapcar (lambda (_) (make-symbol "--cl-var--"))
-				      ,restarg))
-			     ,@lets1)
-			 lets1)))
-	     (list			; 'values
-	      (,(if restarg 'cl-list* 'list) ,@tempsr)
-	      (,(if restarg 'cl-list* 'list) ,@largsr)
-	      (list ,store-temp)
-	      (let*
-		  ,(nreverse
-		    (cons (list store-var store-temp)
-			  lets2))
-		,@args)
-	      (,(if restarg 'cl-list* 'list)
-	       ,@(cons `',func tempsr))))))
-    `(cl-defsetf ,func (&rest args) (store)
-       ,(let ((call `(cons ',arg1
-			   (append args (list store)))))
-	  (if (car args)
-	      `(list 'progn ,call store)
-	    call)))))
-
-;;; Some standard place types from Common Lisp.
-(cl-defsetf aref aset)
-(cl-defsetf car setcar)
-(cl-defsetf cdr setcdr)
-(cl-defsetf caar (x) (val) `(setcar (car ,x) ,val))
-(cl-defsetf cadr (x) (val) `(setcar (cdr ,x) ,val))
-(cl-defsetf cdar (x) (val) `(setcdr (car ,x) ,val))
-(cl-defsetf cddr (x) (val) `(setcdr (cdr ,x) ,val))
-(cl-defsetf elt (seq n) (store)
-  `(if (listp ,seq) (setcar (nthcdr ,n ,seq) ,store)
-     (aset ,seq ,n ,store)))
-(cl-defsetf get put)
-(cl-defsetf cl-get (x y &optional d) (store) `(put ,x ,y ,store))
-(cl-defsetf gethash (x h &optional d) (store) `(puthash ,x ,store ,h))
-(cl-defsetf nth (n x) (store) `(setcar (nthcdr ,n ,x) ,store))
-(cl-defsetf cl-subseq (seq start &optional end) (new)
-  `(progn (cl-replace ,seq ,new :start1 ,start :end1 ,end) ,new))
-(cl-defsetf symbol-function fset)
-(cl-defsetf symbol-plist setplist)
-(cl-defsetf symbol-value set)
-
-;;; Various car/cdr aliases.  Note that `cadr' is handled specially.
-(cl-defsetf cl-first setcar)
-(cl-defsetf cl-second (x) (store) `(setcar (cdr ,x) ,store))
-(cl-defsetf cl-third (x) (store) `(setcar (cddr ,x) ,store))
-(cl-defsetf cl-fourth (x) (store) `(setcar (cl-cdddr ,x) ,store))
-(cl-defsetf cl-fifth (x) (store) `(setcar (nthcdr 4 ,x) ,store))
-(cl-defsetf cl-sixth (x) (store) `(setcar (nthcdr 5 ,x) ,store))
-(cl-defsetf cl-seventh (x) (store) `(setcar (nthcdr 6 ,x) ,store))
-(cl-defsetf cl-eighth (x) (store) `(setcar (nthcdr 7 ,x) ,store))
-(cl-defsetf cl-ninth (x) (store) `(setcar (nthcdr 8 ,x) ,store))
-(cl-defsetf cl-tenth (x) (store) `(setcar (nthcdr 9 ,x) ,store))
-(cl-defsetf cl-rest setcdr)
-
-;;; Some more Emacs-related place types.
-(cl-defsetf buffer-file-name set-visited-file-name t)
-(cl-defsetf buffer-modified-p (&optional buf) (flag)
-  `(with-current-buffer ,buf
-     (set-buffer-modified-p ,flag)))
-(cl-defsetf buffer-name rename-buffer t)
-(cl-defsetf buffer-string () (store)
-  `(progn (erase-buffer) (insert ,store)))
-(cl-defsetf buffer-substring cl--set-buffer-substring)
-(cl-defsetf current-buffer set-buffer)
-(cl-defsetf current-case-table set-case-table)
-(cl-defsetf current-column move-to-column t)
-(cl-defsetf current-global-map use-global-map t)
-(cl-defsetf current-input-mode () (store)
-  `(progn (apply #'set-input-mode ,store) ,store))
-(cl-defsetf current-local-map use-local-map t)
-(cl-defsetf current-window-configuration set-window-configuration t)
-(cl-defsetf default-file-modes set-default-file-modes t)
-(cl-defsetf default-value set-default)
-(cl-defsetf documentation-property put)
-(cl-defsetf face-background (f &optional s) (x) `(set-face-background ,f ,x ,s))
-(cl-defsetf face-background-pixmap (f &optional s) (x)
-  `(set-face-background-pixmap ,f ,x ,s))
-(cl-defsetf face-font (f &optional s) (x) `(set-face-font ,f ,x ,s))
-(cl-defsetf face-foreground (f &optional s) (x) `(set-face-foreground ,f ,x ,s))
-(cl-defsetf face-underline-p (f &optional s) (x)
-  `(set-face-underline-p ,f ,x ,s))
-(cl-defsetf file-modes set-file-modes t)
-(cl-defsetf frame-height set-screen-height t)
-(cl-defsetf frame-parameters modify-frame-parameters t)
-(cl-defsetf frame-visible-p cl--set-frame-visible-p)
-(cl-defsetf frame-width set-screen-width t)
-(cl-defsetf frame-parameter set-frame-parameter t)
-(cl-defsetf terminal-parameter set-terminal-parameter)
-(cl-defsetf getenv setenv t)
-(cl-defsetf get-register set-register)
-(cl-defsetf global-key-binding global-set-key)
-(cl-defsetf keymap-parent set-keymap-parent)
-(cl-defsetf local-key-binding local-set-key)
-(cl-defsetf mark set-mark t)
-(cl-defsetf mark-marker set-mark t)
-(cl-defsetf marker-position set-marker t)
-(cl-defsetf match-data set-match-data t)
-(cl-defsetf mouse-position (scr) (store)
-  `(set-mouse-position ,scr (car ,store) (cadr ,store)
-                      (cddr ,store)))
-(cl-defsetf overlay-get overlay-put)
-(cl-defsetf overlay-start (ov) (store)
-  `(progn (move-overlay ,ov ,store (overlay-end ,ov)) ,store))
-(cl-defsetf overlay-end (ov) (store)
-  `(progn (move-overlay ,ov (overlay-start ,ov) ,store) ,store))
-(cl-defsetf point goto-char)
-(cl-defsetf point-marker goto-char t)
-(cl-defsetf point-max () (store)
-  `(progn (narrow-to-region (point-min) ,store) ,store))
-(cl-defsetf point-min () (store)
-  `(progn (narrow-to-region ,store (point-max)) ,store))
-(cl-defsetf process-buffer set-process-buffer)
-(cl-defsetf process-filter set-process-filter)
-(cl-defsetf process-sentinel set-process-sentinel)
-(cl-defsetf process-get process-put)
-(cl-defsetf read-mouse-position (scr) (store)
-  `(set-mouse-position ,scr (car ,store) (cdr ,store)))
-(cl-defsetf screen-height set-screen-height t)
-(cl-defsetf screen-width set-screen-width t)
-(cl-defsetf selected-window select-window)
-(cl-defsetf selected-screen select-screen)
-(cl-defsetf selected-frame select-frame)
-(cl-defsetf standard-case-table set-standard-case-table)
-(cl-defsetf syntax-table set-syntax-table)
-(cl-defsetf visited-file-modtime set-visited-file-modtime t)
-(cl-defsetf window-buffer set-window-buffer t)
-(cl-defsetf window-display-table set-window-display-table t)
-(cl-defsetf window-dedicated-p set-window-dedicated-p t)
-(cl-defsetf window-height () (store)
-  `(progn (enlarge-window (- ,store (window-height))) ,store))
-(cl-defsetf window-hscroll set-window-hscroll)
-(cl-defsetf window-parameter set-window-parameter)
-(cl-defsetf window-point set-window-point)
-(cl-defsetf window-start set-window-start)
-(cl-defsetf window-width () (store)
-  `(progn (enlarge-window (- ,store (window-width)) t) ,store))
-(cl-defsetf x-get-secondary-selection x-own-secondary-selection t)
-(cl-defsetf x-get-selection x-own-selection t)
-
-;; This is a hack that allows (cl-setf (eq a 7) B) to mean either
-;; (setq a 7) or (setq a nil) depending on whether B is nil or not.
-;; This is useful when you have control over the PLACE but not over
-;; the VALUE, as is the case in define-minor-mode's :variable.
-(cl-define-setf-expander eq (place val)
-  (let ((method (cl-get-setf-method place macroexpand-all-environment))
-        (val-temp (make-symbol "--eq-val--"))
-        (store-temp (make-symbol "--eq-store--")))
-    (list (append (nth 0 method) (list val-temp))
-          (append (nth 1 method) (list val))
-          (list store-temp)
-          `(let ((,(car (nth 2 method))
-                  (if ,store-temp ,val-temp (not ,val-temp))))
-             ,(nth 3 method) ,store-temp)
-          `(eq ,(nth 4 method) ,val-temp))))
-
-;;; More complex setf-methods.
-;; These should take &environment arguments, but since full arglists aren't
-;; available while compiling cl-macs, we fake it by referring to the global
-;; variable macroexpand-all-environment directly.
-
-(cl-define-setf-expander apply (func arg1 &rest rest)
-  (or (and (memq (car-safe func) '(quote function cl-function))
-	   (symbolp (car-safe (cdr-safe func))))
-      (error "First arg to apply in cl-setf is not (function SYM): %s" func))
-  (let* ((form (cons (nth 1 func) (cons arg1 rest)))
-	 (method (cl-get-setf-method form macroexpand-all-environment)))
-    (list (car method) (nth 1 method) (nth 2 method)
-	  (cl-setf-make-apply (nth 3 method) (cadr func) (car method))
-	  (cl-setf-make-apply (nth 4 method) (cadr func) (car method)))))
-
-(defun cl-setf-make-apply (form func temps)
-  (if (eq (car form) 'progn)
-      `(progn ,(cl-setf-make-apply (cadr form) func temps) ,@(cddr form))
-    (or (equal (last form) (last temps))
-	(error "%s is not suitable for use with setf-of-apply" func))
-    `(apply ',(car form) ,@(cdr form))))
-
-(cl-define-setf-expander nthcdr (n place)
-  (let ((method (cl-get-setf-method place macroexpand-all-environment))
-	(n-temp (make-symbol "--cl-nthcdr-n--"))
-	(store-temp (make-symbol "--cl-nthcdr-store--")))
-    (list (cons n-temp (car method))
-	  (cons n (nth 1 method))
-	  (list store-temp)
-	  `(let ((,(car (nth 2 method))
-                  (cl--set-nthcdr ,n-temp ,(nth 4 method)
-                                  ,store-temp)))
-             ,(nth 3 method) ,store-temp)
-	  `(nthcdr ,n-temp ,(nth 4 method)))))
-
-(cl-define-setf-expander cl-getf (place tag &optional def)
-  (let ((method (cl-get-setf-method place macroexpand-all-environment))
-	(tag-temp (make-symbol "--cl-getf-tag--"))
-	(def-temp (make-symbol "--cl-getf-def--"))
-	(store-temp (make-symbol "--cl-getf-store--")))
-    (list (append (car method) (list tag-temp def-temp))
-	  (append (nth 1 method) (list tag def))
-	  (list store-temp)
-	  `(let ((,(car (nth 2 method))
-                  (cl--set-getf ,(nth 4 method) ,tag-temp ,store-temp)))
-             ,(nth 3 method) ,store-temp)
-	  `(cl-getf ,(nth 4 method) ,tag-temp ,def-temp))))
-
-(cl-define-setf-expander substring (place from &optional to)
-  (let ((method (cl-get-setf-method place macroexpand-all-environment))
-	(from-temp (make-symbol "--cl-substring-from--"))
-	(to-temp (make-symbol "--cl-substring-to--"))
-	(store-temp (make-symbol "--cl-substring-store--")))
-    (list (append (car method) (list from-temp to-temp))
-	  (append (nth 1 method) (list from to))
-	  (list store-temp)
-	  `(let ((,(car (nth 2 method))
-                  (cl--set-substring ,(nth 4 method)
-                                     ,from-temp ,to-temp ,store-temp)))
-             ,(nth 3 method) ,store-temp)
-	  `(substring ,(nth 4 method) ,from-temp ,to-temp))))
-
-;;; Getting and optimizing setf-methods.
-;;;###autoload
-(defun cl-get-setf-method (place &optional env)
-  "Return a list of five values describing the setf-method for PLACE.
-PLACE may be any Lisp form which can appear as the PLACE argument to
-a macro like `cl-setf' or `cl-incf'."
-  (if (symbolp place)
-      (let ((temp (make-symbol "--cl-setf--")))
-	(list nil nil (list temp) `(setq ,place ,temp) place))
-    (or (and (symbolp (car place))
-	     (let* ((func (car place))
-		    (name (symbol-name func))
-		    (method (get func 'setf-method))
-		    (case-fold-search nil))
-	       (or (and method
-			(let ((macroexpand-all-environment env))
-			  (setq method (apply method (cdr place))))
-			(if (and (consp method) (= (length method) 5))
-			    method
-			  (error "Setf-method for %s returns malformed method"
-				 func)))
-		   (and (string-match-p "\\`c[ad][ad][ad]?[ad]?r\\'" name)
-			(cl-get-setf-method (cl-compiler-macroexpand place)))
-		   (and (eq func 'edebug-after)
-			(cl-get-setf-method (nth (1- (length place)) place)
-					 env)))))
-	(if (eq place (setq place (macroexpand place env)))
-	    (if (and (symbolp (car place)) (fboundp (car place))
-		     (symbolp (symbol-function (car place))))
-		(cl-get-setf-method (cons (symbol-function (car place))
-				       (cdr place)) env)
-	      (error "No setf-method known for %s" (car place)))
-	  (cl-get-setf-method place env)))))
-
-(defun cl-setf-do-modify (place opt-expr)
-  (let* ((method (cl-get-setf-method place macroexpand-all-environment))
-	 (temps (car method)) (values (nth 1 method))
-	 (lets nil) (subs nil)
-	 (optimize (and (not (eq opt-expr 'no-opt))
-			(or (and (not (eq opt-expr 'unsafe))
-				 (cl--safe-expr-p opt-expr))
-			    (cl-setf-simple-store-p (car (nth 2 method))
-						    (nth 3 method)))))
-	 (simple (and optimize (consp place) (cl--simple-exprs-p (cdr place)))))
-    (while values
-      (if (or simple (macroexp-const-p (car values)))
-	  (push (cons (pop temps) (pop values)) subs)
-	(push (list (pop temps) (pop values)) lets)))
-    (list (nreverse lets)
-	  (cons (car (nth 2 method)) (cl-sublis subs (nth 3 method)))
-	  (cl-sublis subs (nth 4 method)))))
-
-(defun cl-setf-do-store (spec val)
-  (let ((sym (car spec))
-	(form (cdr spec)))
-    (if (or (macroexp-const-p val)
-	    (and (cl--simple-expr-p val) (eq (cl--expr-contains form sym) 1))
-	    (cl-setf-simple-store-p sym form))
-	(cl-subst val sym form)
-      `(let ((,sym ,val)) ,form))))
-
-(defun cl-setf-simple-store-p (sym form)
-  (and (consp form) (eq (cl--expr-contains form sym) 1)
-       (eq (nth (1- (length form)) form) sym)
-       (symbolp (car form)) (fboundp (car form))
-       (not (eq (car-safe (symbol-function (car form))) 'macro))))
-
 ;;; The standard modify macros.
-;;;###autoload
-(defmacro cl-setf (&rest args)
-  "Set each PLACE to the value of its VAL.
-This is a generalized version of `setq'; the PLACEs may be symbolic
-references such as (car x) or (aref x i), as well as plain symbols.
-For example, (cl-setf (cl-cadar x) y) is equivalent to (setcar (cdar x) y).
-The return value is the last VAL in the list.
 
-\(fn PLACE VAL PLACE VAL ...)"
-  (declare (debug (&rest [place form])))
-  (if (cdr (cdr args))
-      (let ((sets nil))
-	(while args (push `(cl-setf ,(pop args) ,(pop args)) sets))
-	(cons 'progn (nreverse sets)))
-    (if (symbolp (car args))
-	(and args (cons 'setq args))
-      (let* ((method (cl-setf-do-modify (car args) (nth 1 args)))
-	     (store (cl-setf-do-store (nth 1 method) (nth 1 args))))
-	(if (car method) `(let* ,(car method) ,store) store)))))
+;; `setf' is now part of core Elisp, defined in gv.el.
 
 ;;;###autoload
 (defmacro cl-psetf (&rest args)
   "Set PLACEs to the values VALs in parallel.
-This is like `cl-setf', except that all VAL forms are evaluated (in order)
+This is like `setf', except that all VAL forms are evaluated (in order)
 before assigning any PLACEs to the corresponding values.
 
 \(fn PLACE VAL PLACE VAL ...)"
-  (declare (debug cl-setf))
+  (declare (debug setf))
   (let ((p args) (simple t) (vars nil))
     (while p
       (if (or (not (symbolp (car p))) (cl--expr-depends-p (nth 1 p) vars))
@@ -2274,41 +1929,23 @@ before assigning any PLACEs to the corresponding values.
       (or p (error "Odd number of arguments to cl-psetf"))
       (pop p))
     (if simple
-	`(progn (cl-setf ,@args) nil)
+	`(progn (setf ,@args) nil)
       (setq args (reverse args))
-      (let ((expr `(cl-setf ,(cadr args) ,(car args))))
+      (let ((expr `(setf ,(cadr args) ,(car args))))
 	(while (setq args (cddr args))
-	  (setq expr `(cl-setf ,(cadr args) (prog1 ,(car args) ,expr))))
+	  (setq expr `(setf ,(cadr args) (prog1 ,(car args) ,expr))))
 	`(progn ,expr nil)))))
 
-;;;###autoload
-(defun cl-do-pop (place)
-  (if (cl--simple-expr-p place)
-      `(prog1 (car ,place) (cl-setf ,place (cdr ,place)))
-    (let* ((method (cl-setf-do-modify place t))
-	   (temp (make-symbol "--cl-pop--")))
-      `(let* (,@(car method)
-              (,temp ,(nth 2 method)))
-         (prog1 (car ,temp)
-           ,(cl-setf-do-store (nth 1 method) `(cdr ,temp)))))))
-
 ;;;###autoload
 (defmacro cl-remf (place tag)
   "Remove TAG from property list PLACE.
-PLACE may be a symbol, or any generalized variable allowed by `cl-setf'.
+PLACE may be a symbol, or any generalized variable allowed by `setf'.
 The form returns true if TAG was found and removed, nil otherwise."
   (declare (debug (place form)))
-  (let* ((method (cl-setf-do-modify place t))
-	 (tag-temp (and (not (macroexp-const-p tag)) (make-symbol "--cl-remf-tag--")))
-	 (val-temp (and (not (cl--simple-expr-p place))
-			(make-symbol "--cl-remf-place--")))
-	 (ttag (or tag-temp tag))
-	 (tval (or val-temp (nth 2 method))))
-    `(let* (,@(car method)
-            ,@(and val-temp `((,val-temp ,(nth 2 method))))
-            ,@(and tag-temp `((,tag-temp ,tag))))
-       (if (eq ,ttag (car ,tval))
-           (progn ,(cl-setf-do-store (nth 1 method) `(cddr ,tval))
+  (gv-letplace (tval setter) place
+    (macroexp-let2 macroexp-copyable-p ttag tag
+      `(if (eq ,ttag (car ,tval))
+           (progn ,(funcall setter `(cddr ,tval))
                   t)
          (cl--do-remf ,tval ,ttag)))))
 
@@ -2316,7 +1953,7 @@ The form returns true if TAG was found and removed, nil otherwise."
 (defmacro cl-shiftf (place &rest args)
   "Shift left among PLACEs.
 Example: (cl-shiftf A B C) sets A to B, B to C, and returns the old A.
-Each PLACE may be a symbol, or any generalized variable allowed by `cl-setf'.
+Each PLACE may be a symbol, or any generalized variable allowed by `setf'.
 
 \(fn PLACE... VAL)"
   (declare (debug (&rest place)))
@@ -2324,16 +1961,15 @@ Each PLACE may be a symbol, or any generalized variable allowed by `cl-setf'.
    ((null args) place)
    ((symbolp place) `(prog1 ,place (setq ,place (cl-shiftf ,@args))))
    (t
-    (let ((method (cl-setf-do-modify place 'unsafe)))
-      `(let* ,(car method)
-	 (prog1 ,(nth 2 method)
-	   ,(cl-setf-do-store (nth 1 method) `(cl-shiftf ,@args))))))))
+    (gv-letplace (getter setter) place
+      `(prog1 ,getter
+         ,(funcall setter `(cl-shiftf ,@args)))))))
 
 ;;;###autoload
 (defmacro cl-rotatef (&rest args)
   "Rotate left among PLACEs.
 Example: (cl-rotatef A B C) sets A to B, B to C, and C to A.  It returns nil.
-Each PLACE may be a symbol, or any generalized variable allowed by `cl-setf'.
+Each PLACE may be a symbol, or any generalized variable allowed by `setf'.
 
 \(fn PLACE...)"
   (declare (debug (&rest place)))
@@ -2348,19 +1984,71 @@ Each PLACE may be a symbol, or any generalized variable allowed by `cl-setf'.
 	   (temp (make-symbol "--cl-rotatef--"))
 	   (form temp))
       (while (cdr places)
-	(let ((method (cl-setf-do-modify (pop places) 'unsafe)))
-	  (setq form `(let* ,(car method)
-                        (prog1 ,(nth 2 method)
-                          ,(cl-setf-do-store (nth 1 method) form))))))
-      (let ((method (cl-setf-do-modify (car places) 'unsafe)))
-	`(let* (,@(car method) (,temp ,(nth 2 method)))
-           ,(cl-setf-do-store (nth 1 method) form) nil)))))
+        (setq form
+              (gv-letplace (getter setter) (pop places)
+                `(prog1 ,getter ,(funcall setter form)))))
+      (gv-letplace (getter setter) (car places)
+	(macroexp-let* `((,temp ,getter))
+                       `(progn ,(funcall setter form) nil))))))
+
+;; FIXME: `letf' is unsatisfactory because it does not really "restore" the
+;; previous state.  If the getter/setter loses information, that info is
+;; not recovered.
+
+(defun cl--letf (bindings simplebinds binds body)
+  ;; It's not quite clear what the semantics of cl-letf should be.
+  ;; E.g. in (cl-letf ((PLACE1 VAL1) (PLACE2 VAL2)) BODY), while it's clear
+  ;; that the actual assignments ("bindings") should only happen after
+  ;; evaluating VAL1 and VAL2, it's not clear when the sub-expressions of
+  ;; PLACE1 and PLACE2 should be evaluated.  Should we have
+  ;;    PLACE1; VAL1; PLACE2; VAL2; bind1; bind2
+  ;; or
+  ;;    VAL1; VAL2; PLACE1; PLACE2; bind1; bind2
+  ;; or
+  ;;    VAL1; VAL2; PLACE1; bind1; PLACE2; bind2
+  ;; Common-Lisp's `psetf' does the first, so we'll do the same.
+  (if (null bindings)
+      (if (and (null binds) (null simplebinds)) (macroexp-progn body)
+        `(let* (,@(mapcar (lambda (x)
+                            (pcase-let ((`(,vold ,getter ,_setter ,_vnew) x))
+                              (list vold getter)))
+                          binds)
+                ,@simplebinds)
+           (unwind-protect
+               ,(macroexp-progn
+                 (append
+                  (delq nil
+                        (mapcar (lambda (x)
+                                  (pcase x
+                                    ;; If there's no vnew, do nothing.
+                                    (`(,_vold ,_getter ,setter ,vnew)
+                                     (funcall setter vnew))))
+                                binds))
+                  body))
+             ,@(mapcar (lambda (x)
+                         (pcase-let ((`(,vold ,_getter ,setter ,_vnew) x))
+                           (funcall setter vold)))
+                       binds))))
+    (let ((binding (car bindings)))
+      (gv-letplace (getter setter) (car binding)
+        (macroexp-let2 nil vnew (cadr binding)
+          (if (symbolp (car binding))
+              ;; Special-case for simple variables.
+              (cl--letf (cdr bindings)
+                        (cons `(,getter ,(if (cdr binding) vnew getter))
+                              simplebinds)
+                        binds body)
+            (cl--letf (cdr bindings) simplebinds
+                      (cons `(,(make-symbol "old") ,getter ,setter
+                              ,@(if (cdr binding) (list vnew)))
+                            binds)
+                      body)))))))
 
 ;;;###autoload
 (defmacro cl-letf (bindings &rest body)
   "Temporarily bind to PLACEs.
 This is the analogue of `let', but with generalized variables (in the
-sense of `cl-setf') for the PLACEs.  Each PLACE is set to the corresponding
+sense of `setf') for the PLACEs.  Each PLACE is set to the corresponding
 VALUE, then the BODY forms are executed.  On exit, either normally or
 because of a `throw' or error, the PLACEs are set back to their original
 values.  Note that this macro is *not* available in Common Lisp.
@@ -2368,87 +2056,32 @@ As a special case, if `(PLACE)' is used instead of `(PLACE VALUE)',
 the PLACE is not modified before executing BODY.
 
 \(fn ((PLACE VALUE) ...) BODY...)"
-  (declare (indent 1) (debug ((&rest (gate place &optional form)) body)))
+  (declare (indent 1) (debug ((&rest (gate gv-place &optional form)) body)))
   (if (and (not (cdr bindings)) (cdar bindings) (symbolp (caar bindings)))
       `(let ,bindings ,@body)
-    (let ((lets nil)
-          (rev (reverse bindings)))
-      (while rev
-	(let* ((place (if (symbolp (caar rev))
-			  `(symbol-value ',(caar rev))
-			(caar rev)))
-	       (value (cl-cadar rev))
-	       (method (cl-setf-do-modify place 'no-opt))
-	       (save (make-symbol "--cl-letf-save--"))
-	       (bound (and (memq (car place) '(symbol-value symbol-function))
-			   (make-symbol "--cl-letf-bound--")))
-	       (temp (and (not (macroexp-const-p value)) (cdr bindings)
-			  (make-symbol "--cl-letf-val--"))))
-	  (setq lets (nconc (car method)
-			    (if bound
-				(list (list bound
-					    (list (if (eq (car place)
-							  'symbol-value)
-						      'boundp 'fboundp)
-						  (nth 1 (nth 2 method))))
-				      (list save `(and ,bound
-						       ,(nth 2 method))))
-			      (list (list save (nth 2 method))))
-			    (and temp (list (list temp value)))
-			    lets)
-		body (list
-		      `(unwind-protect
-                           (progn
-                             ,@(if (cdr (car rev))
-                                   (cons (cl-setf-do-store (nth 1 method)
-                                                           (or temp value))
-                                         body)
-                                 body))
-                         ,(if bound
-                              `(if ,bound
-                                   ,(cl-setf-do-store (nth 1 method) save)
-                                 (,(if (eq (car place) 'symbol-value)
-                                       #'makunbound #'fmakunbound)
-                                  ,(nth 1 (nth 2 method))))
-                            (cl-setf-do-store (nth 1 method) save))))
-		rev (cdr rev))))
-      `(let* ,lets ,@body))))
-
+    (cl--letf bindings () () body)))
 
 ;;;###autoload
 (defmacro cl-letf* (bindings &rest body)
   "Temporarily bind to PLACEs.
-This is the analogue of `let*', but with generalized variables (in the
-sense of `cl-setf') for the PLACEs.  Each PLACE is set to the corresponding
-VALUE, then the BODY forms are executed.  On exit, either normally or
-because of a `throw' or error, the PLACEs are set back to their original
-values.  Note that this macro is *not* available in Common Lisp.
-As a special case, if `(PLACE)' is used instead of `(PLACE VALUE)',
-the PLACE is not modified before executing BODY.
-
-\(fn ((PLACE VALUE) ...) BODY...)"
+Like `cl-letf' but where the bindings are performed one at a time,
+rather than all at the end (i.e. like `let*' rather than like `let')."
   (declare (indent 1) (debug cl-letf))
-  (if (null bindings)
-      (cons 'progn body)
-    (setq bindings (reverse bindings))
-    (while bindings
-      (setq body (list `(cl-letf (,(pop bindings)) ,@body))))
-    (car body)))
+  (dolist (binding (reverse bindings))
+    (setq body (list `(cl-letf (,binding) ,@body))))
+  (macroexp-progn body))
 
 ;;;###autoload
 (defmacro cl-callf (func place &rest args)
   "Set PLACE to (FUNC PLACE ARGS...).
 FUNC should be an unquoted function name.  PLACE may be a symbol,
-or any generalized variable allowed by `cl-setf'.
-
-\(fn FUNC PLACE ARGS...)"
+or any generalized variable allowed by `setf'."
   (declare (indent 2) (debug (cl-function place &rest form)))
-  (let* ((method (cl-setf-do-modify place (cons 'list args)))
-	 (rargs (cons (nth 2 method) args)))
-    `(let* ,(car method)
-       ,(cl-setf-do-store (nth 1 method)
-                          (if (symbolp func) (cons func rargs)
-                            `(funcall #',func ,@rargs))))))
+  (gv-letplace (getter setter) place
+    (let* ((rargs (cons getter args)))
+      (funcall setter
+               (if (symbolp func) (cons func rargs)
+                 `(funcall #',func ,@rargs))))))
 
 ;;;###autoload
 (defmacro cl-callf2 (func arg1 place &rest args)
@@ -2458,31 +2091,13 @@ Like `cl-callf', but PLACE is the second argument of FUNC, not the first.
 \(fn FUNC ARG1 PLACE ARGS...)"
   (declare (indent 3) (debug (cl-function form place &rest form)))
   (if (and (cl--safe-expr-p arg1) (cl--simple-expr-p place) (symbolp func))
-      `(cl-setf ,place (,func ,arg1 ,place ,@args))
-    (let* ((method (cl-setf-do-modify place (cons 'list args)))
-	   (temp (and (not (macroexp-const-p arg1)) (make-symbol "--cl-arg1--")))
-	   (rargs (cl-list* (or temp arg1) (nth 2 method) args)))
-      `(let* (,@(and temp (list (list temp arg1))) ,@(car method))
-         ,(cl-setf-do-store (nth 1 method)
-                            (if (symbolp func) (cons func rargs)
-                              `(funcall #',func ,@rargs)))))))
-
-;;;###autoload
-(defmacro cl-define-modify-macro (name arglist func &optional doc)
-  "Define a `cl-setf'-like modify macro.
-If NAME is called, it combines its PLACE argument with the other arguments
-from ARGLIST using FUNC: (cl-define-modify-macro cl-incf (&optional (n 1)) +)"
-  (declare (debug
-            (&define name cl-lambda-list ;; should exclude &key
-                     symbolp &optional stringp)))
-  (if (memq '&key arglist) (error "&key not allowed in cl-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)))))
-
+      `(setf ,place (,func ,arg1 ,place ,@args))
+    (macroexp-let2 nil a1 arg1
+      (gv-letplace (getter setter) place
+        (let* ((rargs (cl-list* a1 getter args)))
+          (funcall setter
+                   (if (symbolp func) (cons func rargs)
+                     `(funcall #',func ,@rargs))))))))
 
 ;;; Structures.
 
@@ -2492,7 +2107,7 @@ from ARGLIST using FUNC: (cl-define-modify-macro cl-incf (&optional (n 1)) +)"
 This macro defines a new data type called NAME that stores data
 in SLOTs.  It defines a `make-NAME' constructor, a `copy-NAME'
 copier, a `NAME-p' predicate, and slot accessors named `NAME-SLOT'.
-You can use the accessors to set the corresponding slots, via `cl-setf'.
+You can use the accessors to set the corresponding slots, via `setf'.
 
 NAME may instead take the form (NAME OPTIONS...), where each
 OPTION is either a single keyword or (KEYWORD VALUE).
@@ -2501,7 +2116,7 @@ See Info node `(cl)Structures' for a list of valid keywords.
 Each SLOT may instead take the form (SLOT SLOT-OPTS...), where
 SLOT-OPTS are keyword-value pairs for that slot.  Currently, only
 one keyword is supported, `:read-only'.  If this has a non-nil
-value, that slot cannot be set via `cl-setf'.
+value, that slot cannot be set via `setf'.
 
 \(fn NAME SLOTS...)"
   (declare (doc-string 2)
@@ -2655,35 +2270,35 @@ value, that slot cannot be set via `cl-setf'.
 	    (let ((accessor (intern (format "%s%s" conc-name slot))))
 	      (push slot slots)
 	      (push (nth 1 desc) defaults)
-	      (push (cl-list*
-			'cl-defsubst accessor '(cl-x)
-			(append
-			 (and pred-check
+	      (push `(cl-defsubst ,accessor (cl-x)
+                       ,@(and pred-check
 			      (list `(or ,pred-check
                                          (error "%s accessing a non-%s"
                                                 ',accessor ',name))))
-			 (list (if (eq type 'vector) `(aref cl-x ,pos)
-				 (if (= pos 0) '(car cl-x)
-				   `(nth ,pos cl-x)))))) forms)
+                       ,(if (eq type 'vector) `(aref cl-x ,pos)
+                          (if (= pos 0) '(car cl-x)
+                            `(nth ,pos cl-x)))) forms)
 	      (push (cons accessor t) side-eff)
-	      (push `(cl-define-setf-expander ,accessor (cl-x)
-                       ,(if (cadr (memq :read-only (cddr desc)))
-                            `(progn (ignore cl-x)
-                                    (error "%s is a read-only slot"
-                                           ',accessor))
-                          ;; If cl is loaded only for compilation,
-                          ;; the call to cl-struct-setf-expander would
-                          ;; cause a warning because it may not be
-                          ;; defined at run time.  Suppress that warning.
-                          `(progn
-                             (declare-function
-                              cl-struct-setf-expander "cl-macs"
-                              (x name accessor pred-form pos))
-                             (cl-struct-setf-expander
-                              cl-x ',name ',accessor
-                              ,(and pred-check `',pred-check)
-                              ,pos))))
-                    forms)
+              ;; Don't bother defining a setf-expander, since gv-get can use
+              ;; the compiler macro to get the same result.
+              ;;(push `(gv-define-setter ,accessor (cl-val cl-x)
+              ;;         ,(if (cadr (memq :read-only (cddr desc)))
+              ;;              `(progn (ignore cl-x cl-val)
+              ;;                      (error "%s is a read-only slot"
+              ;;                             ',accessor))
+              ;;            ;; If cl is loaded only for compilation,
+              ;;            ;; the call to cl--struct-setf-expander would
+              ;;            ;; cause a warning because it may not be
+              ;;            ;; defined at run time.  Suppress that warning.
+              ;;            `(progn
+              ;;               (declare-function
+              ;;                cl--struct-setf-expander "cl-macs"
+              ;;                (x name accessor pred-form pos))
+              ;;               (cl--struct-setf-expander
+              ;;                cl-val cl-x ',name ',accessor
+              ;;                ,(and pred-check `',pred-check)
+              ;;                ,pos))))
+              ;;      forms)
 	      (if print-auto
 		  (nconc print-func
 			 (list `(princ ,(format " %s" slot) cl-s)
@@ -2739,29 +2354,6 @@ value, that slot cannot be set via `cl-setf'.
           forms)
     `(progn ,@(nreverse (cons `',name forms)))))
 
-;;;###autoload
-(defun cl-struct-setf-expander (x name accessor pred-form pos)
-  (let* ((temp (make-symbol "--cl-x--")) (store (make-symbol "--cl-store--")))
-    (list (list temp) (list x) (list store)
-	  `(progn
-             ,@(and pred-form
-                    (list `(or ,(cl-subst temp 'cl-x pred-form)
-                               (error ,(format
-                                        "%s storing a non-%s"
-                                        accessor name)))))
-             ,(if (eq (car (get name 'cl-struct-type)) 'vector)
-                  `(aset ,temp ,pos ,store)
-                `(setcar
-                  ,(if (<= pos 5)
-                       (let ((xx temp))
-                         (while (>= (setq pos (1- pos)) 0)
-                           (setq xx `(cdr ,xx)))
-                         xx)
-                     `(nthcdr ,pos ,temp))
-                  ,store)))
-	  (list accessor temp))))
-
-
 ;;; Types and assertions.
 
 ;;;###autoload
@@ -2836,6 +2428,7 @@ STRING is an optional description of the desired type."
 
 ;;;###autoload
 (defmacro cl-assert (form &optional show-args string &rest args)
+  ;; FIXME: This is actually not compatible with Common-Lisp's `assert'.
   "Verify that FORM returns non-nil; signal an error if not.
 Second arg SHOW-ARGS means to include arguments of FORM in message.
 Other args STRING and ARGS... are arguments to be passed to `error'.
@@ -2896,8 +2489,8 @@ and then returning foo."
 	(while (and (symbolp func)
 		    (not (setq handler (get func 'compiler-macro)))
 		    (fboundp func)
-		    (or (not (eq (car-safe (symbol-function func)) 'autoload))
-			(load (nth 1 (symbol-function func)))))
+		    (or (not (autoloadp (symbol-function func)))
+			(autoload-do-load (symbol-function func) func)))
 	  (setq func (symbol-function func)))
 	(and handler
 	     (not (eq form (setq form (apply handler form (cdr form))))))))
@@ -2932,7 +2525,7 @@ ARGLIST allows full Common Lisp conventions, and BODY is implicitly
 surrounded by (cl-block NAME ...).
 
 \(fn NAME ARGLIST [DOCSTRING] BODY...)"
-  (declare (debug cl-defun))
+  (declare (debug cl-defun) (indent 2))
   (let* ((argns (cl--arglist-args args)) (p argns)
 	 (pbody (cons 'progn body))
 	 (unsafe (not (cl--safe-expr-p pbody))))
@@ -2978,8 +2571,6 @@ surrounded by (cl-block NAME ...).
 
 
 ;; Compile-time optimizations for some functions defined in this package.
-;; Note that cl.el arranges to force cl-macs to be loaded at compile-time,
-;; mainly to make sure these macros will be present.
 
 (defun cl--compiler-macro-member (form a list &rest keys)
   (let ((test (and (= (length keys) 2) (eq (car keys) :test)
@@ -3021,7 +2612,7 @@ surrounded by (cl-block NAME ...).
 
 (cl-define-compiler-macro cl-typep (&whole form val type)
   (if (macroexp-const-p type)
-      (macroexp-let² macroexp-copyable-p temp val
+      (macroexp-let2 macroexp-copyable-p temp val
         (cl--make-type-test temp (cl--const-expr-val type)))
     form))
 
@@ -3055,8 +2646,8 @@ surrounded by (cl-block NAME ...).
   (put y 'side-effect-free t))
 
 ;;; Things that are inline.
-(cl-proclaim '(inline cl-floatp-safe cl-acons cl-map cl-concatenate cl-notany cl-notevery
-		   cl--set-elt cl-revappend cl-nreconc gethash))
+(cl-proclaim '(inline cl-floatp-safe cl-acons cl-map cl-concatenate cl-notany
+               cl-notevery cl--set-elt cl-revappend cl-nreconc gethash))
 
 ;;; Things that are side-effect-free.
 (mapc (lambda (x) (put x 'side-effect-free t))