summaryrefslogtreecommitdiff
path: root/lisp/emacs-lisp
diff options
context:
space:
mode:
Diffstat (limited to 'lisp/emacs-lisp')
-rw-r--r--lisp/emacs-lisp/byte-opt.el47
-rw-r--r--lisp/emacs-lisp/bytecomp.el138
-rw-r--r--lisp/emacs-lisp/cconv.el43
-rw-r--r--lisp/emacs-lisp/cl-extra.el24
-rw-r--r--lisp/emacs-lisp/cl-loaddefs.el2
-rw-r--r--lisp/emacs-lisp/debug.el5
-rw-r--r--lisp/emacs-lisp/eieio-comp.el145
-rw-r--r--lisp/emacs-lisp/eieio.el45
-rw-r--r--lisp/emacs-lisp/macroexp.el5
9 files changed, 169 insertions, 285 deletions
diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el
index c9cc4618967..342dd8b71d1 100644
--- a/lisp/emacs-lisp/byte-opt.el
+++ b/lisp/emacs-lisp/byte-opt.el
@@ -531,7 +531,11 @@
;; However, don't actually bother calling `ignore'.
`(prog1 nil . ,(mapcar 'byte-optimize-form (cdr form))))
+ ((eq fn 'internal-make-closure)
+ form)
+
((not (symbolp fn))
+ (debug)
(byte-compile-warn "`%s' is a malformed function"
(prin1-to-string fn))
form)
@@ -1472,7 +1476,8 @@
byte-cdr-safe byte-cons byte-list1 byte-list2 byte-point byte-point-max
byte-point-min byte-following-char byte-preceding-char
byte-current-column byte-eolp byte-eobp byte-bolp byte-bobp
- byte-current-buffer byte-stack-ref))
+ byte-current-buffer byte-stack-ref ;; byte-closed-var
+ ))
(defconst byte-compile-side-effect-free-ops
(nconc
@@ -1680,11 +1685,18 @@ If FOR-EFFECT is non-nil, the return value is assumed to be of no importance."
;; const goto-if-* --> whatever
;;
((and (eq 'byte-constant (car lap0))
- (memq (car lap1) byte-conditional-ops))
+ (memq (car lap1) byte-conditional-ops)
+ ;; If the `byte-constant's cdr is not a cons cell, it has
+ ;; to be an index into the constant pool); even though
+ ;; it'll be a constant, that constant is not known yet
+ ;; (it's typically a free variable of a closure, so will
+ ;; only be known when the closure will be built at
+ ;; run-time).
+ (consp (cdr lap0)))
(cond ((if (or (eq (car lap1) 'byte-goto-if-nil)
- (eq (car lap1) 'byte-goto-if-nil-else-pop))
- (car (cdr lap0))
- (not (car (cdr lap0))))
+ (eq (car lap1) 'byte-goto-if-nil-else-pop))
+ (car (cdr lap0))
+ (not (car (cdr lap0))))
(byte-compile-log-lap " %s %s\t-->\t<deleted>"
lap0 lap1)
(setq rest (cdr rest)
@@ -1696,11 +1708,11 @@ If FOR-EFFECT is non-nil, the return value is assumed to be of no importance."
(when (memq (car lap1) byte-goto-always-pop-ops)
(setq lap (delq lap0 lap)))
(setcar lap1 'byte-goto)))
- (setq keep-going t))
+ (setq keep-going t))
;;
;; varref-X varref-X --> varref-X dup
;; varref-X [dup ...] varref-X --> varref-X [dup ...] dup
- ;; stackref-X [dup ...] stackref-X+N --> stackref-X [dup ...] dup
+ ;; stackref-X [dup ...] stackref-X+N --> stackref-X [dup ...] dup
;; We don't optimize the const-X variations on this here,
;; because that would inhibit some goto optimizations; we
;; optimize the const-X case after all other optimizations.
@@ -1877,18 +1889,21 @@ If FOR-EFFECT is non-nil, the return value is assumed to be of no importance."
(cons 'byte-discard byte-conditional-ops)))
(not (eq lap1 (car tmp))))
(setq tmp2 (car tmp))
- (cond ((memq (car tmp2)
- (if (null (car (cdr lap0)))
- '(byte-goto-if-nil byte-goto-if-nil-else-pop)
- '(byte-goto-if-not-nil
- byte-goto-if-not-nil-else-pop)))
+ (cond ((when (consp (cdr lap0))
+ (memq (car tmp2)
+ (if (null (car (cdr lap0)))
+ '(byte-goto-if-nil byte-goto-if-nil-else-pop)
+ '(byte-goto-if-not-nil
+ byte-goto-if-not-nil-else-pop))))
(byte-compile-log-lap " %s goto [%s]\t-->\t%s %s"
lap0 tmp2 lap0 tmp2)
(setcar lap1 (car tmp2))
(setcdr lap1 (cdr tmp2))
;; Let next step fix the (const,goto-if*) sequence.
- (setq rest (cons nil rest)))
- (t
+ (setq rest (cons nil rest))
+ (setq keep-going t))
+ ((or (consp (cdr lap0))
+ (eq (car tmp2) 'byte-discard))
;; Jump one step further
(byte-compile-log-lap
" %s goto [%s]\t-->\t<deleted> goto <skip>"
@@ -1897,8 +1912,8 @@ If FOR-EFFECT is non-nil, the return value is assumed to be of no importance."
(setcdr tmp (cons (byte-compile-make-tag)
(cdr tmp))))
(setcdr lap1 (car (cdr tmp)))
- (setq lap (delq lap0 lap))))
- (setq keep-going t))
+ (setq lap (delq lap0 lap))
+ (setq keep-going t))))
;;
;; X: varref-Y ... varset-Y goto-X -->
;; X: varref-Y Z: ... dup varset-Y goto-Z
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index 771306bb0e6..6bc2b3b5617 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -794,10 +794,13 @@ CONST2 may be evaulated multiple times."
;; goto
(byte-compile-push-bytecodes opcode nil (cdr off) bytes pc)
(push bytes patchlist))
- ((and (consp off)
- ;; Variable or constant reference
- (progn (setq off (cdr off))
- (eq op 'byte-constant)))
+ ((or (and (consp off)
+ ;; Variable or constant reference
+ (progn
+ (setq off (cdr off))
+ (eq op 'byte-constant)))
+ (and (eq op 'byte-constant) ;; 'byte-closed-var
+ (integerp off)))
;; constant ref
(if (< off byte-constant-limit)
(byte-compile-push-bytecodes (+ byte-constant off)
@@ -1480,6 +1483,7 @@ symbol itself."
((byte-compile-const-symbol-p ,form))))
(defmacro byte-compile-close-variables (&rest body)
+ (declare (debug t))
(cons 'let
(cons '(;;
;; Close over these variables to encapsulate the
@@ -1510,6 +1514,7 @@ symbol itself."
body)))
(defmacro displaying-byte-compile-warnings (&rest body)
+ (declare (debug t))
`(let* ((--displaying-byte-compile-warnings-fn (lambda () ,@body))
(warning-series-started
(and (markerp warning-series)
@@ -1930,7 +1935,7 @@ With argument ARG, insert value in current buffer after the form."
(byte-compile-warn "!! The file uses old-style backquotes !!
This functionality has been obsolete for more than 10 years already
and will be removed soon. See (elisp)Backquote in the manual."))
- (byte-compile-file-form form)))
+ (byte-compile-toplevel-file-form form)))
;; Compile pending forms at end of file.
(byte-compile-flush-pending)
;; Make warnings about unresolved functions
@@ -2041,8 +2046,8 @@ Call from the source buffer."
;; defalias calls are output directly by byte-compile-file-form-defmumble;
;; it does not pay to first build the defalias in defmumble and then parse
;; it here.
- (if (and (memq (car-safe form) '(defun defmacro defvar defvaralias defconst autoload
- custom-declare-variable))
+ (if (and (memq (car-safe form) '(defun defmacro defvar defvaralias defconst
+ autoload custom-declare-variable))
(stringp (nth 3 form)))
(byte-compile-output-docform nil nil '("\n(" 3 ")") form nil
(memq (car form)
@@ -2182,12 +2187,17 @@ list that represents a doc string reference.
byte-compile-maxdepth 0
byte-compile-output nil))))
-(defun byte-compile-file-form (form)
- (let ((byte-compile-current-form nil) ; close over this for warnings.
- bytecomp-handler)
+;; byte-hunk-handlers cannot call this!
+(defun byte-compile-toplevel-file-form (form)
+ (let ((byte-compile-current-form nil)) ; close over this for warnings.
(setq form (macroexpand-all form byte-compile-macro-environment))
(if lexical-binding
(setq form (cconv-closure-convert form)))
+ (byte-compile-file-form form)))
+
+;; byte-hunk-handlers can call this.
+(defun byte-compile-file-form (form)
+ (let (bytecomp-handler)
(cond ((not (consp form))
(byte-compile-keep-pending form))
((and (symbolp (car form))
@@ -2541,7 +2551,7 @@ If FORM is a lambda or a macro, byte-compile it as a function."
(if lexical-binding
(setq fun (cconv-closure-convert fun)))
;; Get rid of the `function' quote added by the `lambda' macro.
- (setq fun (cadr fun))
+ (if (eq (car-safe fun) 'function) (setq fun (cadr fun)))
(setq fun (if macro
(cons 'macro (byte-compile-lambda fun))
(byte-compile-lambda fun)))
@@ -2654,7 +2664,7 @@ If FORM is a lambda or a macro, byte-compile it as a function."
;; of the list FUN and `byte-compile-set-symbol-position' is not called.
;; Use this feature to avoid calling `byte-compile-set-symbol-position'
;; for symbols generated by the byte compiler itself.
-(defun byte-compile-lambda (bytecomp-fun &optional add-lambda)
+(defun byte-compile-lambda (bytecomp-fun &optional add-lambda reserved-csts)
(if add-lambda
(setq bytecomp-fun (cons 'lambda bytecomp-fun))
(unless (eq 'lambda (car-safe bytecomp-fun))
@@ -2702,14 +2712,16 @@ If FORM is a lambda or a macro, byte-compile it as a function."
(byte-compile-warn "malformed interactive spec: %s"
(prin1-to-string bytecomp-int)))))
;; Process the body.
- (let* ((byte-compile-lexical-environment
- ;; If doing lexical binding, push a new lexical environment
- ;; containing just the args (since lambda expressions
- ;; should be closed by now).
- (and lexical-binding
- (byte-compile-make-lambda-lexenv bytecomp-fun)))
- (compiled
- (byte-compile-top-level (cons 'progn bytecomp-body) nil 'lambda)))
+ (let* ((compiled
+ (byte-compile-top-level (cons 'progn bytecomp-body) nil 'lambda
+ ;; If doing lexical binding, push a new
+ ;; lexical environment containing just the
+ ;; args (since lambda expressions should be
+ ;; closed by now).
+ (and lexical-binding
+ (byte-compile-make-lambda-lexenv
+ bytecomp-fun))
+ reserved-csts)))
;; Build the actual byte-coded function.
(if (eq 'byte-code (car-safe compiled))
(apply 'make-byte-code
@@ -2740,6 +2752,8 @@ If FORM is a lambda or a macro, byte-compile it as a function."
;; A simple lambda is just a constant.
(byte-compile-constant code)))
+(defvar byte-compile-reserved-constants 0)
+
(defun byte-compile-constants-vector ()
;; Builds the constants-vector from the current variables and constants.
;; This modifies the constants from (const . nil) to (const . offset).
@@ -2748,7 +2762,7 @@ If FORM is a lambda or a macro, byte-compile it as a function."
;; Next up to byte-constant-limit are constants, still with one-byte codes.
;; Next variables again, to get 2-byte codes for variable lookup.
;; The rest of the constants and variables need 3-byte byte-codes.
- (let* ((i -1)
+ (let* ((i (1- byte-compile-reserved-constants))
(rest (nreverse byte-compile-variables)) ; nreverse because the first
(other (nreverse byte-compile-constants)) ; vars often are used most.
ret tmp
@@ -2759,11 +2773,15 @@ If FORM is a lambda or a macro, byte-compile it as a function."
limit)
(while (or rest other)
(setq limit (car limits))
- (while (and rest (not (eq i limit)))
- (if (setq tmp (assq (car (car rest)) ret))
- (setcdr (car rest) (cdr tmp))
+ (while (and rest (< i limit))
+ (cond
+ ((numberp (car rest))
+ (assert (< (car rest) byte-compile-reserved-constants)))
+ ((setq tmp (assq (car (car rest)) ret))
+ (setcdr (car rest) (cdr tmp)))
+ (t
(setcdr (car rest) (setq i (1+ i)))
- (setq ret (cons (car rest) ret)))
+ (setq ret (cons (car rest) ret))))
(setq rest (cdr rest)))
(setq limits (cdr limits)
rest (prog1 other
@@ -2772,7 +2790,8 @@ If FORM is a lambda or a macro, byte-compile it as a function."
;; Given an expression FORM, compile it and return an equivalent byte-code
;; expression (a call to the function byte-code).
-(defun byte-compile-top-level (form &optional for-effect output-type)
+(defun byte-compile-top-level (form &optional for-effect output-type
+ lexenv reserved-csts)
;; OUTPUT-TYPE advises about how form is expected to be used:
;; 'eval or nil -> a single form,
;; 'progn or t -> a list of forms,
@@ -2783,9 +2802,8 @@ If FORM is a lambda or a macro, byte-compile it as a function."
(byte-compile-tag-number 0)
(byte-compile-depth 0)
(byte-compile-maxdepth 0)
- (byte-compile-lexical-environment
- (when (eq output-type 'lambda)
- byte-compile-lexical-environment))
+ (byte-compile-lexical-environment lexenv)
+ (byte-compile-reserved-constants (or reserved-csts 0))
(byte-compile-output nil))
(if (memq byte-optimize '(t source))
(setq form (byte-optimize-form form for-effect)))
@@ -2904,6 +2922,8 @@ If FORM is a lambda or a macro, byte-compile it as a function."
(bytecomp-body
(list bytecomp-body))))
+;; FIXME: Like defsubst's, this hunk-handler won't be called any more
+;; because the macro is expanded away before we see it.
(put 'declare-function 'byte-hunk-handler 'byte-compile-declare-function)
(defun byte-compile-declare-function (form)
(push (cons (nth 1 form)
@@ -2950,12 +2970,6 @@ If FORM is a lambda or a macro, byte-compile it as a function."
(memq bytecomp-fn byte-compile-interactive-only-functions)
(byte-compile-warn "`%s' used from Lisp code\n\
That command is designed for interactive use only" bytecomp-fn))
- (when (byte-compile-warning-enabled-p 'callargs)
- (if (memq bytecomp-fn
- '(custom-declare-group custom-declare-variable
- custom-declare-face))
- (byte-compile-nogroup-warn form))
- (byte-compile-callargs-warn form))
(if (and (fboundp (car form))
(eq (car-safe (symbol-function (car form))) 'macro))
(byte-compile-report-error
@@ -2985,6 +2999,13 @@ That command is designed for interactive use only" bytecomp-fn))
(byte-compile-discard)))
(defun byte-compile-normal-call (form)
+ (when (and (byte-compile-warning-enabled-p 'callargs)
+ (symbolp (car form)))
+ (if (memq (car form)
+ '(custom-declare-group custom-declare-variable
+ custom-declare-face))
+ (byte-compile-nogroup-warn form))
+ (byte-compile-callargs-warn form))
(if byte-compile-generate-call-tree
(byte-compile-annotate-call-tree form))
(when (and for-effect (eq (car form) 'mapcar)
@@ -3037,7 +3058,7 @@ If BINDING is non-nil, VAR is being bound."
(boundp var)
(memq var byte-compile-bound-variables)
(memq var byte-compile-free-references))
- (byte-compile-warn "reference to free variable `%s'" var)
+ (byte-compile-warn "reference to free variable `%S'" var)
(push var byte-compile-free-references))
(byte-compile-dynamic-variable-op 'byte-varref var))))
@@ -3082,26 +3103,6 @@ If BINDING is non-nil, VAR is being bound."
(defun byte-compile-push-constant (const)
(let ((for-effect nil))
(inline (byte-compile-constant const))))
-
-(defun byte-compile-push-unknown-constant (&optional id)
- "Generate code to push a `constant' who's value isn't known yet.
-A tag is returned which may then later be passed to
-`byte-compile-resolve-unknown-constant' to finalize the value.
-The optional argument ID is a tag returned by an earlier call to
-`byte-compile-push-unknown-constant', in which case the same constant is
-pushed again."
- (unless id
- (setq id (list (make-symbol "unknown")))
- (push id byte-compile-constants))
- (byte-compile-out 'byte-constant id)
- id)
-
-(defun byte-compile-resolve-unknown-constant (id value)
- "Give an `unknown constant' a value.
-ID is the tag returned by `byte-compile-push-unknown-constant'. and VALUE
-is the value it should have."
- (setcar id value))
-
;; Compile those primitive ordinary functions
;; which have special byte codes just for speed.
@@ -3345,18 +3346,23 @@ discarding."
(defconst byte-compile--env-var (make-symbol "env"))
(defun byte-compile-make-closure (form)
- ;; FIXME: don't use `curry'!
- (byte-compile-form
- (unless for-effect
- `(curry (function (lambda (,byte-compile--env-var . ,(nth 1 form))
- . ,(nthcdr 3 form)))
- (vector . ,(nth 2 form))))
- for-effect))
+ (if for-effect (setq for-effect nil)
+ (let* ((vars (nth 1 form))
+ (env (nth 2 form))
+ (body (nthcdr 3 form))
+ (fun
+ (byte-compile-lambda `(lambda ,vars . ,body) nil (length env))))
+ (assert (byte-code-function-p fun))
+ (byte-compile-form `(make-byte-code
+ ',(aref fun 0) ',(aref fun 1)
+ (vconcat (vector . ,env) ',(aref fun 2))
+ ,@(nthcdr 3 (mapcar (lambda (x) `',x) fun)))))))
+
(defun byte-compile-get-closed-var (form)
- (byte-compile-form (unless for-effect
- `(aref ,byte-compile--env-var ,(nth 1 form)))
- for-effect))
+ (if for-effect (setq for-effect nil)
+ (byte-compile-out 'byte-constant ;; byte-closed-var
+ (nth 1 form))))
;; Compile a function that accepts one or more args and is right-associative.
;; We do it by left-associativity so that the operations
diff --git a/lisp/emacs-lisp/cconv.el b/lisp/emacs-lisp/cconv.el
index 6aa4b7e0a61..bc7ecb1ad55 100644
--- a/lisp/emacs-lisp/cconv.el
+++ b/lisp/emacs-lisp/cconv.el
@@ -47,19 +47,14 @@
;; (lambda (v1 ...) ... fv1 fv2 ...) => (lambda (v1 ... fv1 fv2 ) ... fv1 fv2 .)
;; if the function is suitable for lambda lifting (if all calls are known)
;;
-;; (lambda (v1 ...) ... fv ...) =>
-;; (curry (lambda (env v1 ...) ... env ...) env)
-;; if the function has only 1 free variable
-;;
-;; and finally
-;; (lambda (v1 ...) ... fv1 fv2 ...) =>
-;; (curry (lambda (env v1 ..) .. (aref env 0) (aref env 1) ..) (vector fv1 fv2))
-;; if the function has 2 or more free variables.
+;; (lambda (v0 ...) ... fv0 .. fv1 ...) =>
+;; (internal-make-closure (v0 ...) (fv1 ...)
+;; ... (internal-get-closed-var 0) ... (internal-get-closed-var 1) ...)
;;
;; If the function has no free variables, we don't do anything.
;;
;; If a variable is mutated (updated by setq), and it is used in a closure
-;; we wrap it's definition with list: (list val) and we also replace
+;; we wrap its definition with list: (list val) and we also replace
;; var => (car var) wherever this variable is used, and also
;; (setq var value) => (setcar var value) where it is updated.
;;
@@ -71,15 +66,12 @@
;;; Code:
;;; TODO:
+;; - pay attention to `interactive': its arg is run in an empty env.
;; - canonize code in macro-expand so we don't have to handle (let (var) body)
;; and other oddities.
;; - Change new byte-code representation, so it directly gives the
;; number of mandatory and optional arguments as well as whether or
;; not there's a &rest arg.
-;; - Use abstract `make-closure' and `closure-ref' expressions, which bytecomp
-;; should turn into building corresponding byte-code function.
-;; - don't use `curry', instead build a new compiled-byte-code object
-;; (merge the closure env into the static constants pool).
;; - warn about unused lexical vars.
;; - clean up cconv-closure-convert-rec, especially the `let' binding part.
;; - new byte codes for unwind-protect, catch, and condition-case so that
@@ -184,8 +176,8 @@ Returns a list of free variables."
;; We call cconv-freevars only for functions(lambdas)
;; defun, defconst, defvar are not allowed to be inside
;; a function (lambda).
- ;; FIXME: should be a byte-compile-report-error!
- (error "Invalid form: %s inside a function" sym))
+ ;; (error "Invalid form: %s inside a function" sym)
+ (cconv-freevars `(progn ,@(cddr form)) fvrs))
(`(,_ . ,body-forms) ; First element is (like) a function.
(dolist (exp body-forms)
@@ -537,6 +529,9 @@ Returns a form where all lambdas don't have any free variables."
`(internal-make-closure
,vars ,envector . ,body-forms-new)))))
+ (`(internal-make-closure . ,_)
+ (error "Internal byte-compiler error: cconv called twice"))
+
(`(function . ,_) form) ; Same as quote.
;defconst, defvar
@@ -599,20 +594,18 @@ Returns a form where all lambdas don't have any free variables."
;condition-case
(`(condition-case ,var ,protected-form . ,handlers)
- (let ((handlers-new '())
- (newform (cconv-closure-convert-rec
+ (let ((newform (cconv-closure-convert-rec
`(function (lambda () ,protected-form))
emvrs fvrs envs lmenvs)))
(setq fvrs (remq var fvrs))
- (dolist (handler handlers)
- (push (list (car handler)
- (cconv-closure-convert-rec
- `(function (lambda (,(or var cconv--dummy-var))
- ,@(cdr handler)))
- emvrs fvrs envs lmenvs))
- handlers-new))
`(condition-case :fun-body ,newform
- ,@(nreverse handlers-new))))
+ ,@(mapcar (lambda (handler)
+ (list (car handler)
+ (cconv-closure-convert-rec
+ (let ((arg (or var cconv--dummy-var)))
+ `(function (lambda (,arg) ,@(cdr handler))))
+ emvrs fvrs envs lmenvs)))
+ handlers))))
(`(,(and head (or `catch `unwind-protect)) ,form . ,body)
`(,head ,(cconv-closure-convert-rec form emvrs fvrs envs lmenvs)
diff --git a/lisp/emacs-lisp/cl-extra.el b/lisp/emacs-lisp/cl-extra.el
index 12dafe274b9..7468a0237cf 100644
--- a/lisp/emacs-lisp/cl-extra.el
+++ b/lisp/emacs-lisp/cl-extra.el
@@ -766,21 +766,15 @@ This also does some trivial optimizations to make the form prettier."
(eq (car-safe (car body)) 'interactive))
(push (list 'quote (pop body)) decls))
(put (car (last cl-closure-vars)) 'used t)
- (append
- (list 'list '(quote lambda) '(quote (&rest --cl-rest--)))
- (sublis sub (nreverse decls))
- (list
- (list* 'list '(quote apply)
- (list 'quote
- (list 'function
- (list* 'lambda
- (append new (cadadr form))
- (sublis sub body))))
- (nconc (mapcar (function
- (lambda (x)
- (list 'list '(quote quote) x)))
- cl-closure-vars)
- '((quote --cl-rest--)))))))
+ `(list 'lambda '(&rest --cl-rest--)
+ ,@(sublis sub (nreverse decls))
+ (list 'apply
+ (list 'quote
+ #'(lambda ,(append new (cadadr form))
+ ,@(sublis sub body)))
+ ,@(nconc (mapcar (lambda (x) `(list 'quote ,x))
+ cl-closure-vars)
+ '((quote --cl-rest--))))))
(list (car form) (list* 'lambda (cadadr form) body))))
(let ((found (assq (cadr form) env)))
(if (and found (ignore-errors
diff --git a/lisp/emacs-lisp/cl-loaddefs.el b/lisp/emacs-lisp/cl-loaddefs.el
index bd50c75bcc3..df9460154e8 100644
--- a/lisp/emacs-lisp/cl-loaddefs.el
+++ b/lisp/emacs-lisp/cl-loaddefs.el
@@ -10,7 +10,7 @@
;;;;;; ceiling* floor* isqrt lcm gcd cl-progv-before cl-set-frame-visible-p
;;;;;; cl-map-overlays cl-map-intervals cl-map-keymap-recursively
;;;;;; notevery notany every some mapcon mapcan mapl maplist map
-;;;;;; cl-mapcar-many equalp coerce) "cl-extra" "cl-extra.el" "2bfbae6523c842d511b8c8d88658825a")
+;;;;;; cl-mapcar-many equalp coerce) "cl-extra" "cl-extra.el" "26339d9571f9485bf34fa6d2ae38fc84")
;;; Generated autoloads from cl-extra.el
(autoload 'coerce "cl-extra" "\
diff --git a/lisp/emacs-lisp/debug.el b/lisp/emacs-lisp/debug.el
index 88633eaaa46..0b2ea81fb64 100644
--- a/lisp/emacs-lisp/debug.el
+++ b/lisp/emacs-lisp/debug.el
@@ -269,8 +269,9 @@ That buffer should be current already."
(setq buffer-undo-list t)
(let ((standard-output (current-buffer))
(print-escape-newlines t)
- (print-level 8)
- (print-length 50))
+ (print-level 1000) ;8
+ ;; (print-length 50)
+ )
(backtrace))
(goto-char (point-min))
(delete-region (point)
diff --git a/lisp/emacs-lisp/eieio-comp.el b/lisp/emacs-lisp/eieio-comp.el
deleted file mode 100644
index 244c4318425..00000000000
--- a/lisp/emacs-lisp/eieio-comp.el
+++ /dev/null
@@ -1,145 +0,0 @@
-;;; eieio-comp.el -- eieio routines to help with byte compilation
-
-;; Copyright (C) 1995-1996, 1998-2002, 2005, 2008-2011
-;; Free Software Foundation, Inc.
-
-;; Author: Eric M. Ludlam <zappo@gnu.org>
-;; Version: 0.2
-;; Keywords: lisp, tools
-;; Package: eieio
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; Byte compiler functions for defmethod. This will affect the new GNU
-;; byte compiler for Emacs 19 and better. This function will be called by
-;; the byte compiler whenever a `defmethod' is encountered in a file.
-;; It will output a function call to `eieio-defmethod' with the byte
-;; compiled function as a parameter.
-
-;;; Code:
-
-(declare-function eieio-defgeneric-form "eieio" (method doc-string))
-
-;; Some compatibility stuff
-(eval-and-compile
- (if (not (fboundp 'byte-compile-compiled-obj-to-list))
- (defun byte-compile-compiled-obj-to-list (moose) nil))
-
- (if (not (boundp 'byte-compile-outbuffer))
- (defvar byte-compile-outbuffer nil))
- )
-
-;; This teaches the byte compiler how to do this sort of thing.
-(put 'defmethod 'byte-hunk-handler 'eieio-byte-compile-file-form-defmethod)
-
-(defun eieio-byte-compile-file-form-defmethod (form)
- "Mumble about the method we are compiling.
-This function is mostly ripped from `byte-compile-file-form-defun',
-but it's been modified to handle the special syntax of the `defmethod'
-command. There should probably be one for `defgeneric' as well, but
-that is called but rarely. Argument FORM is the body of the method."
- (setq form (cdr form))
- (let* ((meth (car form))
- (key (progn (setq form (cdr form))
- (cond ((or (eq ':BEFORE (car form))
- (eq ':before (car form)))
- (setq form (cdr form))
- ":before ")
- ((or (eq ':AFTER (car form))
- (eq ':after (car form)))
- (setq form (cdr form))
- ":after ")
- ((or (eq ':PRIMARY (car form))
- (eq ':primary (car form)))
- (setq form (cdr form))
- ":primary ")
- ((or (eq ':STATIC (car form))
- (eq ':static (car form)))
- (setq form (cdr form))
- ":static ")
- (t ""))))
- (params (car form))
- (lamparams (eieio-byte-compile-defmethod-param-convert params))
- (arg1 (car params))
- (class (if (listp arg1) (nth 1 arg1) nil))
- (my-outbuffer (if (eval-when-compile (featurep 'xemacs))
- byte-compile-outbuffer
- (cond ((boundp 'bytecomp-outbuffer)
- bytecomp-outbuffer) ; Emacs >= 23.2
- ((boundp 'outbuffer) outbuffer)
- (t (error "Unable to set outbuffer"))))))
- (let ((name (format "%s::%s" (or class "#<generic>") meth)))
- (if byte-compile-verbose
- ;; #### filename used free
- (message "Compiling %s... (%s)"
- (cond ((boundp 'bytecomp-filename) bytecomp-filename)
- ((boundp 'filename) filename)
- (t ""))
- name))
- (setq byte-compile-current-form name) ; for warnings
- )
- ;; Flush any pending output
- (byte-compile-flush-pending)
- ;; Byte compile the body. For the byte compiled forms, add the
- ;; rest arguments, which will get ignored by the engine which will
- ;; add them later (I hope)
- ;; FIXME: This relies on compiler's internal. Make sure it still
- ;; works with lexical-binding code. Maybe calling `byte-compile'
- ;; would be preferable.
- (let* ((new-one (byte-compile-lambda
- (append (list 'lambda lamparams)
- (cdr form))))
- (code (byte-compile-byte-code-maker new-one)))
- (princ "\n(eieio-defmethod '" my-outbuffer)
- (princ meth my-outbuffer)
- (princ " '(" my-outbuffer)
- (princ key my-outbuffer)
- (prin1 params my-outbuffer)
- (princ " " my-outbuffer)
- (prin1 code my-outbuffer)
- (princ "))" my-outbuffer)
- )
- ;; Now add this function to the list of known functions.
- ;; Don't bother with a doc string. Not relevant here.
- (add-to-list 'byte-compile-function-environment
- (cons meth
- (eieio-defgeneric-form meth "")))
-
- ;; Remove it from the undefined list if it is there.
- (let ((elt (assq meth byte-compile-unresolved-functions)))
- (if elt (setq byte-compile-unresolved-functions
- (delq elt byte-compile-unresolved-functions))))
-
- ;; nil prevents cruft from appearing in the output buffer.
- nil))
-
-(defun eieio-byte-compile-defmethod-param-convert (paramlist)
- "Convert method params into the params used by the `defmethod' thingy.
-Argument PARAMLIST is the parameter list to convert."
- (let ((argfix nil))
- (while paramlist
- (setq argfix (cons (if (listp (car paramlist))
- (car (car paramlist))
- (car paramlist))
- argfix))
- (setq paramlist (cdr paramlist)))
- (nreverse argfix)))
-
-(provide 'eieio-comp)
-
-;;; eieio-comp.el ends here
diff --git a/lisp/emacs-lisp/eieio.el b/lisp/emacs-lisp/eieio.el
index bd768dbdb9f..4e443452d8b 100644
--- a/lisp/emacs-lisp/eieio.el
+++ b/lisp/emacs-lisp/eieio.el
@@ -45,8 +45,7 @@
;;; Code:
(eval-when-compile
- (require 'cl)
- (require 'eieio-comp))
+ (require 'cl))
(defvar eieio-version "1.3"
"Current version of EIEIO.")
@@ -123,6 +122,7 @@ execute a `call-next-method'. DO NOT SET THIS YOURSELF!")
;; while it is being built itself.
(defvar eieio-default-superclass nil)
+;; FIXME: The constants below should have a `eieio-' prefix added!!
(defconst class-symbol 1 "Class's symbol (self-referencing.).")
(defconst class-parent 2 "Class parent slot.")
(defconst class-children 3 "Class children class slot.")
@@ -181,10 +181,6 @@ Stored outright without modifications or stripping.")
(t key) ;; already generic.. maybe.
))
-;; How to specialty compile stuff.
-(autoload 'eieio-byte-compile-file-form-defmethod "eieio-comp"
- "This function is used to byte compile methods in a nice way.")
-(put 'defmethod 'byte-hunk-handler 'eieio-byte-compile-file-form-defmethod)
;;; Important macros used in eieio.
;;
@@ -1293,9 +1289,35 @@ Summary:
((typearg class-name) arg2 &optional opt &rest rest)
\"doc-string\"
body)"
- `(eieio-defmethod (quote ,method) (quote ,args)))
-
-(defun eieio-defmethod (method args)
+ (let* ((key (cond ((or (eq ':BEFORE (car args))
+ (eq ':before (car args)))
+ (setq args (cdr args))
+ :before)
+ ((or (eq ':AFTER (car args))
+ (eq ':after (car args)))
+ (setq args (cdr args))
+ :after)
+ ((or (eq ':PRIMARY (car args))
+ (eq ':primary (car args)))
+ (setq args (cdr args))
+ :primary)
+ ((or (eq ':STATIC (car args))
+ (eq ':static (car args)))
+ (setq args (cdr args))
+ :static)
+ (t nil)))
+ (params (car args))
+ (lamparams
+ (mapcar (lambda (param) (if (listp param) (car param) param))
+ params))
+ (arg1 (car params))
+ (class (if (listp arg1) (nth 1 arg1) nil)))
+ `(eieio-defmethod ',method
+ '(,@(if key (list key))
+ ,params)
+ (lambda ,lamparams ,@(cdr args)))))
+
+(defun eieio-defmethod (method args &optional code)
"Work part of the `defmethod' macro defining METHOD with ARGS."
(let ((key nil) (body nil) (firstarg nil) (argfix nil) (argclass nil) loopa)
;; find optional keys
@@ -1349,10 +1371,7 @@ Summary:
;; generics are higher
(setq key (eieio-specialized-key-to-generic-key key)))
;; Put this lambda into the symbol so we can find it
- (if (byte-code-function-p (car-safe body))
- (eieiomt-add method (car-safe body) key argclass)
- (eieiomt-add method (append (list 'lambda (reverse argfix)) body)
- key argclass))
+ (eieiomt-add method code key argclass)
)
(when eieio-optimize-primary-methods-flag
diff --git a/lisp/emacs-lisp/macroexp.el b/lisp/emacs-lisp/macroexp.el
index bccc60a24e0..781195d034a 100644
--- a/lisp/emacs-lisp/macroexp.el
+++ b/lisp/emacs-lisp/macroexp.el
@@ -153,13 +153,14 @@ Assumes the caller has bound `macroexpand-all-environment'."
;; here, so that any code that cares about the difference will
;; see the same transformation.
;; First arg is a function:
- (`(,(and fun (or `apply `mapcar `mapatoms `mapconcat `mapc)) ',f . ,args)
+ (`(,(and fun (or `apply `mapcar `mapatoms `mapconcat `mapc))
+ ',(and f `(lambda . ,_)) . ,args)
;; We don't use `maybe-cons' since there's clearly a change.
(cons fun
(cons (macroexpand-all-1 (list 'function f))
(macroexpand-all-forms args))))
;; Second arg is a function:
- (`(,(and fun (or `sort)) ,arg1 ',f . ,args)
+ (`(,(and fun (or `sort)) ,arg1 ',(and f `(lambda . ,_)) . ,args)
;; We don't use `maybe-cons' since there's clearly a change.
(cons fun
(cons (macroexpand-all-1 arg1)
generated by cgit v1.2.3 (git 2.39.1) at 2025-04-24 01:07:37 +0000