[Emacs-diffs] /srv/bzr/emacs/trunk r99853: Fix some of the problems in defsubst* (bug#5728).

[Stefan Monnier]

------------------------------------------------------------
revno: 99853
committer: Stefan Monnier <address@hidden>
branch nick: trunk
timestamp: Thu 2010-04-08 15:59:46 -0400
message:
  Fix some of the problems in defsubst* (bug#5728).
  * emacs-lisp/cl-macs.el (defsubst*): Don't substitute non-trivial args.
  (cl-defsubst-expand): Do the substitutions simultaneously (bug#5728).
modified:
  .bzrignore
  lisp/ChangeLog
  lisp/emacs-lisp/cl-macs.el

=== modified file '.bzrignore'
--- a/.bzrignore        2010-03-24 19:14:50 +0000
+++ b/.bzrignore        2010-04-08 19:59:46 +0000
@@ -65,3 +65,4 @@
 configure.lineno
 conftest*
 confdefs.h
+core

=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog    2010-04-07 16:20:35 +0000
+++ b/lisp/ChangeLog    2010-04-08 19:59:46 +0000
@@ -1,7 +1,13 @@
+2010-04-08  Stefan Monnier  <address@hidden>
+
+       Fix some of the problems in defsubst* (bug#5728).
+       * emacs-lisp/cl-macs.el (defsubst*): Don't substitute non-trivial args.
+       (cl-defsubst-expand): Do the substitutions simultaneously (bug#5728).
+
 2010-04-07  Sam Steingold  <address@hidden>
 
-       * progmodes/compile.el (compilation-save-buffers-predicate): New
-       custom variable.
+       * progmodes/compile.el (compilation-save-buffers-predicate):
+       New custom variable.
        (compile, recompile): Pass it to `save-some-buffers'.
 
 2010-04-07  Jan Djärv  <address@hidden>

=== modified file 'lisp/emacs-lisp/cl-macs.el'
--- a/lisp/emacs-lisp/cl-macs.el        2010-03-12 03:19:17 +0000
+++ b/lisp/emacs-lisp/cl-macs.el        2010-04-08 19:59:46 +0000
@@ -128,6 +128,12 @@
   (and (eq (cl-const-expr-p x) t) (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 (cl-const-expr-p x) v
     (if (consp x)
        (progn
@@ -2616,21 +2622,36 @@
                    (cons '&cl-quote args))
                  (list* 'cl-defsubst-expand (list 'quote argns)
                         (list 'quote (list* 'block name body))
-                        (not (or unsafe (cl-expr-access-order pbody argns)))
+                         ;; We used to pass `simple' as
+                         ;; (not (or unsafe (cl-expr-access-order pbody 
argns)))
+                         ;; But this is much too simplistic since it
+                         ;; does not pay attention to the argvs (and
+                         ;; cl-expr-access-order itself is also too naive).
+                        nil
                         (and (memq '&key args) 'cl-whole) unsafe argns)))
          (list* 'defun* name args body))))
 
 (defun cl-defsubst-expand (argns body simple whole unsafe &rest argvs)
   (if (and whole (not (cl-safe-expr-p (cons 'progn argvs)))) whole
     (if (cl-simple-exprs-p argvs) (setq simple t))
-    (let ((lets (delq nil
-                     (mapcar* (function
-                               (lambda (argn argv)
-                                 (if (or simple (cl-const-expr-p argv))
-                                     (progn (setq body (subst argv argn body))
-                                            (and unsafe (list argn argv)))
-                                   (list argn argv))))
-                              argns argvs))))
+    (let* ((substs ())
+           (lets (delq nil
+                       (mapcar* (function
+                                 (lambda (argn argv)
+                                   (if (or simple (cl-const-expr-p argv))
+                                       (progn (push (cons argn argv) substs)
+                                              (and unsafe (list argn argv)))
+                                     (list argn argv))))
+                                argns argvs))))
+      ;; FIXME: `sublis/subst' will happily substitute the symbol
+      ;; `argn' in places where it's not used as a reference
+      ;; to a variable.
+      ;; FIXME: `sublis/subst' will happily copy `argv' to a different
+      ;; scope, leading to name capture.
+      (setq body (cond ((null substs) body)
+                       ((null (cdr substs))
+                        (subst (cdar substs) (caar substs) body))
+                       (t (sublis substs body))))
       (if lets (list 'let lets body) body))))