mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2026-01-03 02:31:03 -08:00
Code Issues Projects Releases Wiki Activity

Get rid of funvec.

Browse source 
* 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 2011-02-24 22:27:45 -05:00
parent cb9336bd97
commit 876c194cba
33 changed files with 379 additions and 752 deletions
Download patch file Download diff file Expand all files Collapse all files

2
.dir-locals.el
View file

@ -1,6 +1,6 @@
((nil . ((tab-width . 8)
(sentence-end-double-space . t)
(fill-column . 70)))
(fill-column . 79)))
(c-mode . ((c-file-style . "GNU")))
;; You must set bugtracker_debbugs_url in your bazaar.conf for this to work.
;; See admin/notes/bugtracker.

8
doc/lispref/ChangeLog
View file

@ -1,3 +1,11 @@
2011-02-25 Stefan Monnier <monnier@iro.umontreal.ca>
* vol2.texi (Top):
* vol1.texi (Top):
* objects.texi (Programming Types, Funvec Type, Type Predicates):
* functions.texi (Functions, What Is a Function, Function Currying):
* elisp.texi (Top): Remove mentions of funvec and curry.
2011-02-19 Eli Zaretskii <eliz@gnu.org>
* elisp.texi: Sync @dircategory with ../../info/dir.

4
doc/lispref/elisp.texi
View file

@ -249,7 +249,7 @@ Programming Types
* Macro Type:: A method of expanding an expression into another
expression, more fundamental but less pretty.
* Primitive Function Type:: A function written in C, callable from Lisp.
* Funvec Type:: A vector type callable as a function.
* Byte-Code Type:: A function written in Lisp, then compiled.
* Autoload Type:: A type used for automatically loading seldom-used
functions.
@ -464,8 +464,6 @@ Functions
* Inline Functions:: Defining functions that the compiler
will open code.
* Declaring Functions:: Telling the compiler that a function is defined.
* Function Currying:: Making wrapper functions that pre-specify
some arguments.
* Function Safety:: Determining whether a function is safe to call.
* Related Topics:: Cross-references to specific Lisp primitives
that have a special bearing on how functions work.

70
doc/lispref/functions.texi
View file

