Get rid of funvec.
* lisp/emacs-lisp/bytecomp.el (byte-compile-lapcode): Handle new form of `byte-constant'. (byte-compile-close-variables, displaying-byte-compile-warnings): Add edebug spec. (byte-compile-toplevel-file-form): New fun, split out of byte-compile-file-form. (byte-compile-from-buffer): Use it to avoid applying cconv multiple times. (byte-compile): Only strip `function' if it's present. (byte-compile-lambda): Add `reserved-csts' argument. Use new lexenv arg of byte-compile-top-level. (byte-compile-reserved-constants): New var. (byte-compile-constants-vector): Obey it. (byte-compile-constants-vector): Handle new `byte-constant' form. (byte-compile-top-level): Add args `lexenv' and `reserved-csts'. (byte-compile-form): Don't check callargs here. (byte-compile-normal-call): Do it here instead. (byte-compile-push-unknown-constant) (byte-compile-resolve-unknown-constant): Remove, unused. (byte-compile-make-closure): Use `make-byte-code' rather than `curry', putting the environment into the "constant" pool. (byte-compile-get-closed-var): Use special byte-constant. * lisp/emacs-lisp/byte-opt.el (byte-optimize-form-code-walker): Handle new intermediate special form `internal-make-vector'. (byte-optimize-lapcode): Handle new form of `byte-constant'. * lisp/help-fns.el (describe-function-1): Don't handle funvecs. * lisp/emacs-lisp/macroexp.el (macroexpand-all-1): Only convert quote to function if the content is a lambda expression, not if it's a closure. * emacs-lisp/eieio-come.el: Remove. * lisp/emacs-lisp/eieio.el: Don't require eieio-comp. (defmethod): Do a bit more work to find the body and wrap it into a function before passing it to eieio-defmethod. (eieio-defmethod): New arg `code' for it. * lisp/emacs-lisp/debug.el (debugger-setup-buffer): Don't hide things in debugger backtrace. * lisp/emacs-lisp/cl-extra.el (cl-macroexpand-all): Use backquotes, and be more careful when quoting a function value. * lisp/emacs-lisp/cconv.el (cconv-freevars): Accept defvar/defconst. (cconv-closure-convert-rec): Catch stray `internal-make-closure'. * lisp/Makefile.in (COMPILE_FIRST): Compile pcase and cconv early. * src/eval.c (Qcurry): Remove. (funcall_funvec): Remove. (funcall_lambda): Move new byte-code handling to reduce impact. Treat all args as lexical in the case of lexbind. (Fcurry): Remove. * src/data.c (Qfunction_vector): Remove. (Ffunvecp): Remove. * src/lread.c (read1): Revert to calling make_byte_code here. (read_vector): Don't call make_byte_code any more. * src/lisp.h (enum pvec_type): Rename back to PVEC_COMPILED. (XSETCOMPILED): Rename back from XSETFUNVEC. (FUNVEC_SIZE): Remove. (FUNVEC_COMPILED_TAG_P, FUNVEC_COMPILED_P): Remove. (COMPILEDP): Rename back from FUNVECP. * src/fns.c (Felt): Remove unexplained FUNVEC check. * src/doc.c (Fdocumentation): Don't handle funvec. * src/alloc.c (make_funvec, Ffunvec): Remove. * doc/lispref/vol2.texi (Top): * doc/lispref/vol1.texi (Top): * doc/lispref/objects.texi (Programming Types, Funvec Type, Type Predicates): * doc/lispref/functions.texi (Functions, What Is a Function, FunctionCurrying): * doc/lispref/elisp.texi (Top): Remove mentions of funvec and curry.
This commit is contained in:
Stefan Monnier
parent
cb9336bd97
commit
876c194cba
33 changed files with 379 additions and 752 deletions
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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" "\
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
@ -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)))
|
||||
(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)
|
||||
(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
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue