From: Alan Mackenzie Date: Tue, 18 Jul 2023 11:04:27 +0000 (+0000) Subject: Revert whitespace changes. Restore a condition-case in comp.el X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=aba3d13ea8d712bca1b3f23ac7db7e38c2165b3c;p=emacs.git Revert whitespace changes. Restore a condition-case in comp.el * lisp/emacs-lisp/byte-run.el (defun) * lisp/emacs-lisp/cl-generic.el (cl-generic-define-context-rewriter) * lisp/emacs-lisp/pcase.el (pcase--expand) * src/eval.c (Ffunction): Revert whitespace changes. * lisp/emacs-lisp/comp.el (comp--native-compile): Revert deletion of a condition-case. * lisp/emacs-lisp/nadvice.el (advice--equal): Remove commented out diagnostics. --- diff --git a/lisp/emacs-lisp/byte-run.el b/lisp/emacs-lisp/byte-run.el index 9c865613399..946db634d7e 100644 --- a/lisp/emacs-lisp/byte-run.el +++ b/lisp/emacs-lisp/byte-run.el @@ -470,9 +470,9 @@ The return value is undefined. (bare-symbol name) (cons arglist body) )))))) - (if declarations - (cons 'prog1 (cons def (car declarations))) - def)))) + (if declarations + (cons 'prog1 (cons def (car declarations))) + def)))) (defmacro lambda-arglist (l) "Given a lambda form L, return its arglist. diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el index 5ff1bcfa471..1297ce6d2e5 100644 --- a/lisp/emacs-lisp/cl-generic.el +++ b/lisp/emacs-lisp/cl-generic.el @@ -466,16 +466,17 @@ the specializer used will be the one returned by BODY." (apply (lambda (,@λ-lift ,@args) ,nbody) ,@λ-lift ,arglist))))))) (t - (cons t `#'(lambda ,defsym (,cnm ,@args) - ,@(car parsed-body) - ,(macroexp-warn-and-return - "cl-defmethod used without lexical-binding" - (if (not (assq nmp uses-cnm)) - nbody - `(let ((,nmp (lambda () - (cl--generic-isnot-nnm-p ,cnm)))) - ,nbody)) - 'lexical t))))) + (cons t + `#'(lambda ,defsym (,cnm ,@args) + ,@(car parsed-body) + ,(macroexp-warn-and-return + "cl-defmethod used without lexical-binding" + (if (not (assq nmp uses-cnm)) + nbody + `(let ((,nmp (lambda () + (cl--generic-isnot-nnm-p ,cnm)))) + ,nbody)) + 'lexical t))))) )) (f (error "Unexpected macroexpansion result: %S" f)))))) diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index f228523d801..375f003592c 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -4171,26 +4171,45 @@ the deferred compilation mechanism." (comp-log "\n \n" 1) (unwind-protect (progn - (cl-loop - with report = nil - for t0 = (current-time) - for pass in comp-passes - unless (memq pass comp-disabled-passes) - do - (comp-log (format "(%s) Running pass %s:\n" - function-or-file pass) - 2) - (setf data (funcall pass data)) - (push (cons pass (float-time (time-since t0))) report) - (cl-loop for f in (alist-get pass comp-post-pass-hooks) - do (funcall f data)) - finally - (when comp-log-time-report - (comp-log (format "Done compiling %s" data) 0) - (cl-loop for (pass . time) in (reverse report) - do (comp-log (format "Pass %s took: %fs." - pass time) - 0)))) + (condition-case err + (cl-loop + with report = nil + for t0 = (current-time) + for pass in comp-passes + unless (memq pass comp-disabled-passes) + do + (comp-log (format "(%s) Running pass %s:\n" + function-or-file pass) + 2) + (setf data (funcall pass data)) + (push (cons pass (float-time (time-since t0))) report) + (cl-loop for f in (alist-get pass comp-post-pass-hooks) + do (funcall f data)) + finally + (when comp-log-time-report + (comp-log (format "Done compiling %s" data) 0) + (cl-loop for (pass . time) in (reverse report) + do (comp-log (format "Pass %s took: %fs." + pass time) 0)))) + (native-compiler-skip) + (t + (let ((err-val (cdr err))) + ;; If we are doing an async native compilation print the + ;; error in the correct format so is parsable and abort. + (if (and comp-async-compilation + (not (eq (car err) 'native-compiler-error))) + (progn + (message (if err-val + "%s: Error: %s %s" + "%s: Error %s") + function-or-file + (get (car err) 'error-message) + (car-safe err-val)) + (kill-emacs -1)) + ;; Otherwise re-signal it adding the compilation input. + (signal (car err) (if (consp err-val) + (cons function-or-file err-val) + (list function-or-file err-val))))))) (if (stringp function-or-file) data ;; So we return the compiled function. diff --git a/lisp/emacs-lisp/nadvice.el b/lisp/emacs-lisp/nadvice.el index 7700927bd67..6ccc8aa71c9 100644 --- a/lisp/emacs-lisp/nadvice.el +++ b/lisp/emacs-lisp/nadvice.el @@ -292,9 +292,7 @@ On such sameness, ADV is returned, otherwise nil." (defun advice--member-p (function use-name definition) (let ((found nil)) - ;; (message "advice--member-p: function: %S" function) (while (and (not found) (advice--p definition)) - ;; (message "advice--member-p: elt: %S" (advice--car definition)) (if (if (eq use-name :use-both) (or (advice--equal function diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el index 00cda84ab40..1a4beb45268 100644 --- a/lisp/emacs-lisp/pcase.el +++ b/lisp/emacs-lisp/pcase.el @@ -475,13 +475,13 @@ This can be nil, meaning never create such a function.") ,@code) ;; Several occurrence of this non-small branch in ;; the output. - (unless bsym - (setq bsym (make-symbol - (format "pcase-%d" (length defs)))) - (push `(,bsym (lambda ,(mapcar #'car varvals) - ,@ignores ,@code)) - defs)) - `(funcall ,bsym ,@(mapcar #'cadr varvals))))))))) + (unless bsym + (setq bsym (make-symbol + (format "pcase-%d" (length defs)))) + (push `(,bsym (lambda ,(mapcar #'car varvals) + ,@ignores ,@code)) + defs)) + `(funcall ,bsym ,@(mapcar #'cadr varvals))))))))) (main (pcase-compile-patterns exp diff --git a/src/eval.c b/src/eval.c index 83877008d8f..4cd26afbf3e 100644 --- a/src/eval.c +++ b/src/eval.c @@ -564,9 +564,9 @@ usage: (function ARG) */) if (NILP (Vinternal_make_interpreted_closure_function)) return Fcons (Qclosure, Fcons (Vinternal_interpreter_environment, cdr)); else - return call2 (Vinternal_make_interpreted_closure_function, + return call2 (Vinternal_make_interpreted_closure_function, Fcons (Qlambda, cdr), - Vinternal_interpreter_environment); + Vinternal_interpreter_environment); } else /* Simply quote the argument. */