(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.
(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))))))
(comp-log "\n\f\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.
(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
,@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
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. */