------------------------------------------------------------ revno: 117010 committer: Daniel Colascione branch nick: trunk timestamp: Tue 2014-04-22 00:04:34 -0700 message: Correctly macroexpand top-level forms during eager macroexpand * lisp/emacs-lisp/byte-run.el (eval-when-compile, eval-and-compile): Improve docstrings. * lisp/emacs-lisp/macroexp.el (internal-macroexpand-for-load): Add `full-p' parameter; when nil, call `macroexpand' instead of `macroexpand-all'. * src/lread.c (readevalloop_eager_expand_eval): New function that can recurse into toplevel forms. (readevalloop): Call it. * src/lisp.h: Declare Qprogn. * src/callint.c (Qprogn): No longer static. * test/automated/bytecomp-tests.el (test-byte-comp-compile-and-load): Add compile flag. (test-byte-comp-macro-expansion) (test-byte-comp-macro-expansion-eval-and-compile) (test-byte-comp-macro-expansion-eval-when-compile) (test-byte-comp-macro-expand-lexical-override): Use it. (test-eager-load-macro-expansion) (test-eager-load-macro-expansion-eval-and-compile) (test-eager-load-macro-expansion-eval-when-compile) (test-eager-load-macro-expand-lexical-override): New tests. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2014-04-22 06:51:30 +0000 +++ lisp/ChangeLog 2014-04-22 07:04:34 +0000 @@ -1,5 +1,12 @@ 2014-04-22 Daniel Colascione + * emacs-lisp/macroexp.el (internal-macroexpand-for-load): Add + `full-p' parameter; when nil, call `macroexpand' instead of + `macroexpand-all'. + + * emacs-lisp/byte-run.el (eval-when-compile, eval-and-compile): + Improve docstrings. + * emacs-lisp/bytecomp.el (byte-compile-initial-macro-environment): Use lambda function values, not quoted lambdas. (byte-compile-recurse-toplevel): Remove extraneous &optional. === modified file 'lisp/emacs-lisp/byte-run.el' --- lisp/emacs-lisp/byte-run.el 2014-03-22 22:12:52 +0000 +++ lisp/emacs-lisp/byte-run.el 2014-04-22 07:04:34 +0000 @@ -398,13 +398,20 @@ (defmacro eval-when-compile (&rest body) "Like `progn', but evaluates the body at compile time if you're compiling. -Thus, the result of the body appears to the compiler as a quoted constant. -In interpreted code, this is entirely equivalent to `progn'." +Thus, the result of the body appears to the compiler as a quoted +constant. In interpreted code, this is entirely equivalent to +`progn', except that the value of the expression may be (but is +not necessarily) computed at load time if eager macro expansion +is enabled." (declare (debug (&rest def-form)) (indent 0)) (list 'quote (eval (cons 'progn body) lexical-binding))) (defmacro eval-and-compile (&rest body) - "Like `progn', but evaluates the body at compile time and at load time." + "Like `progn', but evaluates the body at compile time and at +load time. In interpreted code, this is entirely equivalent to +`progn', except that the value of the expression may be (but is +not necessarily) computed at load time if eager macro expansion +is enabled." (declare (debug t) (indent 0)) ;; When the byte-compiler expands code, this macro is not used, so we're ;; either about to run `body' (plain interpretation) or we're doing eager === modified file 'lisp/emacs-lisp/macroexp.el' --- lisp/emacs-lisp/macroexp.el 2014-04-21 09:34:21 +0000 +++ lisp/emacs-lisp/macroexp.el 2014-04-22 07:04:34 +0000 @@ -405,7 +405,7 @@ (defvar macroexp--pending-eager-loads nil "Stack of files currently undergoing eager macro-expansion.") -(defun internal-macroexpand-for-load (form) +(defun internal-macroexpand-for-load (form full-p) ;; Called from the eager-macroexpansion in readevalloop. (cond ;; Don't repeat the same warning for every top-level element. @@ -428,7 +428,9 @@ (condition-case err (let ((macroexp--pending-eager-loads (cons load-file-name macroexp--pending-eager-loads))) - (macroexpand-all form)) + (if full-p + (macroexpand-all form) + (macroexpand form))) (error ;; Hopefully this shouldn't happen thanks to the cycle detection, ;; but in case it does happen, let's catch the error and give the === modified file 'src/ChangeLog' --- src/ChangeLog 2014-04-19 20:32:05 +0000 +++ src/ChangeLog 2014-04-22 07:04:34 +0000 @@ -1,3 +1,11 @@ +2014-04-22 Daniel Colascione + + * lread.c (readevalloop_eager_expand_eval): New function + that can recurse into toplevel forms. + (readevalloop): Call it. + * lisp.h: Declare Qprogn. + * callint.c (Qprogn): No longer static. + 2014-04-19 Stefan Monnier * intervals.c (rotate_right, rotate_left): Fix up length computation. === modified file 'src/callint.c' --- src/callint.c 2014-01-31 09:41:54 +0000 +++ src/callint.c 2014-04-22 07:04:34 +0000 @@ -38,8 +38,8 @@ Lisp_Object Qmouse_leave_buffer_hook; -static Lisp_Object Qlist, Qlet, Qletx, Qsave_excursion, Qprogn, Qif; -Lisp_Object Qwhen; +static Lisp_Object Qlist, Qlet, Qletx, Qsave_excursion, Qif; +Lisp_Object Qwhen, Qprogn; static Lisp_Object preserved_fns; /* Marker used within call-interactively to refer to point. */ === modified file 'src/lisp.h' --- src/lisp.h 2014-04-16 19:43:46 +0000 +++ src/lisp.h 2014-04-22 07:04:34 +0000 @@ -4027,6 +4027,7 @@ /* Defined in callint.c. */ extern Lisp_Object Qminus, Qplus; +extern Lisp_Object Qprogn; extern Lisp_Object Qwhen; extern Lisp_Object Qmouse_leave_buffer_hook; extern void syms_of_callint (void); === modified file 'src/lread.c' --- src/lread.c 2014-02-25 22:51:34 +0000 +++ src/lread.c 2014-04-22 07:04:34 +0000 @@ -1763,6 +1763,29 @@ xsignal0 (Qend_of_file); } +static Lisp_Object +readevalloop_eager_expand_eval (Lisp_Object val, Lisp_Object macroexpand) +{ + /* If we macroexpand the toplevel form non-recursively and it ends + up being a `progn' (or if it was a progn to start), treat each + form in the progn as a top-level form. This way, if one form in + the progn defines a macro, that macro is in effect when we expand + the remaining forms. See similar code in bytecomp.el. */ + val = call2 (macroexpand, val, Qnil); + if (EQ (CAR_SAFE (val), Qprogn)) + { + Lisp_Object subforms = XCDR (val); + val = Qnil; + for (; CONSP (subforms); subforms = XCDR (subforms)) + val = readevalloop_eager_expand_eval (XCAR (subforms), + macroexpand); + } + else + val = eval_sub (call2 (macroexpand, val, Qt)); + + return val; +} + /* UNIBYTE specifies how to set load_convert_to_unibyte for this invocation. READFUN, if non-nil, is used instead of `read'. @@ -1930,8 +1953,9 @@ /* Now eval what we just read. */ if (!NILP (macroexpand)) - val = call1 (macroexpand, val); - val = eval_sub (val); + val = readevalloop_eager_expand_eval (val, macroexpand); + else + val = eval_sub (val); if (printflag) { === modified file 'test/ChangeLog' --- test/ChangeLog 2014-04-22 03:51:12 +0000 +++ test/ChangeLog 2014-04-22 07:04:34 +0000 @@ -1,7 +1,19 @@ 2014-04-22 Daniel Colascione + * automated/bytecomp-tests.el (test-byte-comp-compile-and-load): + Add compile flag. + (test-byte-comp-macro-expansion) + (test-byte-comp-macro-expansion-eval-and-compile) + (test-byte-comp-macro-expansion-eval-when-compile) + (test-byte-comp-macro-expand-lexical-override): Use it. + (test-eager-load-macro-expansion) + (test-eager-load-macro-expansion-eval-and-compile) + (test-eager-load-macro-expansion-eval-when-compile) + (test-eager-load-macro-expand-lexical-override): New tests. + * automated/cl-lib.el (cl-lib-struct-accessors): Fix test to - account for removal of `cl-struct-set-slot-value'. + account for removal of `cl-struct-set-slot-value'. Also, move + the defstruct to top level. 2014-04-21 Daniel Colascione === modified file 'test/automated/bytecomp-tests.el' --- test/automated/bytecomp-tests.el 2014-04-21 09:34:21 +0000 +++ test/automated/bytecomp-tests.el 2014-04-22 07:04:34 +0000 @@ -305,30 +305,33 @@ 'face fail-face))) (insert "\n")))) -(defun test-byte-comp-compile-and-load (&rest forms) +(defun test-byte-comp-compile-and-load (compile &rest forms) (let ((elfile nil) (elcfile nil)) (unwind-protect (progn (setf elfile (make-temp-file "test-bytecomp" nil ".el")) - (setf elcfile (make-temp-file "test-bytecomp" nil ".elc")) + (when compile + (setf elcfile (make-temp-file "test-bytecomp" nil ".elc"))) (with-temp-buffer (dolist (form forms) (print form (current-buffer))) (write-region (point-min) (point-max) elfile)) - (let ((byte-compile-dest-file elcfile)) - (byte-compile-file elfile t))) + (if compile + (let ((byte-compile-dest-file elcfile)) + (byte-compile-file elfile t)) + (load elfile))) (when elfile (delete-file elfile)) (when elcfile (delete-file elcfile))))) -(put 'test-byte-comp-compile-and-load 'lisp-indent-function 0) +(put 'test-byte-comp-compile-and-load 'lisp-indent-function 1) (ert-deftest test-byte-comp-macro-expansion () - (test-byte-comp-compile-and-load + (test-byte-comp-compile-and-load t '(progn (defmacro abc (arg) 1) (defun def () (abc 2)))) (should (equal (funcall 'def) 1))) (ert-deftest test-byte-comp-macro-expansion-eval-and-compile () - (test-byte-comp-compile-and-load + (test-byte-comp-compile-and-load t '(eval-and-compile (defmacro abc (arg) -1) (defun def () (abc 2)))) (should (equal (funcall 'def) -1))) @@ -336,7 +339,7 @@ ;; Make sure we interpret eval-when-compile forms properly. CLISP ;; and SBCL interpreter eval-when-compile (well, the CL equivalent) ;; in the same way. - (test-byte-comp-compile-and-load + (test-byte-comp-compile-and-load t '(eval-when-compile (defmacro abc (arg) -10) (defun abc-1 () (abc 2))) @@ -349,12 +352,47 @@ ;; macrolet since macrolet's is explicitly called out as being ;; equivalent to toplevel, but CLISP and SBCL both evaluate the form ;; this way, so we should too. - (test-byte-comp-compile-and-load - '(require 'cl-lib) - '(cl-macrolet ((m () 4)) - (defmacro m () 5) - (defun def () (m)))) - (should (equal (funcall 'def) 4))) + (test-byte-comp-compile-and-load t + '(require 'cl-lib) + '(cl-macrolet ((m () 4)) + (defmacro m () 5) + (defun def () (m)))) + (should (equal (funcall 'def) 4))) + +(ert-deftest test-eager-load-macro-expansion () + (test-byte-comp-compile-and-load nil + '(progn (defmacro abc (arg) 1) (defun def () (abc 2)))) + (should (equal (funcall 'def) 1))) + +(ert-deftest test-eager-load-macro-expansion-eval-and-compile () + (test-byte-comp-compile-and-load nil + '(eval-and-compile (defmacro abc (arg) -1) (defun def () (abc 2)))) + (should (equal (funcall 'def) -1))) + +(ert-deftest test-eager-load-macro-expansion-eval-when-compile () + ;; Make sure we interpret eval-when-compile forms properly. CLISP + ;; and SBCL interpreter eval-when-compile (well, the CL equivalent) + ;; in the same way. + (test-byte-comp-compile-and-load nil + '(eval-when-compile + (defmacro abc (arg) -10) + (defun abc-1 () (abc 2))) + '(defmacro abc-2 () (abc-1)) + '(defun def () (abc-2))) + (should (equal (funcall 'def) -10))) + +(ert-deftest test-eager-load-macro-expand-lexical-override () + ;; Intuitively, one might expect the defmacro to override the + ;; macrolet since macrolet's is explicitly called out as being + ;; equivalent to toplevel, but CLISP and SBCL both evaluate the form + ;; this way, so we should too. + (test-byte-comp-compile-and-load nil + '(require 'cl-lib) + '(cl-macrolet ((m () 4)) + (defmacro m () 5) + (defun def () (m)))) + (should (equal (funcall 'def) 4))) + ;; Local Variables: ;; no-byte-compile: t ------------------------------------------------------------ revno: 117009 committer: Daniel Colascione branch nick: trunk timestamp: Mon 2014-04-21 23:51:30 -0700 message: Minor bytecomp.el fixes * lisp/emacs-lisp/bytecomp.el (byte-compile-initial-macro-environment): Use lambda function values, not quoted lambdas. (byte-compile-recurse-toplevel): Remove extraneous &optional. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2014-04-22 03:51:12 +0000 +++ lisp/ChangeLog 2014-04-22 06:51:30 +0000 @@ -1,7 +1,11 @@ 2014-04-22 Daniel Colascione + * emacs-lisp/bytecomp.el (byte-compile-initial-macro-environment): + Use lambda function values, not quoted lambdas. + (byte-compile-recurse-toplevel): Remove extraneous &optional. + * emacs-lisp/cl-macs.el - (cl-struct-sequence-type,cl-struct-slot-info): Declare pure. + (cl-struct-sequence-type, cl-struct-slot-info): Declare pure. (cl-struct-slot-value): Conditionally use aref or nth so that the compiler produces optimal code. === modified file 'lisp/emacs-lisp/bytecomp.el' --- lisp/emacs-lisp/bytecomp.el 2014-04-21 09:34:21 +0000 +++ lisp/emacs-lisp/bytecomp.el 2014-04-22 06:51:30 +0000 @@ -421,7 +421,7 @@ (defvar byte-compiler-error-flag) -(defun byte-compile-recurse-toplevel (form &optional non-toplevel-case) +(defun byte-compile-recurse-toplevel (form non-toplevel-case) "Implement `eval-when-compile' and `eval-and-compile'. Return the compile-time value of FORM." ;; Macroexpand (not macroexpand-all!) form at toplevel in case it @@ -439,28 +439,28 @@ (funcall non-toplevel-case form))) (defconst byte-compile-initial-macro-environment - '( + `( ;; (byte-compiler-options . (lambda (&rest forms) ;; (apply 'byte-compiler-options-handler forms))) (declare-function . byte-compile-macroexpand-declare-function) - (eval-when-compile . (lambda (&rest body) - (let ((result nil)) - (byte-compile-recurse-toplevel - (cons 'progn body) - (lambda (form) - (setf result - (byte-compile-eval - (byte-compile-top-level - (byte-compile-preprocess form)))))) - (list 'quote result)))) - (eval-and-compile . (lambda (&rest body) - (byte-compile-recurse-toplevel - (cons 'progn body) - (lambda (form) - (let ((compiled (byte-compile-top-level - (byte-compile-preprocess form)))) - (eval compiled) - compiled)))))) + (eval-when-compile . ,(lambda (&rest body) + (let ((result nil)) + (byte-compile-recurse-toplevel + (cons 'progn body) + (lambda (form) + (setf result + (byte-compile-eval + (byte-compile-top-level + (byte-compile-preprocess form)))))) + (list 'quote result)))) + (eval-and-compile . ,(lambda (&rest body) + (byte-compile-recurse-toplevel + (cons 'progn body) + (lambda (form) + (let ((compiled (byte-compile-top-level + (byte-compile-preprocess form)))) + (eval compiled lexical-binding) + compiled)))))) "The default macro-environment passed to macroexpand by the compiler. Placing a macro here will cause a macro to have different semantics when expanded by the compiler as when expanded by the interpreter.") ------------------------------------------------------------ revno: 117008 committer: Daniel Colascione branch nick: trunk timestamp: Mon 2014-04-21 23:45:41 -0700 message: Fix cl-lib-struct-accessors test again. * test/automated/cl-lib.el (cl-lib-struct-accessors): Fix test to account for removal of `cl-struct-set-slot-value'. Also, move the defstruct to top level. diff: === modified file 'test/automated/cl-lib.el' --- test/automated/cl-lib.el 2014-04-22 03:51:12 +0000 +++ test/automated/cl-lib.el 2014-04-22 06:45:41 +0000 @@ -201,8 +201,8 @@ :b :a :a 42) '(42 :a)))) +(cl-defstruct mystruct (abc :readonly t) def) (ert-deftest cl-lib-struct-accessors () - (cl-defstruct mystruct (abc :readonly t) def) (let ((x (make-mystruct :abc 1 :def 2))) (should (eql (cl-struct-slot-value 'mystruct 'abc x) 1)) (should (eql (cl-struct-slot-value 'mystruct 'def x) 2)) ------------------------------------------------------------ revno: 117007 committer: Daniel Colascione branch nick: trunk timestamp: Mon 2014-04-21 20:51:12 -0700 message: Optimize cl-struct-slot-value; fix test 2014-04-22 Daniel Colascione * emacs-lisp/cl-macs.el (cl-struct-sequence-type,cl-struct-slot-info): Declare pure. (cl-struct-slot-value): Conditionally use aref or nth so that the compiler produces optimal code. 2014-04-22 Daniel Colascione * automated/cl-lib.el (cl-lib-struct-accessors): Fix test to account for removal of `cl-struct-set-slot-value'. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2014-04-22 03:18:15 +0000 +++ lisp/ChangeLog 2014-04-22 03:51:12 +0000 @@ -1,3 +1,10 @@ +2014-04-22 Daniel Colascione + + * emacs-lisp/cl-macs.el + (cl-struct-sequence-type,cl-struct-slot-info): Declare pure. + (cl-struct-slot-value): Conditionally use aref or nth so that the + compiler produces optimal code. + 2014-04-22 Stefan Monnier * emacs-lisp/cl-macs.el (cl-struct-slot-offset): Mark as pure. === modified file 'lisp/emacs-lisp/cl-macs.el' --- lisp/emacs-lisp/cl-macs.el 2014-04-22 03:18:15 +0000 +++ lisp/emacs-lisp/cl-macs.el 2014-04-22 03:51:12 +0000 @@ -2600,6 +2600,7 @@ 'list, or nil if STRUCT-TYPE is not a struct type. " (car (get struct-type 'cl-struct-type))) (put 'cl-struct-sequence-type 'side-effect-free t) +(put 'cl-struct-sequence-type 'pure t) (defun cl-struct-slot-info (struct-type) "Return a list of slot names of struct STRUCT-TYPE. @@ -2609,6 +2610,7 @@ slots skipped by :initial-offset may appear in the list." (get struct-type 'cl-struct-slots)) (put 'cl-struct-slot-info 'side-effect-free t) +(put 'cl-struct-slot-info 'pure t) (defun cl-struct-slot-offset (struct-type slot-name) "Return the offset of slot SLOT-NAME in STRUCT-TYPE. @@ -2942,7 +2944,12 @@ STRUCT and SLOT-NAME are symbols. INST is a structure instance." (unless (cl-typep inst struct-type) (signal 'wrong-type-argument (list struct-type inst))) - (elt inst (cl-struct-slot-offset struct-type slot-name))) + ;; We could use `elt', but since the byte compiler will resolve the + ;; branch below at compile time, it's more efficient to use the + ;; type-specific accessor. + (if (eq (cl-struct-sequence-type struct-type) 'vector) + (aref inst (cl-struct-slot-offset struct-type slot-name)) + (nth (cl-struct-slot-offset struct-type slot-name) inst))) (put 'cl-struct-slot-value 'side-effect-free t) (run-hooks 'cl-macs-load-hook) === modified file 'test/ChangeLog' --- test/ChangeLog 2014-04-21 09:34:21 +0000 +++ test/ChangeLog 2014-04-22 03:51:12 +0000 @@ -1,3 +1,8 @@ +2014-04-22 Daniel Colascione + + * automated/cl-lib.el (cl-lib-struct-accessors): Fix test to + account for removal of `cl-struct-set-slot-value'. + 2014-04-21 Daniel Colascione * automated/bytecomp-tests.el (test-byte-comp-compile-and-load): === modified file 'test/automated/cl-lib.el' --- test/automated/cl-lib.el 2014-04-21 01:28:55 +0000 +++ test/automated/cl-lib.el 2014-04-22 03:51:12 +0000 @@ -206,7 +206,7 @@ (let ((x (make-mystruct :abc 1 :def 2))) (should (eql (cl-struct-slot-value 'mystruct 'abc x) 1)) (should (eql (cl-struct-slot-value 'mystruct 'def x) 2)) - (cl-struct-set-slot-value 'mystruct 'def x -1) + (setf (cl-struct-slot-value 'mystruct 'def x) -1) (should (eql (cl-struct-slot-value 'mystruct 'def x) -1)) (should (eql (cl-struct-slot-offset 'mystruct 'abc) 1)) (should-error (cl-struct-slot-offset 'mystruct 'marypoppins)) ------------------------------------------------------------ revno: 117006 committer: Stefan Monnier branch nick: trunk timestamp: Mon 2014-04-21 23:18:15 -0400 message: * lisp/emacs-lisp/cl-macs.el (cl-struct-slot-offset): Mark as pure. (cl--set-elt): Don't proclaim as inline. (cl-struct-slot-value): Remove explicit gv-setter and compiler-macro. Define as inlinable instead. (cl-struct-set-slot-value): Remove. * doc/misc/cl.texi (Structures): Remove cl-struct-set-slot-value. * lisp/emacs-lisp/cl-lib.el (cl--set-elt): Remove. * lisp/emacs-lisp/cl-seq.el (cl-replace, cl-substitute, cl-nsubstitute): Use setf instead. diff: === modified file 'doc/misc/ChangeLog' --- doc/misc/ChangeLog 2014-04-20 02:50:36 +0000 +++ doc/misc/ChangeLog 2014-04-22 03:18:15 +0000 @@ -1,3 +1,7 @@ +2014-04-22 Stefan Monnier + + * cl.texi (Structures): Remove cl-struct-set-slot-value. + 2014-04-20 Daniel Colascione * cl.texi (Declarations): Document changes to `cl-the' and defstruct functions. === modified file 'doc/misc/cl.texi' --- doc/misc/cl.texi 2014-04-20 02:50:36 +0000 +++ doc/misc/cl.texi 2014-04-22 03:18:15 +0000 @@ -4278,18 +4278,7 @@ Return the value of slot @code{slot-name} in @code{inst} of @code{struct-type}. @code{struct} and @code{slot-name} are symbols. @code{inst} is a structure instance. This routine is also a -@code{setf} place. @code{cl-struct-slot-value} uses -@code{cl-struct-slot-offset} internally and can signal the same -errors. -@end defun - -@defun cl-struct-set-slot-value struct-type slot-name inst value -Set the value of slot @code{slot-name} in @code{inst} of -@code{struct-type}. @code{struct} and @code{slot-name} are symbols. -@code{inst} is a structure instance. @code{value} is the value to -which to set the given slot. Return @code{value}. -@code{cl-struct-slot-value} uses @code{cl-struct-set-slot-offset} -internally and can signal the same errors. +@code{setf} place. Can signal the same errors as @code{cl-struct-slot-offset}. @end defun @node Assertions === modified file 'etc/NEWS' --- etc/NEWS 2014-04-20 02:50:36 +0000 +++ etc/NEWS 2014-04-22 03:18:15 +0000 @@ -99,8 +99,7 @@ ** You can specify a function's interactive-only property via `declare'. However you specify it, the property affects `describe-function' output. -** You can access the slots of structures using `cl-struct-slot-value' - and `cl-struct-set-slot-value'. +** You can access the slots of structures using `cl-struct-slot-value'. * Changes in Emacs 24.5 on Non-Free Operating Systems === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2014-04-21 18:00:19 +0000 +++ lisp/ChangeLog 2014-04-22 03:18:15 +0000 @@ -1,3 +1,15 @@ +2014-04-22 Stefan Monnier + + * emacs-lisp/cl-macs.el (cl-struct-slot-offset): Mark as pure. + (inline): Don't inline cl--set-elt. + (cl-struct-slot-value): Remove explicit gv-setter and compiler-macro. + Define as inlinable instead. + (cl-struct-set-slot-value): Remove. + + * emacs-lisp/cl-lib.el (cl--set-elt): Remove. + * emacs-lisp/cl-seq.el (cl-replace, cl-substitute, cl-nsubstitute): + Use setf instead. + 2014-04-21 Daniel Colascione * emacs-lisp/cl-macs.el (cl--const-expr-val): We didn't need the === modified file 'lisp/emacs-lisp/cl-lib.el' --- lisp/emacs-lisp/cl-lib.el 2014-04-12 19:30:14 +0000 +++ lisp/emacs-lisp/cl-lib.el 2014-04-22 03:18:15 +0000 @@ -152,9 +152,6 @@ `(setq ,place (cl-adjoin ,x ,place ,@keys))) `(cl-callf2 cl-adjoin ,x ,place ,@keys))) -(defun cl--set-elt (seq n val) - (if (listp seq) (setcar (nthcdr n seq) val) (aset seq n val))) - (defun cl--set-buffer-substring (start end val) (save-excursion (delete-region start end) (goto-char start) === modified file 'lisp/emacs-lisp/cl-macs.el' --- lisp/emacs-lisp/cl-macs.el 2014-04-21 18:00:19 +0000 +++ lisp/emacs-lisp/cl-macs.el 2014-04-22 03:18:15 +0000 @@ -2621,6 +2621,7 @@ :key #'car :test #'eq) (error "struct %s has no slot %s" struct-type slot-name))) (put 'cl-struct-slot-offset 'side-effect-free t) +(put 'cl-struct-slot-offset 'pure t) (defvar byte-compile-function-environment) (defvar byte-compile-macro-environment) @@ -2907,7 +2908,7 @@ ;;; Things that are inline. (cl-proclaim '(inline cl-acons cl-map cl-concatenate cl-notany - cl-notevery cl--set-elt cl-revappend cl-nreconc gethash)) + cl-notevery cl-revappend cl-nreconc gethash)) ;;; Things that are side-effect-free. (mapc (lambda (x) (put x 'side-effect-free t)) @@ -2932,9 +2933,11 @@ (cl-function (lambda (&cl-defs '('*) ,@arglist) ,@body))))) ;;; Additional functions that we can now define because we've defined -;;; `cl-define-compiler-macro' and `cl-typep'. +;;; `cl-defsubst' and `cl-typep'. -(defun cl-struct-slot-value (struct-type slot-name inst) +(cl-defsubst cl-struct-slot-value (struct-type slot-name inst) + ;; The use of `cl-defsubst' here gives us both a compiler-macro + ;; and a gv-expander "for free". "Return the value of slot SLOT-NAME in INST of STRUCT-TYPE. STRUCT and SLOT-NAME are symbols. INST is a structure instance." (unless (cl-typep inst struct-type) @@ -2942,45 +2945,6 @@ (elt inst (cl-struct-slot-offset struct-type slot-name))) (put 'cl-struct-slot-value 'side-effect-free t) -(defun cl-struct-set-slot-value (struct-type slot-name inst value) - "Set the value of slot SLOT-NAME in INST of STRUCT-TYPE. -STRUCT and SLOT-NAME are symbols. INST is a structure instance. -VALUE is the value to which to set the given slot. Return -VALUE." - (unless (cl-typep inst struct-type) - (signal 'wrong-type-argument (list struct-type inst))) - (setf (elt inst (cl-struct-slot-offset struct-type slot-name)) value)) - -(gv-define-simple-setter cl-struct-slot-value cl-struct-set-slot-value) - -(cl-define-compiler-macro cl-struct-slot-value - (&whole orig struct-type slot-name inst) - (or (let* ((struct-type (cl--const-expr-val struct-type)) - (slot-name (cl--const-expr-val slot-name))) - (and struct-type (symbolp struct-type) - slot-name (symbolp slot-name) - (assq slot-name (cl-struct-slot-info struct-type)) - (let ((idx (cl-struct-slot-offset struct-type slot-name))) - (cl-ecase (cl-struct-sequence-type struct-type) - (vector `(aref (cl-the ,struct-type ,inst) ,idx)) - (list `(nth ,idx (cl-the ,struct-type ,inst))))))) - orig)) - -(cl-define-compiler-macro cl-struct-set-slot-value - (&whole orig struct-type slot-name inst value) - (or (let* ((struct-type (cl--const-expr-val struct-type)) - (slot-name (cl--const-expr-val slot-name))) - (and struct-type (symbolp struct-type) - slot-name (symbolp slot-name) - (assq slot-name (cl-struct-slot-info struct-type)) - (let ((idx (cl-struct-slot-offset struct-type slot-name))) - (cl-ecase (cl-struct-sequence-type struct-type) - (vector `(setf (aref (cl-the ,struct-type ,inst) ,idx) - ,value)) - (list `(setf (nth ,idx (cl-the ,struct-type ,inst)) - ,value)))))) - orig)) - (run-hooks 'cl-macs-load-hook) ;; Local variables: === modified file 'lisp/emacs-lisp/cl-seq.el' --- lisp/emacs-lisp/cl-seq.el 2014-01-01 07:43:34 +0000 +++ lisp/emacs-lisp/cl-seq.el 2014-04-22 03:18:15 +0000 @@ -166,7 +166,7 @@ (cl-n (min (- (or cl-end1 cl-len) cl-start1) (- (or cl-end2 cl-len) cl-start2)))) (while (>= (setq cl-n (1- cl-n)) 0) - (cl--set-elt cl-seq1 (+ cl-start1 cl-n) + (setf (elt cl-seq1 (+ cl-start1 cl-n)) (elt cl-seq2 (+ cl-start2 cl-n)))))) (if (listp cl-seq1) (let ((cl-p1 (nthcdr cl-start1 cl-seq1)) @@ -392,7 +392,7 @@ cl-seq (setq cl-seq (copy-sequence cl-seq)) (or cl-from-end - (progn (cl--set-elt cl-seq cl-i cl-new) + (progn (setf (elt cl-seq cl-i) cl-new) (setq cl-i (1+ cl-i) cl-count (1- cl-count)))) (apply 'cl-nsubstitute cl-new cl-old cl-seq :count cl-count :start cl-i cl-keys)))))) @@ -439,7 +439,7 @@ (setq cl-end (1- cl-end)) (if (cl--check-test cl-old (elt cl-seq cl-end)) (progn - (cl--set-elt cl-seq cl-end cl-new) + (setf (elt cl-seq cl-end) cl-new) (setq cl-count (1- cl-count))))) (while (and (< cl-start cl-end) (> cl-count 0)) (if (cl--check-test cl-old (aref cl-seq cl-start)) ------------------------------------------------------------ revno: 117005 committer: Daniel Colascione branch nick: trunk timestamp: Mon 2014-04-21 11:00:19 -0700 message: Remove excess parameters on cl--const-expr-val 2014-04-21 Daniel Colascione * emacs-lisp/cl-macs.el (cl--const-expr-val): We didn't need the last two parameters after all. (cl--expr-contains,cl--compiler-macro-typep,cl--compiler-macro-member) (cl--compiler-macro-assoc,cl-struct-slot-value) (cl-struct-set-slot-value): Stop using them. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2014-04-21 14:34:49 +0000 +++ lisp/ChangeLog 2014-04-21 18:00:19 +0000 @@ -1,4 +1,12 @@ -2014-04-21 Stefan Monnier +2014-04-21 Daniel Colascione + + * emacs-lisp/cl-macs.el (cl--const-expr-val): We didn't need the + last two parameters after all. + (cl--expr-contains,cl--compiler-macro-typep,cl--compiler-macro-member) + (cl--compiler-macro-assoc,cl-struct-slot-value) + (cl-struct-set-slot-value): Stop using them. + +(2014-04-21 Stefan Monnier * image-mode.el (image-mode-window-put): Don't assume there's a `t' entry in image-mode-winprops-alist. === modified file 'lisp/emacs-lisp/cl-macs.el' --- lisp/emacs-lisp/cl-macs.el 2014-04-21 01:03:39 +0000 +++ lisp/emacs-lisp/cl-macs.el 2014-04-21 18:00:19 +0000 @@ -134,15 +134,14 @@ ((symbolp x) (and (memq x '(nil t)) t)) (t t))) -(defun cl--const-expr-val (x &optional environment default) +(defun cl--const-expr-val (x) "Return the value of X known at compile-time. -If X is not known at compile time, return DEFAULT. Before -testing whether X is known at compile time, macroexpand it in -ENVIRONMENT." - (let ((x (macroexpand-all x environment))) +If X is not known at compile time, return nil. Before testing +whether X is known at compile time, macroexpand it completely in +`macroexpand-all-environment'." + (let ((x (macroexpand-all x macroexpand-all-environment))) (if (macroexp-const-p x) - (if (consp x) (nth 1 x) x) - default))) + (if (consp x) (nth 1 x) x)))) (defun cl--expr-contains (x y) "Count number of times X refers to Y. Return nil for 0 times." @@ -526,8 +525,7 @@ look `(or ,look ,(if (eq (cl--const-expr-p def) t) - `'(nil ,(cl--const-expr-val - def macroexpand-all-environment)) + `'(nil ,(cl--const-expr-val def)) `(list nil ,def)))))))) (push karg keys))))) (setq keys (nreverse keys)) @@ -2689,8 +2687,7 @@ (defun cl--compiler-macro-typep (form val type) (if (macroexp-const-p type) (macroexp-let2 macroexp-copyable-p temp val - (cl--make-type-test temp (cl--const-expr-val - type macroexpand-all-environment))) + (cl--make-type-test temp (cl--const-expr-val type))) form)) ;;;###autoload @@ -2866,8 +2863,7 @@ (defun cl--compiler-macro-member (form a list &rest keys) (let ((test (and (= (length keys) 2) (eq (car keys) :test) - (cl--const-expr-val (nth 1 keys) - macroexpand-all-environment)))) + (cl--const-expr-val (nth 1 keys))))) (cond ((eq test 'eq) `(memq ,a ,list)) ((eq test 'equal) `(member ,a ,list)) ((or (null keys) (eq test 'eql)) `(memql ,a ,list)) @@ -2875,12 +2871,11 @@ (defun cl--compiler-macro-assoc (form a list &rest keys) (let ((test (and (= (length keys) 2) (eq (car keys) :test) - (cl--const-expr-val (nth 1 keys) - macroexpand-all-environment)))) + (cl--const-expr-val (nth 1 keys))))) (cond ((eq test 'eq) `(assq ,a ,list)) ((eq test 'equal) `(assoc ,a ,list)) ((and (macroexp-const-p a) (or (null keys) (eq test 'eql))) - (if (floatp (cl--const-expr-val a macroexpand-all-environment)) + (if (floatp (cl--const-expr-val a)) `(assoc ,a ,list) `(assq ,a ,list))) (t form)))) @@ -2960,9 +2955,8 @@ (cl-define-compiler-macro cl-struct-slot-value (&whole orig struct-type slot-name inst) - (or (let* ((macenv macroexpand-all-environment) - (struct-type (cl--const-expr-val struct-type macenv)) - (slot-name (cl--const-expr-val slot-name macenv))) + (or (let* ((struct-type (cl--const-expr-val struct-type)) + (slot-name (cl--const-expr-val slot-name))) (and struct-type (symbolp struct-type) slot-name (symbolp slot-name) (assq slot-name (cl-struct-slot-info struct-type)) @@ -2974,9 +2968,8 @@ (cl-define-compiler-macro cl-struct-set-slot-value (&whole orig struct-type slot-name inst value) - (or (let* ((macenv macroexpand-all-environment) - (struct-type (cl--const-expr-val struct-type macenv)) - (slot-name (cl--const-expr-val slot-name macenv))) + (or (let* ((struct-type (cl--const-expr-val struct-type)) + (slot-name (cl--const-expr-val slot-name))) (and struct-type (symbolp struct-type) slot-name (symbolp slot-name) (assq slot-name (cl-struct-slot-info struct-type)) ------------------------------------------------------------ revno: 117004 committer: Stefan Monnier branch nick: trunk timestamp: Mon 2014-04-21 10:34:49 -0400 message: * lisp/image-mode.el (image-mode-window-put): Don't assume there's a `t' entry in image-mode-winprops-alist. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2014-04-21 09:34:21 +0000 +++ lisp/ChangeLog 2014-04-21 14:34:49 +0000 @@ -1,9 +1,12 @@ +2014-04-21 Stefan Monnier + + * image-mode.el (image-mode-window-put): Don't assume there's a `t' + entry in image-mode-winprops-alist. + 2014-04-21 Daniel Colascione - * emacs-lisp/bytecomp.el (byte-compile-recurse-toplevel): New - function. - (byte-compile-recurse-toplevel, - (byte-compile-initial-macro-environment, + * emacs-lisp/bytecomp.el (byte-compile-recurse-toplevel): New function. + (byte-compile-recurse-toplevel, byte-compile-initial-macro-environment) (byte-compile-toplevel-file-form): Use it. * emacs-lisp/cl-macs.el: @@ -14,8 +17,7 @@ * vc/vc.el (vc-root-dir): New public autoloaded function for generically finding the current VC root. * vc/vc-hooks.el (vc-not-supported): New error. - (vc-call-backend): Signal `vc-not-supported' instead of generic - error. + (vc-call-backend): Signal `vc-not-supported' instead of generic error. 2014-04-20 Daniel Colascione === modified file 'lisp/image-mode.el' --- lisp/image-mode.el 2014-04-17 03:58:25 +0000 +++ lisp/image-mode.el 2014-04-21 14:34:49 +0000 @@ -90,9 +90,8 @@ (defun image-mode-window-put (prop val &optional winprops) (unless (consp winprops) (setq winprops (image-mode-winprops winprops))) - (setcdr (assq t image-mode-winprops-alist) - (cons (cons prop val) - (delq (assq prop (cdr winprops)) (cdr winprops)))) + (unless (eq t (car winprops)) + (image-mode-window-put prop val t)) (setcdr winprops (cons (cons prop val) (delq (assq prop (cdr winprops)) (cdr winprops))))) ------------------------------------------------------------ revno: 117003 committer: Daniel Colascione branch nick: trunk timestamp: Mon 2014-04-21 02:38:44 -0700 message: Ignore a.out diff: === modified file '.bzrignore' --- .bzrignore 2013-12-12 09:20:37 +0000 +++ .bzrignore 2014-04-21 09:38:44 +0000 @@ -232,3 +232,4 @@ admin/charsets/cp51932.el admin/charsets/eucjp-ms.el admin/charsets/jisx2131-filter +a.out === modified file 'ChangeLog' --- ChangeLog 2014-04-19 17:45:20 +0000 +++ ChangeLog 2014-04-21 09:38:44 +0000 @@ -1,3 +1,8 @@ +2014-04-21 Daniel Colascione + + * .bzrignore: Add a.out to bzr ignore list (a test generates this + file). + 2014-04-19 Paul Eggert Link to glib-using libraries when checking for glib (Bug#17289). ------------------------------------------------------------ revno: 117002 committer: Daniel Colascione branch nick: trunk timestamp: Mon 2014-04-21 02:34:21 -0700 message: Correctly treat progn contents as toplevel forms when byte compiling diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2014-04-21 01:03:39 +0000 +++ lisp/ChangeLog 2014-04-21 09:34:21 +0000 @@ -1,5 +1,11 @@ 2014-04-21 Daniel Colascione + * emacs-lisp/bytecomp.el (byte-compile-recurse-toplevel): New + function. + (byte-compile-recurse-toplevel, + (byte-compile-initial-macro-environment, + (byte-compile-toplevel-file-form): Use it. + * emacs-lisp/cl-macs.el: (cl--loop-let): Properly destructure `while' clauses. === modified file 'lisp/emacs-lisp/bytecomp.el' --- lisp/emacs-lisp/bytecomp.el 2014-03-14 00:32:41 +0000 +++ lisp/emacs-lisp/bytecomp.el 2014-04-21 09:34:21 +0000 @@ -421,31 +421,46 @@ (defvar byte-compiler-error-flag) +(defun byte-compile-recurse-toplevel (form &optional non-toplevel-case) + "Implement `eval-when-compile' and `eval-and-compile'. +Return the compile-time value of FORM." + ;; Macroexpand (not macroexpand-all!) form at toplevel in case it + ;; expands into a toplevel-equivalent `progn'. See CLHS section + ;; 3.2.3.1, "Processing of Top Level Forms". The semantics are very + ;; subtle: see test/automated/bytecomp-tests.el for interesting + ;; cases. + (setf form (macroexpand form byte-compile-macro-environment)) + (if (eq (car-safe form) 'progn) + (cons 'progn + (mapcar (lambda (subform) + (byte-compile-recurse-toplevel + subform non-toplevel-case)) + (cdr form))) + (funcall non-toplevel-case form))) + (defconst byte-compile-initial-macro-environment '( ;; (byte-compiler-options . (lambda (&rest forms) ;; (apply 'byte-compiler-options-handler forms))) (declare-function . byte-compile-macroexpand-declare-function) (eval-when-compile . (lambda (&rest body) - (list - 'quote - (byte-compile-eval - (byte-compile-top-level - (byte-compile-preprocess (cons 'progn body))))))) + (let ((result nil)) + (byte-compile-recurse-toplevel + (cons 'progn body) + (lambda (form) + (setf result + (byte-compile-eval + (byte-compile-top-level + (byte-compile-preprocess form)))))) + (list 'quote result)))) (eval-and-compile . (lambda (&rest body) - ;; Byte compile before running it. Do it piece by - ;; piece, in case further expressions need earlier - ;; ones to be evaluated already, as is the case in - ;; eieio.el. - `(progn - ,@(mapcar (lambda (exp) - (let ((cexp - (byte-compile-top-level - (byte-compile-preprocess - exp)))) - (eval cexp) - cexp)) - body))))) + (byte-compile-recurse-toplevel + (cons 'progn body) + (lambda (form) + (let ((compiled (byte-compile-top-level + (byte-compile-preprocess form)))) + (eval compiled) + compiled)))))) "The default macro-environment passed to macroexpand by the compiler. Placing a macro here will cause a macro to have different semantics when expanded by the compiler as when expanded by the interpreter.") @@ -2198,9 +2213,12 @@ (t form))) ;; byte-hunk-handlers cannot call this! -(defun byte-compile-toplevel-file-form (form) - (let ((byte-compile-current-form nil)) ; close over this for warnings. - (byte-compile-file-form (byte-compile-preprocess form t)))) +(defun byte-compile-toplevel-file-form (top-level-form) + (byte-compile-recurse-toplevel + top-level-form + (lambda (form) + (let ((byte-compile-current-form nil)) ; close over this for warnings. + (byte-compile-file-form (byte-compile-preprocess form t)))))) ;; byte-hunk-handlers can call this. (defun byte-compile-file-form (form) @@ -2942,8 +2960,11 @@ interactive-only)) (t ".")))) (if (eq (car-safe (symbol-function (car form))) 'macro) - (byte-compile-log-warning - (format "Forgot to expand macro %s" (car form)) nil :error)) + (progn + (debug) + (byte-compile-log-warning + (format "Forgot to expand macro %s in %S" (car form) form) + nil :error))) (if (and handler ;; Make sure that function exists. (and (functionp handler) === modified file 'lisp/emacs-lisp/macroexp.el' --- lisp/emacs-lisp/macroexp.el 2014-01-01 07:43:34 +0000 +++ lisp/emacs-lisp/macroexp.el 2014-04-21 09:34:21 +0000 @@ -97,7 +97,10 @@ (defun macroexp--compiler-macro (handler form) (condition-case err (apply handler form (cdr form)) - (error (message "Compiler-macro error for %S: %S" (car form) err) + (error + (message "--------------------------------------------------") + (backtrace) + (message "Compiler-macro error for %S: %S" (car form) err) form))) (defun macroexp--funcall-if-compiled (_form) === modified file 'test/ChangeLog' --- test/ChangeLog 2014-04-21 01:28:55 +0000 +++ test/ChangeLog 2014-04-21 09:34:21 +0000 @@ -1,5 +1,12 @@ 2014-04-21 Daniel Colascione + * automated/bytecomp-tests.el (test-byte-comp-compile-and-load): + New function. + (test-byte-comp-macro-expansion) + (test-byte-comp-macro-expansion-eval-and-compile) + (test-byte-comp-macro-expansion-eval-when-compile) + (test-byte-comp-macro-expand-lexical-override): New tests. + * automated/cl-lib.el (cl-loop-destructuring-with): New test. (cl-the): Fix cl-the test. === modified file 'test/automated/bytecomp-tests.el' --- test/automated/bytecomp-tests.el 2014-01-01 07:43:34 +0000 +++ test/automated/bytecomp-tests.el 2014-04-21 09:34:21 +0000 @@ -305,6 +305,56 @@ 'face fail-face))) (insert "\n")))) +(defun test-byte-comp-compile-and-load (&rest forms) + (let ((elfile nil) + (elcfile nil)) + (unwind-protect + (progn + (setf elfile (make-temp-file "test-bytecomp" nil ".el")) + (setf elcfile (make-temp-file "test-bytecomp" nil ".elc")) + (with-temp-buffer + (dolist (form forms) + (print form (current-buffer))) + (write-region (point-min) (point-max) elfile)) + (let ((byte-compile-dest-file elcfile)) + (byte-compile-file elfile t))) + (when elfile (delete-file elfile)) + (when elcfile (delete-file elcfile))))) +(put 'test-byte-comp-compile-and-load 'lisp-indent-function 0) + +(ert-deftest test-byte-comp-macro-expansion () + (test-byte-comp-compile-and-load + '(progn (defmacro abc (arg) 1) (defun def () (abc 2)))) + (should (equal (funcall 'def) 1))) + +(ert-deftest test-byte-comp-macro-expansion-eval-and-compile () + (test-byte-comp-compile-and-load + '(eval-and-compile (defmacro abc (arg) -1) (defun def () (abc 2)))) + (should (equal (funcall 'def) -1))) + +(ert-deftest test-byte-comp-macro-expansion-eval-when-compile () + ;; Make sure we interpret eval-when-compile forms properly. CLISP + ;; and SBCL interpreter eval-when-compile (well, the CL equivalent) + ;; in the same way. + (test-byte-comp-compile-and-load + '(eval-when-compile + (defmacro abc (arg) -10) + (defun abc-1 () (abc 2))) + '(defmacro abc-2 () (abc-1)) + '(defun def () (abc-2))) + (should (equal (funcall 'def) -10))) + +(ert-deftest test-byte-comp-macro-expand-lexical-override () + ;; Intuitively, one might expect the defmacro to override the + ;; macrolet since macrolet's is explicitly called out as being + ;; equivalent to toplevel, but CLISP and SBCL both evaluate the form + ;; this way, so we should too. + (test-byte-comp-compile-and-load + '(require 'cl-lib) + '(cl-macrolet ((m () 4)) + (defmacro m () 5) + (defun def () (m)))) + (should (equal (funcall 'def) 4))) ;; Local Variables: ;; no-byte-compile: t ------------------------------------------------------------ revno: 117001 committer: Daniel Colascione branch nick: trunk timestamp: Sun 2014-04-20 18:28:55 -0700 message: Fix cl-the test diff: === modified file 'test/ChangeLog' --- test/ChangeLog 2014-04-21 01:03:39 +0000 +++ test/ChangeLog 2014-04-21 01:28:55 +0000 @@ -1,6 +1,7 @@ 2014-04-21 Daniel Colascione * automated/cl-lib.el (cl-loop-destructuring-with): New test. + (cl-the): Fix cl-the test. 2014-04-20 Daniel Colascione === modified file 'test/automated/cl-lib.el' --- test/automated/cl-lib.el 2014-04-21 01:03:39 +0000 +++ test/automated/cl-lib.el 2014-04-21 01:28:55 +0000 @@ -214,11 +214,11 @@ '((cl-tag-slot) (abc :readonly t) (def)))))) (ert-deftest cl-the () - (should (eql (the integer 42) 42)) - (should-error (the integer "abc")) - (let ((sideffect 0)) - (should (= (the integer (incf sideffect)) 1)) - (should (= sideffect 1)))) + (should (eql (cl-the integer 42) 42)) + (should-error (cl-the integer "abc")) + (let ((side-effect 0)) + (should (= (cl-the integer (cl-incf side-effect)) 1)) + (should (= side-effect 1)))) (ert-deftest cl-loop-destructuring-with () (should (equal (cl-loop with (a b c) = '(1 2 3) return (+ a b c)) 6)))