((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.
+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.
* 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.
* 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.
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
@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
@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
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
* 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
@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
@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}.
* 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.
* 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.
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.
\f
* 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).
\f
----------------------------------------------------------------------
This file is part of GNU Emacs.
+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
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.
@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)
# 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
;; 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)
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
;; 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)
(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.
(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>"
(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
;; 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)
((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
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)
(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
;; 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)
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))
(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)))
;; 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))
(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
;; 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).
;; 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
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
;; 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,
(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)))
(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)
(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
(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)
(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))))
(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))
-
\f
;; Compile those primitive ordinary functions
;; which have special byte codes just for speed.
(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
;; (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.
;;
;;; 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
;; 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)
`(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
;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)
(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
;;;;;; 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" "\
(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)
+++ /dev/null
-;;; 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
;;; Code:
(eval-when-compile
- (require 'cl)
- (require 'eieio-comp))
+ (require 'cl))
(defvar eieio-version "1.3"
"Current version of EIEIO.")
;; 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.")
(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)
\f
;;; Important macros used in eieio.
;;
((typearg class-name) arg2 &optional opt &rest rest)
\"doc-string\"
body)"
- `(eieio-defmethod (quote ,method) (quote ,args)))
-
-(defun eieio-defmethod (method args)
+ (let* ((key (cond ((or (eq ':BEFORE (car args))
+ (eq ':before (car args)))
+ (setq args (cdr args))
+ :before)
+ ((or (eq ':AFTER (car args))
+ (eq ':after (car args)))
+ (setq args (cdr args))
+ :after)
+ ((or (eq ':PRIMARY (car args))
+ (eq ':primary (car args)))
+ (setq args (cdr args))
+ :primary)
+ ((or (eq ':STATIC (car args))
+ (eq ':static (car args)))
+ (setq args (cdr args))
+ :static)
+ (t nil)))
+ (params (car args))
+ (lamparams
+ (mapcar (lambda (param) (if (listp param) (car param) param))
+ params))
+ (arg1 (car params))
+ (class (if (listp arg1) (nth 1 arg1) nil)))
+ `(eieio-defmethod ',method
+ '(,@(if key (list key))
+ ,params)
+ (lambda ,lamparams ,@(cdr args)))))
+
+(defun eieio-defmethod (method args &optional code)
"Work part of the `defmethod' macro defining METHOD with ARGS."
(let ((key nil) (body nil) (firstarg nil) (argfix nil) (argclass nil) loopa)
;; find optional keys
;; 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
;; 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)
(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)))
((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)))
+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
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.
+++ /dev/null
-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
}
-/* 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.
}
-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,
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);
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;
}
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;
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);
}
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. */
defsubr (&Scons);
defsubr (&Slist);
defsubr (&Svector);
- defsubr (&Sfunvec);
defsubr (&Smake_byte_code);
defsubr (&Smake_list);
defsubr (&Smake_vector);
*
* 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 */
\f
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:
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;
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))
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)
{
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);
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");
staticpro (&Qwindow);
/* staticpro (&Qsubr); */
staticpro (&Qcompiled_function);
- staticpro (&Qfunction_vector);
staticpro (&Qbuffer);
staticpro (&Qframe);
staticpro (&Qvector);
defsubr (&Smarkerp);
defsubr (&Ssubrp);
defsubr (&Sbyte_code_function_p);
- defsubr (&Sfunvecp);
defsubr (&Schar_or_string_p);
defsubr (&Scar);
defsubr (&Scdr);
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.");
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;
}
}
}
- else if (FUNVECP (fun))
+ else if (COMPILEDP (fun))
val = apply_lambda (fun, original_args);
else
{
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))
{
}
}
}
- else if (FUNVECP (fun))
+ else if (COMPILEDP (fun))
val = funcall_lambda (fun, numargs, args + 1);
else
{
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. */
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))
}
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;
}
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
\f
-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);
-}
-\f
-
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. */)
Qclosure = intern_c_string ("closure");
staticpro (&Qclosure);
- Qcurry = intern_c_string ("curry");
- staticpro (&Qcurry);
-
Qdebug = intern_c_string ("debug");
staticpro (&Qdebug);
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);
}
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;
{
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);
}
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);
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);
}
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;
}
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++)
{
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;
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'. */
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,
#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))
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)
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
#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
#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)
#define FUNCTIONP(OBJ) \
((CONSP (OBJ) && EQ (XCAR (OBJ), Qlambda)) \
|| (SYMBOLP (OBJ) && !NILP (Ffboundp (OBJ))) \
- || FUNVECP (OBJ) \
+ || COMPILEDP (OBJ) \
|| SUBRP (OBJ))
/* defsubr (Sname);
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);
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;
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;
\f
static Lisp_Object
-read_vector (Lisp_Object readcharfun, int read_funvec)
+read_vector (Lisp_Object readcharfun, int bytecodeflag)
{
register int i;
register int size;
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);
{
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)
{
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;
}
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)
/* 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)
else
{
EMACS_INT size = XVECTOR (obj)->size;
- if (FUNVECP (obj))
+ if (COMPILEDP (obj))
{
PRINTCHAR ('#');
size &= PSEUDOVECTOR_SIZE_MASK;
HCoop / bpt / emacs.git / commitdiff