@ -23,8 +23,6 @@ define them.
of a symbol.
* Obsolete Functions:: Declaring functions obsolete.
* Inline Functions:: Defining functions that the compiler will open code.
* Function Currying:: Making wrapper functions that pre-specify
some arguments.
* Declaring Functions:: Telling the compiler that a function is defined.
* Function Safety:: Determining whether a function is safe to call.
* Related Topics:: Cross-references to specific Lisp primitives
@ -113,25 +111,7 @@ editors; for Lisp programs, the distinction is normally unimportant.
@item byte-code function
A @dfn{byte-code function} is a function that has been compiled by the
byte compiler. A byte-code function is actually a special case of a
@dfn{funvec} object (see below).
@item function vector
A @dfn{function vector}, or @dfn{funvec} is a vector-like object whose
purpose is to define special kinds of functions. @xref{Funvec Type}.
The exact meaning of the vector elements is determined by the type of
funvec: the most common use is byte-code functions, which have a
list---the argument list---as the first element. Further types of
funvec object are:
@table @code
@item curry
A curried function. Remaining arguments in the funvec are function to
call, and arguments to prepend to user arguments at the time of the
call; @xref{Function Currying}.
@end table
byte compiler. @xref{Byte-Code Type}.
@end table
@defun functionp object
@ -172,11 +152,6 @@ function. For example:
@end example
@end defun
@defun funvecp object
@code{funvecp} returns @code{t} if @var{object} is a function vector
object (including byte-code objects), and @code{nil} otherwise.
@end defun
@defun subr-arity subr
This function provides information about the argument list of a
primitive, @var{subr}. The returned value is a pair
@ -1302,49 +1277,6 @@ do for macros. (@xref{Argument Evaluation}.)
Inline functions can be used and open-coded later on in the same file,
following the definition, just like macros.
@node Function Currying
@section Function Currying
@cindex function currying
@cindex currying
@cindex partial-application
Function currying is a way to make a new function that calls an
existing function with a partially pre-determined argument list.
@defun curry function &rest args
Return a function-like object that will append any arguments it is
called with to @var{args}, and call @var{function} with the resulting
list of arguments.
For example, @code{(curry 'concat "The ")} returns a function that
concatenates @code{"The "} and its arguments. Calling this function
on @code{"end"} returns @code{"The end"}:
@example
(funcall (curry 'concat "The ") "end")
@result{} "The end"
@end example
The @dfn{curried function} is useful as an argument to @code{mapcar}:
@example
(mapcar (curry 'concat "The ") '("big" "red" "balloon"))
@result{} ("The big" "The red" "The balloon")
@end example
@end defun
Function currying may be implemented in any Lisp by constructing a
@code{lambda} expression, for instance:
@example
(defun curry (function &rest args)
`(lambda (&rest call-args)
(apply #',function ,@@args call-args)))
@end example
However in Emacs Lisp, a special curried function object is used for
efficiency. @xref{Funvec Type}.
@node Declaring Functions
@section Telling the Compiler that a Function is Defined
@cindex function declaration

61
doc/lispref/objects.texi
View file

@ -156,7 +156,7 @@ latter are unique to Emacs Lisp.
* Macro Type:: A method of expanding an expression into another
expression, more fundamental but less pretty.
* Primitive Function Type:: A function written in C, callable from Lisp.
* Funvec Type:: A vector type callable as a function.
* Byte-Code Type:: A function written in Lisp, then compiled.
* Autoload Type:: A type used for automatically loading seldom-used
functions.
@end menu
@ -1313,55 +1313,18 @@ with the name of the subroutine.
@end group
@end example
@node Funvec Type
@subsection ``Function Vector' Type
@cindex function vector
@cindex funvec
@node Byte-Code Type
@subsection Byte-Code Function Type
A @dfn{function vector}, or @dfn{funvec} is a vector-like object whose
purpose is to define special kinds of functions. You can examine or
modify the contents of a funvec like a normal vector, using the
@code{aref} and @code{aset} functions.
The byte compiler produces @dfn{byte-code function objects}.
Internally, a byte-code function object is much like a vector; however,
the evaluator handles this data type specially when it appears as a
function to be called. @xref{Byte Compilation}, for information about
the byte compiler.
The behavior of a funvec when called is dependent on the kind of
funvec it is, and that is determined by its first element (a
zero-length funvec will signal an error if called):
@table @asis
@item A list
A funvec with a list as its first element is a byte-compiled function,
produced by the byte compiler; such funvecs are known as
@dfn{byte-code function objects}. @xref{Byte Compilation}, for
information about the byte compiler.
@item The symbol @code{curry}
A funvec with @code{curry} as its first element is a ``curried function''.
The second element in such a funvec is the function which is
being curried, and the remaining elements are a list of arguments.
Calling such a funvec operates by calling the embedded function with
an argument list composed of the arguments in the funvec followed by
the arguments the funvec was called with. @xref{Function Currying}.
@end table
The printed representation and read syntax for a funvec object is like
that for a vector, with an additional @samp{#} before the opening
@samp{[}.
@defun funvecp object
@code{funvecp} returns @code{t} if @var{object} is a function vector
object (including byte-code objects), and @code{nil} otherwise.
@end defun
@defun funvec kind &rest params
@code{funvec} returns a new function vector containing @var{kind} and
@var{params}. @var{kind} determines the type of funvec; it should be
one of the choices listed in the table above.
Typically you should use the @code{make-byte-code} function to create
byte-code objects, though they are a type of funvec.
@end defun
The printed representation and read syntax for a byte-code function
object is like that for a vector, with an additional @samp{#} before the
opening @samp{[}.
@node Autoload Type
@subsection Autoload Type
@ -1808,7 +1771,7 @@ with references to further information.
@xref{Buffer Basics, bufferp}.
@item byte-code-function-p
@xref{Funvec Type, byte-code-function-p}.
@xref{Byte-Code Type, byte-code-function-p}.
@item case-table-p
@xref{Case Tables, case-table-p}.

2
doc/lispref/vol1.texi
View file

@ -269,7 +269,7 @@ Programming Types
* Macro Type:: A method of expanding an expression into another
expression, more fundamental but less pretty.
* Primitive Function Type:: A function written in C, callable from Lisp.
* Funvec Type:: A vector type callable as a function.
* Byte-Code Type:: A function written in Lisp, then compiled.
* Autoload Type:: A type used for automatically loading seldom-used
functions.

2
doc/lispref/vol2.texi
View file

@ -268,7 +268,7 @@ Programming Types
* Macro Type:: A method of expanding an expression into another
expression, more fundamental but less pretty.
* Primitive Function Type:: A function written in C, callable from Lisp.
* Funvec Type:: A vector type callable as a function.
* Byte-Code Type:: A function written in Lisp, then compiled.
* Autoload Type:: A type used for automatically loading seldom-used
functions.

21
etc/NEWS.lexbind
View file

@ -1,6 +1,6 @@
GNU Emacs NEWS -- history of user-visible changes.
Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2007
Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2011
Free Software Foundation, Inc.
See the end of the file for license conditions.
@ -12,21 +12,12 @@ This file is about changes in the Emacs "lexbind" branch.
* Lisp changes in Emacs 23.1
** New `function vector' type, including function currying
The `function vector', or `funvec' type extends the old
byte-compiled-function vector type to have other uses as well, and
includes existing byte-compiled functions as a special case. The kind
of funvec is determined by the first element: a list is a byte-compiled
function, and a non-nil atom is one of the new extended uses, currently
`curry' for curried functions. See the node `Funvec Type' in the Emacs
Lisp Reference Manual for more information.
*** New function curry allows constructing `curried functions'
(see the node `Function Currying' in the Emacs Lisp Reference Manual).
*** New functions funvec and funvecp allow primitive access to funvecs
** The `lexical-binding' lets code use lexical scoping for local variables.
It is typically set via file-local variables, in which case it applies to
all the code in that file.
** Lexically scoped interpreted functions are represented with a new form
of function value which looks like (closure ENV lambda ARGS &rest BODY).
----------------------------------------------------------------------
This file is part of GNU Emacs.

43
lisp/ChangeLog
View file

@ -1,3 +1,46 @@
2011-02-25 Stefan Monnier <monnier@iro.umontreal.ca>
* 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.
* 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'.
* help-fns.el (describe-function-1): Don't handle funvecs.
* 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.
* 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.
* emacs-lisp/debug.el (debugger-setup-buffer): Don't hide things in
debugger backtrace.
* emacs-lisp/cl-extra.el (cl-macroexpand-all): Use backquotes, and be
more careful when quoting a function value.
* emacs-lisp/cconv.el (cconv-freevars): Accept defvar/defconst.
(cconv-closure-convert-rec): Catch stray `internal-make-closure'.
* Makefile.in (COMPILE_FIRST): Compile pcase and cconv early.
2011-02-21 Stefan Monnier <monnier@iro.umontreal.ca>
* emacs-lisp/cconv.el (cconv-closure-convert-rec): Let the byte

6
lisp/Makefile.in
View file

@ -83,7 +83,9 @@ BIG_STACK_OPTS = --eval "(setq max-lisp-eval-depth $(BIG_STACK_DEPTH))"
COMPILE_FIRST = \
$(lisp)/emacs-lisp/bytecomp.elc \
$(lisp)/emacs-lisp/byte-opt.elc \
$(lisp)/emacs-lisp/pcase.elc \
$(lisp)/emacs-lisp/macroexp.elc \
$(lisp)/emacs-lisp/cconv.elc \
$(lisp)/emacs-lisp/autoload.elc
# The actual Emacs command run in the targets below.
@ -203,7 +205,7 @@ compile-onefile:
@echo Compiling $(THEFILE)
@# Use byte-compile-refresh-preloaded to try and work around some of
@# the most common bootstrapping problems.
@$(emacs) -l bytecomp.el -f byte-compile-refresh-preloaded \
$(emacs) -l bytecomp.el -f byte-compile-refresh-preloaded \
$(BIG_STACK_OPTS) $(BYTE_COMPILE_EXTRA_FLAGS) \
-f batch-byte-compile $(THEFILE)
@ -220,7 +222,7 @@ compile-onefile:
# cannot have prerequisites.
.el.elc:
@echo Compiling $<
@$(emacs) $(BIG_STACK_OPTS) $(BYTE_COMPILE_EXTRA_FLAGS) \
$(emacs) $(BIG_STACK_OPTS) $(BYTE_COMPILE_EXTRA_FLAGS) \
-f batch-byte-compile $<
.PHONY: compile-first compile-main compile compile-always

47
lisp/emacs-lisp/byte-opt.el
View file

@ -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

138
lisp/emacs-lisp/bytecomp.el
View file

@ -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

43
lisp/emacs-lisp/cconv.el
View file

@ -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)

24
lisp/emacs-lisp/cl-extra.el
View file

@ -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

2
lisp/emacs-lisp/cl-loaddefs.el
View file

@ -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" "\

5
lisp/emacs-lisp/debug.el
View file

@ -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)

145
lisp/emacs-lisp/eieio-comp.el
View file

@ -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

43
lisp/emacs-lisp/eieio.el
View file

@ -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

5
lisp/emacs-lisp/macroexp.el
View file

@ -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)

22
lisp/help-fns.el
View file

@ -363,13 +363,6 @@ suitable file is found, return nil."
(concat beg "built-in function")))
((byte-code-function-p def)
(concat beg "compiled Lisp function"))
((and (funvecp def) (eq (aref def 0) 'curry))
(if (symbolp (aref def 1))
(format "a curried function calling `%s'" (aref def 1))
"a curried function"))
((funvecp def)
(format "a function-vector (funvec) of type `%s'"
(aref def 0)))
((symbolp def)
(while (and (fboundp def)
(symbolp (symbol-function def)))
@ -510,21 +503,6 @@ suitable file is found, return nil."
((or (stringp def)
(vectorp def))
(format "\nMacro: %s" (format-kbd-macro def)))
((and (funvecp def) (eq (aref def 0) 'curry))
;; Describe a curried-function's function and args
(let ((slot 0))
(mapconcat (lambda (arg)
(setq slot (1+ slot))
(cond
((= slot 1) "")
((= slot 2)
(format " Function: %S" arg))
(t
(format "Argument %d: %S"
(- slot 3) arg))))
def
"\n")))
((funvecp def) nil)
(t "[Missing arglist. Please make a bug report.]")))
(high (help-highlight-arguments use doc)))
(let ((fill-begin (point)))

56
src/ChangeLog
View file

@ -1,3 +1,23 @@
2011-02-25 Stefan Monnier <monnier@iro.umontreal.ca>
* 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.
* data.c (Qfunction_vector): Remove.
(Ffunvecp): Remove.
* lread.c (read1): Revert to calling make_byte_code here.
(read_vector): Don't call make_byte_code any more.
* 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.
* fns.c (Felt): Remove unexplained FUNVEC check.
* doc.c (Fdocumentation): Don't handle funvec.
* alloc.c (make_funvec, Ffunvec): Remove.
2011-02-21 Stefan Monnier <monnier@iro.umontreal.ca>
* bytecode.c (exec_byte_code): Change stack_ref and stack_set to use
@ -113,6 +133,42 @@
Merge funvec patch.
2004-05-20 Miles Bader <miles@gnu.org>
* lisp.h: Declare make_funvec and Ffunvec.
(enum pvec_type): Rename `PVEC_COMPILED' to `PVEC_FUNVEC'.
(XSETFUNVEC): Rename from `XSETCOMPILED'.
(FUNVEC_SIZE, FUNVEC_COMPILED_TAG_P, FUNVEC_COMPILED_P): New macros.
(COMPILEDP): Define in terms of funvec macros.
(FUNVECP, GC_FUNVECP): Rename from `COMPILEDP' & `GC_COMPILEDP'.
(FUNCTIONP): Use FUNVECP instead of COMPILEDP.
* alloc.c (make_funvec, funvec): New functions.
(Fmake_byte_code): Make sure the first element is a list.
* eval.c (Qcurry): New variable.
(funcall_funvec, Fcurry): New functions.
(syms_of_eval): Initialize them.
(funcall_lambda): Handle non-bytecode funvec objects by calling
funcall_funvec.
(Ffuncall, Feval): Use FUNVECP insetad of COMPILEDP.
* lread.c (read1): Return result of read_vector for `#[' syntax
directly; read_vector now does any extra work required.
(read_vector): Handle both funvec and byte-code objects, converting the
type as necessary. `bytecodeflag' argument is now called
`read_funvec'.
* data.c (Ffunvecp): New function.
* doc.c (Fdocumentation): Return nil for unknown funvecs.
* fns.c (mapcar1, Felt, concat): Allow funvecs.
* eval.c (Ffunctionp): Use `funvec' operators instead of `compiled'
operators.
* alloc.c (Fmake_byte_code, Fpurecopy, mark_object): Likewise.
* keyboard.c (Fcommand_execute): Likewise.
* image.c (parse_image_spec): Likewise.
* fns.c (Flength, concat, internal_equal): Likewise.
* data.c (Faref, Ftype_of): Likewise.
* print.c (print_preprocess, print_object): Likewise.
2004-04-10 Miles Bader <miles@gnu.org>
* eval.c (Fspecialp): New function.

37
src/ChangeLog.funvec
View file

@ -1,37 +0,0 @@
2004-05-20 Miles Bader <miles@gnu.org>
* lisp.h: Declare make_funvec and Ffunvec.
(enum pvec_type): Rename `PVEC_COMPILED' to `PVEC_FUNVEC'.
(XSETFUNVEC): Renamed from `XSETCOMPILED'.
(FUNVEC_SIZE, FUNVEC_COMPILED_TAG_P, FUNVEC_COMPILED_P): New macros.
(COMPILEDP): Define in terms of funvec macros.
(FUNVECP, GC_FUNVECP): Renamed from `COMPILEDP' & `GC_COMPILEDP'.
(FUNCTIONP): Use FUNVECP instead of COMPILEDP.
* alloc.c (make_funvec, funvec): New functions.
(Fmake_byte_code): Make sure the first element is a list.
* eval.c (Qcurry): New variable.
(funcall_funvec, Fcurry): New functions.
(syms_of_eval): Initialize them.
(funcall_lambda): Handle non-bytecode funvec objects by calling
funcall_funvec.
(Ffuncall, Feval): Use FUNVECP insetad of COMPILEDP.
* lread.c (read1): Return result of read_vector for `#[' syntax
directly; read_vector now does any extra work required.
(read_vector): Handle both funvec and byte-code objects, converting the
type as necessary. `bytecodeflag' argument is now called
`read_funvec'.
* data.c (Ffunvecp): New function.
* doc.c (Fdocumentation): Return nil for unknown funvecs.
* fns.c (mapcar1, Felt, concat): Allow funvecs.
* eval.c (Ffunctionp): Use `funvec' operators instead of `compiled'
operators.
* alloc.c (Fmake_byte_code, Fpurecopy, mark_object): Likewise.
* keyboard.c (Fcommand_execute): Likewise.
* image.c (parse_image_spec): Likewise.
* fns.c (Flength, concat, internal_equal): Likewise.
* data.c (Faref, Ftype_of): Likewise.
* print.c (print_preprocess, print_object): Likewise.
;; arch-tag: f35a6a00-4a11-4739-a4b6-9cf98296f315

71
src/alloc.c
View file

@ -2924,37 +2924,6 @@ See also the function `vector'. */)
}
/* Return a new `function vector' containing KIND as the first element,
followed by NUM_NIL_SLOTS nil elements, and further elements copied from
the vector PARAMS of length NUM_PARAMS (so the total length of the
resulting vector is 1 + NUM_NIL_SLOTS + NUM_PARAMS).
If NUM_PARAMS is zero, then PARAMS may be NULL.
A `function vector', a.k.a. `funvec', is a funcallable vector in Emacs Lisp.
See the function `funvec' for more detail. */
Lisp_Object
make_funvec (Lisp_Object kind, int num_nil_slots, int num_params,
Lisp_Object *params)
{
int param_index;
Lisp_Object funvec;
funvec = Fmake_vector (make_number (1 + num_nil_slots + num_params), Qnil);
ASET (funvec, 0, kind);
for (param_index = 0; param_index < num_params; param_index++)
ASET (funvec, 1 + num_nil_slots + param_index, params[param_index]);
XSETPVECTYPE (XVECTOR (funvec), PVEC_FUNVEC);
XSETFUNVEC (funvec, XVECTOR (funvec));
return funvec;
}
DEFUN ("vector", Fvector, Svector, 0, MANY, 0,
doc: /* Return a newly created vector with specified arguments as elements.
Any number of arguments, even zero arguments, are allowed.
@ -2974,27 +2943,6 @@ usage: (vector &rest OBJECTS) */)
}
DEFUN ("funvec", Ffunvec, Sfunvec, 1, MANY, 0,
doc: /* Return a newly created `function vector' of type KIND.
A `function vector', a.k.a. `funvec', is a funcallable vector in Emacs Lisp.
KIND indicates the kind of funvec, and determines its behavior when called.
The meaning of the remaining arguments depends on KIND. Currently
implemented values of KIND, and their meaning, are:
A list -- A byte-compiled function. See `make-byte-code' for the usual
way to create byte-compiled functions.
`curry' -- A curried function. Remaining arguments are a function to
call, and arguments to prepend to user arguments at the
time of the call; see the `curry' function.
usage: (funvec KIND &rest PARAMS) */)
(int nargs, Lisp_Object *args)
{
return make_funvec (args[0], 0, nargs - 1, args + 1);
}
DEFUN ("make-byte-code", Fmake_byte_code, Smake_byte_code, 4, MANY, 0,
doc: /* Create a byte-code object with specified arguments as elements.
The arguments should be the arglist, bytecode-string, constant vector,
@ -3008,10 +2956,6 @@ usage: (make-byte-code ARGLIST BYTE-CODE CONSTANTS DEPTH &optional DOCSTRING INT
register int index;
register struct Lisp_Vector *p;
/* Make sure the arg-list is really a list, as that's what's used to
distinguish a byte-compiled object from other funvecs. */
CHECK_LIST (args[0]);
XSETFASTINT (len, nargs);
if (!NILP (Vpurify_flag))
val = make_pure_vector ((EMACS_INT) nargs);
@ -3033,8 +2977,8 @@ usage: (make-byte-code ARGLIST BYTE-CODE CONSTANTS DEPTH &optional DOCSTRING INT
args[index] = Fpurecopy (args[index]);
p->contents[index] = args[index];
}
XSETPVECTYPE (p, PVEC_FUNVEC);
XSETFUNVEC (val, p);
XSETPVECTYPE (p, PVEC_COMPILED);
XSETCOMPILED (val, p);
return val;
}
@ -4817,7 +4761,7 @@ Does not copy symbols. Copies strings without text properties. */)
obj = make_pure_string (SSDATA (obj), SCHARS (obj),
SBYTES (obj),
STRING_MULTIBYTE (obj));
else if (FUNVECP (obj) || VECTORP (obj))
else if (COMPILEDP (obj) || VECTORP (obj))
{
register struct Lisp_Vector *vec;
register EMACS_INT i;
@ -4829,10 +4773,10 @@ Does not copy symbols. Copies strings without text properties. */)
vec = XVECTOR (make_pure_vector (size));
for (i = 0; i < size; i++)
vec->contents[i] = Fpurecopy (XVECTOR (obj)->contents[i]);
if (FUNVECP (obj))
if (COMPILEDP (obj))
{
XSETPVECTYPE (vec, PVEC_FUNVEC);
XSETFUNVEC (obj, vec);
XSETPVECTYPE (vec, PVEC_COMPILED);
XSETCOMPILED (obj, vec);
}
else
XSETVECTOR (obj, vec);
@ -5418,7 +5362,7 @@ mark_object (Lisp_Object arg)
}
else if (SUBRP (obj))
break;
else if (FUNVECP (obj) && FUNVEC_COMPILED_P (obj))
else if (COMPILEDP (obj))
/* We could treat this just like a vector, but it is better to
save the COMPILED_CONSTANTS element for last and avoid
recursion there. */
@ -6320,7 +6264,6 @@ The time is in seconds as a floating point value. */);
defsubr (&Scons);
defsubr (&Slist);
defsubr (&Svector);
defsubr (&Sfunvec);
defsubr (&Smake_byte_code);
defsubr (&Smake_list);
defsubr (&Smake_vector);

9
src/bytecode.c
View file

@ -51,7 +51,7 @@ by Hallvard:
*
* define BYTE_CODE_METER to enable generation of a byte-op usage histogram.
*/
/* #define BYTE_CODE_SAFE 1 */
/* #define BYTE_CODE_SAFE */
/* #define BYTE_CODE_METER */
@ -1720,8 +1720,13 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
break;
#endif
case 0:
/* Actually this is Bstack_ref with offset 0, but we use Bdup
for that instead. */
/* case Bstack_ref: */
abort ();
/* Handy byte-codes for lexical binding. */
/* case Bstack_ref: */ /* Use `dup' instead. */
case Bstack_ref+1:
case Bstack_ref+2:
case Bstack_ref+3:

25
src/data.c
View file

@ -84,7 +84,7 @@ static Lisp_Object Qsymbol, Qstring, Qcons, Qmarker, Qoverlay;
Lisp_Object Qwindow;
static Lisp_Object Qfloat, Qwindow_configuration;
Lisp_Object Qprocess;
static Lisp_Object Qcompiled_function, Qfunction_vector, Qbuffer, Qframe, Qvector;
static Lisp_Object Qcompiled_function, Qbuffer, Qframe, Qvector;
static Lisp_Object Qchar_table, Qbool_vector, Qhash_table;
static Lisp_Object Qsubrp, Qmany, Qunevalled;
Lisp_Object Qfont_spec, Qfont_entity, Qfont_object;
@ -194,11 +194,8 @@ for example, (type-of 1) returns `integer'. */)
return Qwindow;
if (SUBRP (object))
return Qsubr;
if (FUNVECP (object))
if (FUNVEC_COMPILED_P (object))
return Qcompiled_function;
else
return Qfunction_vector;
if (COMPILEDP (object))
return Qcompiled_function;
if (BUFFERP (object))
return Qbuffer;
if (CHAR_TABLE_P (object))
@ -397,13 +394,6 @@ DEFUN ("byte-code-function-p", Fbyte_code_function_p, Sbyte_code_function_p,
return Qnil;
}
DEFUN ("funvecp", Ffunvecp, Sfunvecp, 1, 1, 0,
doc: /* Return t if OBJECT is a `function vector' object. */)
(Lisp_Object object)
{
return FUNVECP (object) ? Qt : Qnil;
}
DEFUN ("char-or-string-p", Fchar_or_string_p, Schar_or_string_p, 1, 1, 0,
doc: /* Return t if OBJECT is a character or a string. */)
(register Lisp_Object object)
@ -2113,9 +2103,9 @@ or a byte-code object. IDX starts at 0. */)
{
int size = 0;
if (VECTORP (array))
size = ASIZE (array);
else if (FUNVECP (array))
size = FUNVEC_SIZE (array);
size = XVECTOR (array)->size;
else if (COMPILEDP (array))
size = XVECTOR (array)->size & PSEUDOVECTOR_SIZE_MASK;
else
wrong_type_argument (Qarrayp, array);
@ -3180,7 +3170,6 @@ syms_of_data (void)
Qwindow = intern_c_string ("window");
/* Qsubr = intern_c_string ("subr"); */
Qcompiled_function = intern_c_string ("compiled-function");
Qfunction_vector = intern_c_string ("function-vector");
Qbuffer = intern_c_string ("buffer");
Qframe = intern_c_string ("frame");
Qvector = intern_c_string ("vector");
@ -3206,7 +3195,6 @@ syms_of_data (void)
staticpro (&Qwindow);
/* staticpro (&Qsubr); */
staticpro (&Qcompiled_function);
staticpro (&Qfunction_vector);
staticpro (&Qbuffer);
staticpro (&Qframe);
staticpro (&Qvector);
@ -3243,7 +3231,6 @@ syms_of_data (void)
defsubr (&Smarkerp);
defsubr (&Ssubrp);
defsubr (&Sbyte_code_function_p);
defsubr (&Sfunvecp);
defsubr (&Schar_or_string_p);
defsubr (&Scar);
defsubr (&Scdr);

5
src/doc.c
View file

@ -357,11 +357,6 @@ string is passed through `substitute-command-keys'. */)
else
return Qnil;
}
else if (FUNVECP (fun))
{
/* Unless otherwise handled, funvecs have no documentation. */
return Qnil;
}
else if (STRINGP (fun) || VECTORP (fun))
{
return build_string ("Keyboard macro.");

133
src/eval.c
View file

@ -60,7 +60,6 @@ Lisp_Object Qinhibit_quit;
Lisp_Object Qand_rest, Qand_optional;
Lisp_Object Qdebug_on_error;
Lisp_Object Qdeclare;
Lisp_Object Qcurry;
Lisp_Object Qinternal_interpreter_environment, Qclosure;
Lisp_Object Qdebug;
@ -2405,7 +2404,7 @@ eval_sub (Lisp_Object form)
}
}
}
else if (FUNVECP (fun))
else if (COMPILEDP (fun))
val = apply_lambda (fun, original_args);
else
{
@ -2890,7 +2889,7 @@ DEFUN ("functionp", Ffunctionp, Sfunctionp, 1, 1, 0,
if (SUBRP (object))
return (XSUBR (object)->max_args != UNEVALLED) ? Qt : Qnil;
else if (FUNVECP (object))
else if (COMPILEDP (object))
return Qt;
else if (CONSP (object))
{
@ -3034,7 +3033,7 @@ usage: (funcall FUNCTION &rest ARGUMENTS) */)
}
}
}
else if (FUNVECP (fun))
else if (COMPILEDP (fun))
val = funcall_lambda (fun, numargs, args + 1);
else
{
@ -3107,54 +3106,6 @@ apply_lambda (Lisp_Object fun, Lisp_Object args)
return tem;
}
/* Call a non-bytecode funvec object FUN, on the argments in ARGS (of
length NARGS). */
static Lisp_Object
funcall_funvec (Lisp_Object fun, int nargs, Lisp_Object *args)
{
int size = FUNVEC_SIZE (fun);
Lisp_Object tag = (size > 0 ? AREF (fun, 0) : Qnil);
if (EQ (tag, Qcurry))
{
/* A curried function is a way to attach arguments to a another
function. The first element of the vector is the identifier
`curry', the second is the wrapped function, and remaining
elements are the attached arguments. */
int num_curried_args = size - 2;
/* Offset of the curried and user args in the final arglist. Curried
args are first in the new arg vector, after the function. User
args follow. */
int curried_args_offs = 1;
int user_args_offs = curried_args_offs + num_curried_args;
/* The curried function and arguments. */
Lisp_Object *curry_params = XVECTOR (fun)->contents + 1;
/* The arguments in the curry vector. */
Lisp_Object *curried_args = curry_params + 1;
/* The number of arguments with which we'll call funcall, and the
arguments themselves. */
int num_funcall_args = 1 + num_curried_args + nargs;
Lisp_Object *funcall_args
= (Lisp_Object *) alloca (num_funcall_args * sizeof (Lisp_Object));
/* First comes the real function. */
funcall_args[0] = curry_params[0];
/* Then the arguments in the appropriate order. */
memcpy (funcall_args + curried_args_offs, curried_args,
num_curried_args * sizeof (Lisp_Object));
memcpy (funcall_args + user_args_offs, args,
nargs * sizeof (Lisp_Object));
return Ffuncall (num_funcall_args, funcall_args);
}
else
xsignal1 (Qinvalid_function, fun);
}
/* Apply a Lisp function FUN to the NARGS evaluated arguments in ARG_VECTOR
and return the result of evaluation.
FUN must be either a lambda-expression or a compiled-code object. */
@ -3167,34 +3118,6 @@ funcall_lambda (Lisp_Object fun, int nargs,
int count = SPECPDL_INDEX ();
int i, optional, rest;
if (COMPILEDP (fun)
&& FUNVEC_SIZE (fun) > COMPILED_PUSH_ARGS
&& ! NILP (XVECTOR (fun)->contents[COMPILED_PUSH_ARGS]))
/* A byte-code object with a non-nil `push args' slot means we
shouldn't bind any arguments, instead just call the byte-code
interpreter directly; it will push arguments as necessary.
Byte-code objects with either a non-existant, or a nil value for
the `push args' slot (the default), have dynamically-bound
arguments, and use the argument-binding code below instead (as do
all interpreted functions, even lexically bound ones). */
{
/* If we have not actually read the bytecode string
and constants vector yet, fetch them from the file. */
if (CONSP (AREF (fun, COMPILED_BYTECODE)))
Ffetch_bytecode (fun);
return exec_byte_code (AREF (fun, COMPILED_BYTECODE),
AREF (fun, COMPILED_CONSTANTS),
AREF (fun, COMPILED_STACK_DEPTH),
AREF (fun, COMPILED_ARGLIST),
nargs, arg_vector);
}
if (FUNVECP (fun) && !FUNVEC_COMPILED_P (fun))
/* Byte-compiled functions are handled directly below, but we
call other funvec types via funcall_funvec. */
return funcall_funvec (fun, nargs, arg_vector);
if (CONSP (fun))
{
if (EQ (XCAR (fun), Qclosure))
@ -3213,6 +3136,27 @@ funcall_lambda (Lisp_Object fun, int nargs,
}
else if (COMPILEDP (fun))
{
if ((ASIZE (fun) & PSEUDOVECTOR_SIZE_MASK) > COMPILED_PUSH_ARGS
&& ! NILP (XVECTOR (fun)->contents[COMPILED_PUSH_ARGS]))
/* A byte-code object with a non-nil `push args' slot means we
shouldn't bind any arguments, instead just call the byte-code
interpreter directly; it will push arguments as necessary.
Byte-code objects with either a non-existant, or a nil value for
the `push args' slot (the default), have dynamically-bound
arguments, and use the argument-binding code below instead (as do
all interpreted functions, even lexically bound ones). */
{
/* If we have not actually read the bytecode string
and constants vector yet, fetch them from the file. */
if (CONSP (AREF (fun, COMPILED_BYTECODE)))
Ffetch_bytecode (fun);
return exec_byte_code (AREF (fun, COMPILED_BYTECODE),
AREF (fun, COMPILED_CONSTANTS),
AREF (fun, COMPILED_STACK_DEPTH),
AREF (fun, COMPILED_ARGLIST),
nargs, arg_vector);
}
syms_left = AREF (fun, COMPILED_ARGLIST);
lexenv = Qnil;
}
@ -3248,11 +3192,7 @@ funcall_lambda (Lisp_Object fun, int nargs,
val = Qnil;
/* Bind the argument. */
if (!NILP (lexenv) && SYMBOLP (next)
/* FIXME: there's no good reason to allow dynamic-scoping
on function arguments, other than consistency with let. */
&& !XSYMBOL (next)->declared_special
&& NILP (Fmemq (next, Vinternal_interpreter_environment)))
if (!NILP (lexenv) && SYMBOLP (next))
/* Lexically bind NEXT by adding it to the lexenv alist. */
lexenv = Fcons (Fcons (next, val), lexenv);
else
@ -3532,24 +3472,6 @@ context where binding is lexical by default. */)
DEFUN ("curry", Fcurry, Scurry, 1, MANY, 0,
doc: /* Return FUN curried with ARGS.
The result is a function-like object that will append any arguments it
is called with to ARGS, and call FUN with the resulting list of arguments.
For instance:
(funcall (curry '+ 3 4 5) 2) is the same as (funcall '+ 3 4 5 2)
and:
(mapcar (curry 'concat "The ") '("a" "b" "c"))
=> ("The a" "The b" "The c")
usage: (curry FUN &rest ARGS) */)
(int nargs, Lisp_Object *args)
{
return make_funvec (Qcurry, 0, nargs, args);
}
DEFUN ("backtrace-debug", Fbacktrace_debug, Sbacktrace_debug, 2, 2, 0,
doc: /* Set the debug-on-exit flag of eval frame LEVEL levels down to FLAG.
The debugger is entered when that frame exits, if the flag is non-nil. */)
@ -3764,9 +3686,6 @@ before making `inhibit-quit' nil. */);
Qclosure = intern_c_string ("closure");
staticpro (&Qclosure);
Qcurry = intern_c_string ("curry");
staticpro (&Qcurry);
Qdebug = intern_c_string ("debug");
staticpro (&Qdebug);
@ -3901,11 +3820,9 @@ alist of active lexical bindings. */);
defsubr (&Srun_hook_with_args_until_success);
defsubr (&Srun_hook_with_args_until_failure);
defsubr (&Sfetch_bytecode);
defsubr (&Scurry);
defsubr (&Sbacktrace_debug);
defsubr (&Sbacktrace);
defsubr (&Sbacktrace_frame);
defsubr (&Scurry);
defsubr (&Sspecial_variable_p);
defsubr (&Sfunctionp);
}

25
src/fns.c
View file

@ -127,8 +127,8 @@ To get the number of bytes, use `string-bytes'. */)
XSETFASTINT (val, MAX_CHAR);
else if (BOOL_VECTOR_P (sequence))
XSETFASTINT (val, XBOOL_VECTOR (sequence)->size);
else if (FUNVECP (sequence))
XSETFASTINT (val, FUNVEC_SIZE (sequence));
else if (COMPILEDP (sequence))
XSETFASTINT (val, ASIZE (sequence) & PSEUDOVECTOR_SIZE_MASK);
else if (CONSP (sequence))
{
i = 0;
@ -488,7 +488,7 @@ concat (int nargs, Lisp_Object *args, enum Lisp_Type target_type, int last_speci
{
this = args[argnum];
if (!(CONSP (this) || NILP (this) || VECTORP (this) || STRINGP (this)
|| FUNVECP (this) || BOOL_VECTOR_P (this)))
|| COMPILEDP (this) || BOOL_VECTOR_P (this)))
wrong_type_argument (Qsequencep, this);
}
@ -512,7 +512,7 @@ concat (int nargs, Lisp_Object *args, enum Lisp_Type target_type, int last_speci
Lisp_Object ch;
EMACS_INT this_len_byte;
if (VECTORP (this) || FUNVECP (this))
if (VECTORP (this) || COMPILEDP (this))
for (i = 0; i < len; i++)
{
ch = AREF (this, i);
@ -1311,9 +1311,7 @@ DEFUN ("elt", Felt, Selt, 2, 2, 0,
return Fcar (Fnthcdr (n, sequence));
/* Faref signals a "not array" error, so check here. */
if (! FUNVECP (sequence))
CHECK_ARRAY (sequence, Qsequencep);
CHECK_ARRAY (sequence, Qsequencep);
return Faref (sequence, n);
}
@ -2092,14 +2090,13 @@ internal_equal (register Lisp_Object o1, register Lisp_Object o2, int depth, int
if (WINDOW_CONFIGURATIONP (o1))
return compare_window_configurations (o1, o2, 0);
/* Aside from them, only true vectors, char-tables, function vectors,
and fonts (font-spec, font-entity, font-ojbect) are sensible to
compare, so eliminate the others now. */
/* Aside from them, only true vectors, char-tables, compiled
functions, and fonts (font-spec, font-entity, font-ojbect)
are sensible to compare, so eliminate the others now. */
if (size & PSEUDOVECTOR_FLAG)
{
if (!(size & (PVEC_FUNVEC
| PVEC_CHAR_TABLE | PVEC_SUB_CHAR_TABLE
| PVEC_FONT)))
if (!(size & (PVEC_COMPILED
| PVEC_CHAR_TABLE | PVEC_SUB_CHAR_TABLE | PVEC_FONT)))
return 0;
size &= PSEUDOVECTOR_SIZE_MASK;
}
@ -2302,7 +2299,7 @@ mapcar1 (EMACS_INT leni, Lisp_Object *vals, Lisp_Object fn, Lisp_Object seq)
1) lists are not relocated and 2) the list is marked via `seq' so will not
be freed */
if (VECTORP (seq) || FUNVECP (seq))
if (VECTORP (seq) || COMPILEDP (seq))
{
for (i = 0; i < leni; i++)
{

3
src/image.c
View file

@ -835,8 +835,9 @@ parse_image_spec (Lisp_Object spec, struct image_keyword *keywords,
case IMAGE_FUNCTION_VALUE:
value = indirect_function (value);
/* FIXME: Shouldn't we use Ffunctionp here? */
if (SUBRP (value)
|| FUNVECP (value)
|| COMPILEDP (value)
|| (CONSP (value) && EQ (XCAR (value), Qlambda)))
break;
return 0;

2
src/keyboard.c
View file

@ -10179,7 +10179,7 @@ a special event, so ignore the prefix argument and don't clear it. */)
return Fexecute_kbd_macro (final, prefixarg, Qnil);
}
if (CONSP (final) || SUBRP (final) || FUNVECP (final))
if (CONSP (final) || SUBRP (final) || COMPILEDP (final))
/* Don't call Fcall_interactively directly because we want to make
sure the backtrace has an entry for `call-interactively'.
For the same reason, pass `cmd' rather than `final'. */

33
src/lisp.h
View file

@ -349,7 +349,7 @@ enum pvec_type
PVEC_NORMAL_VECTOR = 0,
PVEC_PROCESS = 0x200,
PVEC_FRAME = 0x400,
PVEC_FUNVEC = 0x800,
PVEC_COMPILED = 0x800,
PVEC_WINDOW = 0x1000,
PVEC_WINDOW_CONFIGURATION = 0x2000,
PVEC_SUBR = 0x4000,
@ -607,7 +607,7 @@ extern Lisp_Object make_number (EMACS_INT);
#define XSETWINDOW(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_WINDOW))
#define XSETTERMINAL(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_TERMINAL))
#define XSETSUBR(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_SUBR))
#define XSETFUNVEC(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_FUNVEC))
#define XSETCOMPILED(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_COMPILED))
#define XSETBUFFER(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_BUFFER))
#define XSETCHAR_TABLE(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_CHAR_TABLE))
#define XSETBOOL_VECTOR(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_BOOL_VECTOR))
@ -623,9 +623,6 @@ extern Lisp_Object make_number (EMACS_INT);
eassert ((IDX) >= 0 && (IDX) < ASIZE (ARRAY)), \
AREF ((ARRAY), (IDX)) = (VAL))
/* Return the size of the psuedo-vector object FUNVEC. */
#define FUNVEC_SIZE(funvec) (ASIZE (funvec) & PSEUDOVECTOR_SIZE_MASK)
/* Convenience macros for dealing with Lisp strings. */
#define SDATA(string) (XSTRING (string)->data + 0)
@ -1474,7 +1471,7 @@ struct Lisp_Float
typedef unsigned char UCHAR;
#endif
/* Meanings of slots in a byte-compiled function vector: */
/* Meanings of slots in a Lisp_Compiled: */
#define COMPILED_ARGLIST 0
#define COMPILED_BYTECODE 1
@ -1484,24 +1481,6 @@ typedef unsigned char UCHAR;
#define COMPILED_INTERACTIVE 5
#define COMPILED_PUSH_ARGS 6
/* Return non-zero if TAG, the first element from a funvec object, refers
to a byte-code object. Byte-code objects are distinguished from other
`funvec' objects by having a (possibly empty) list as their first
element -- other funvec types use a non-nil symbol there. */
#define FUNVEC_COMPILED_TAG_P(tag) \
(NILP (tag) || CONSP (tag))
/* Return non-zero if FUNVEC, which should be a `funvec' object, is a
byte-compiled function. Byte-compiled function are funvecs with the
arglist as the first element (other funvec types will have a symbol
identifying the type as the first object). */
#define FUNVEC_COMPILED_P(funvec) \
(FUNVEC_SIZE (funvec) > 0 && FUNVEC_COMPILED_TAG_P (AREF (funvec, 0)))
/* Return non-zero if OBJ is byte-compile function. */
#define COMPILEDP(obj) \
(FUNVECP (obj) && FUNVEC_COMPILED_P (obj))
/* Flag bits in a character. These also get used in termhooks.h.
Richard Stallman <rms@gnu.ai.mit.edu> thinks that MULE
(MUlti-Lingual Emacs) might need 22 bits for the character value
@ -1657,7 +1636,7 @@ typedef struct {
#define WINDOWP(x) PSEUDOVECTORP (x, PVEC_WINDOW)
#define TERMINALP(x) PSEUDOVECTORP (x, PVEC_TERMINAL)
#define SUBRP(x) PSEUDOVECTORP (x, PVEC_SUBR)
#define FUNVECP(x) PSEUDOVECTORP (x, PVEC_FUNVEC)
#define COMPILEDP(x) PSEUDOVECTORP (x, PVEC_COMPILED)
#define BUFFERP(x) PSEUDOVECTORP (x, PVEC_BUFFER)
#define CHAR_TABLE_P(x) PSEUDOVECTORP (x, PVEC_CHAR_TABLE)
#define SUB_CHAR_TABLE_P(x) PSEUDOVECTORP (x, PVEC_SUB_CHAR_TABLE)
@ -1851,7 +1830,7 @@ typedef struct {
#define FUNCTIONP(OBJ) \
((CONSP (OBJ) && EQ (XCAR (OBJ), Qlambda)) \
|| (SYMBOLP (OBJ) && !NILP (Ffboundp (OBJ))) \
|| FUNVECP (OBJ) \
|| COMPILEDP (OBJ) \
|| SUBRP (OBJ))
/* defsubr (Sname);
@ -2725,7 +2704,6 @@ EXFUN (Fmake_list, 2);
extern Lisp_Object allocate_misc (void);
EXFUN (Fmake_vector, 2);
EXFUN (Fvector, MANY);
EXFUN (Ffunvec, MANY);
EXFUN (Fmake_symbol, 1);
EXFUN (Fmake_marker, 0);
EXFUN (Fmake_string, 2);
@ -2745,7 +2723,6 @@ extern Lisp_Object make_pure_c_string (const char *data);
extern Lisp_Object pure_cons (Lisp_Object, Lisp_Object);
extern Lisp_Object make_pure_vector (EMACS_INT);
EXFUN (Fgarbage_collect, 0);
extern Lisp_Object make_funvec (Lisp_Object, int, int, Lisp_Object *);
EXFUN (Fmake_byte_code, MANY);
EXFUN (Fmake_bool_vector, 2);
extern Lisp_Object Qchar_table_extra_slots;

33
src/lread.c
View file

@ -2497,8 +2497,14 @@ read1 (register Lisp_Object readcharfun, int *pch, int first_in_list)
invalid_syntax ("#&...", 5);
}
if (c == '[')
/* `function vector' objects, including byte-compiled functions. */
return read_vector (readcharfun, 1);
{
/* Accept compiled functions at read-time so that we don't have to
build them using function calls. */
Lisp_Object tmp;
tmp = read_vector (readcharfun, 1);
return Fmake_byte_code (XVECTOR (tmp)->size,
XVECTOR (tmp)->contents);
}
if (c == '(')
{
Lisp_Object tmp;
@ -3311,7 +3317,7 @@ isfloat_string (const char *cp, int ignore_trailing)
static Lisp_Object
read_vector (Lisp_Object readcharfun, int read_funvec)
read_vector (Lisp_Object readcharfun, int bytecodeflag)
{
register int i;
register int size;
@ -3319,11 +3325,6 @@ read_vector (Lisp_Object readcharfun, int read_funvec)
register Lisp_Object tem, item, vector;
register struct Lisp_Cons *otem;
Lisp_Object len;
/* If we're reading a funvec object we start out assuming it's also a
byte-code object (a subset of funvecs), so we can do any special
processing needed. If it's just an ordinary funvec object, we'll
realize that as soon as we've read the first element. */
int read_bytecode = read_funvec;
tem = read_list (1, readcharfun);
len = Flength (tem);
@ -3335,18 +3336,11 @@ read_vector (Lisp_Object readcharfun, int read_funvec)
{
item = Fcar (tem);
/* If READ_BYTECODE is set, check whether this is really a byte-code
object, or just an ordinary `funvec' object -- non-byte-code
funvec objects use the same reader syntax. We can tell from the
first element which one it is. */
if (read_bytecode && i == 0 && ! FUNVEC_COMPILED_TAG_P (item))
read_bytecode = 0; /* Nope. */
/* If `load-force-doc-strings' is t when reading a lazily-loaded
bytecode object, the docstring containing the bytecode and
constants values must be treated as unibyte and passed to
Fread, to get the actual bytecode string and constants vector. */
if (read_bytecode && load_force_doc_strings)
if (bytecodeflag && load_force_doc_strings)
{
if (i == COMPILED_BYTECODE)
{
@ -3400,13 +3394,6 @@ read_vector (Lisp_Object readcharfun, int read_funvec)
free_cons (otem);
}
if (read_bytecode && size >= 4)
/* Convert this vector to a bytecode object. */
vector = Fmake_byte_code (size, XVECTOR (vector)->contents);
else if (read_funvec && size >= 1)
/* Convert this vector to an ordinary funvec object. */
XSETFUNVEC (vector, XVECTOR (vector));
return vector;
}

6
src/print.c
View file

@ -1155,7 +1155,7 @@ print_preprocess (Lisp_Object obj)
loop:
if (STRINGP (obj) || CONSP (obj) || VECTORP (obj)
|| FUNVECP (obj) || CHAR_TABLE_P (obj) || SUB_CHAR_TABLE_P (obj)
|| COMPILEDP (obj) || CHAR_TABLE_P (obj) || SUB_CHAR_TABLE_P (obj)
|| HASH_TABLE_P (obj)
|| (! NILP (Vprint_gensym)
&& SYMBOLP (obj)
@ -1337,7 +1337,7 @@ print_object (Lisp_Object obj, register Lisp_Object printcharfun, int escapeflag
/* Detect circularities and truncate them. */
if (STRINGP (obj) || CONSP (obj) || VECTORP (obj)
|| FUNVECP (obj) || CHAR_TABLE_P (obj) || SUB_CHAR_TABLE_P (obj)
|| COMPILEDP (obj) || CHAR_TABLE_P (obj) || SUB_CHAR_TABLE_P (obj)
|| HASH_TABLE_P (obj)
|| (! NILP (Vprint_gensym)
&& SYMBOLP (obj)
@ -1960,7 +1960,7 @@ print_object (Lisp_Object obj, register Lisp_Object printcharfun, int escapeflag
else
{
EMACS_INT size = XVECTOR (obj)->size;
if (FUNVECP (obj))
if (COMPILEDP (obj))
{
PRINTCHAR ('#');
size &= PSEUDOVECTOR_SIZE_MASK;