From: Miles Bader <miles@gnu.org>
Cc: lars@nocrew.org, monnier@iro.umontreal.ca, emacs-devel@gnu.org
Subject: Function vectors: +funvec-20030520-0-c.patch
Date: 20 May 2004 07:32:40 +0900 [thread overview]
Message-ID: <87d650120n.fsf_-_@tc-1-100.kawasaki.gol.ne.jp> (raw)
In-Reply-To: <E1BQWJ1-0002ov-Vt@fencepost.gnu.org>
[-- Attachment #1: Type: text/plain, Size: 195 bytes --]
Ok, here's a new patch that gets rid of the reserved slot for #[curry]
objects, and does some more minor tweaking (doc tweaks, add some
description to describe-function, etc).
-Miles
Patch:
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: +funvec-20030520-0-c.patch --]
[-- Type: text/x-patch, Size: 50297 bytes --]
lisp/ChangeLog:
2004-05-20 Miles Bader <miles@gnu.org>
* subr.el (functionp): Use `funvecp' instead of
`byte-compiled-function-p'.
* help-fns.el (describe-function-1): Describe curried functions
and other funvecs as such.
(help-highlight-arguments): Only format things that look like a
function.
lispref/ChangeLog:
2004-05-16 Miles Bader <miles@gnu.org>
* objects.texi (Funvec Type): Renamed from `Byte-Code Type'.
Add description of general funvec objects.
* functions.texi (What Is a Function): Add entry for funvecs,
adjust byte-code function entry accordingly.
(Function Currying): New node.
src/ChangeLog:
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.
M src/eval.c
M src/image.c
M etc/NEWS
M src/data.c
M lispref/functions.texi
M src/doc.c
M src/ChangeLog
M src/alloc.c
M src/keyboard.c
M src/fns.c
M lispref/vol1.texi
M lispref/objects.texi
M lispref/ChangeLog
M src/lisp.h
M lisp/help-fns.el
M src/lread.c
M src/print.c
M lispref/vol2.texi
M lisp/ChangeLog
M lisp/subr.el
M lispref/elisp.texi
* modified files
*** orig/etc/NEWS
--- mod/etc/NEWS
***************
*** 3485,3490 ****
--- 3485,3504 ----
** Arguments for remove-overlays are now optional, so that you can remove
all overlays in the buffer by just calling (remove-overlay).
+ ** 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
+
** New packages:
*** The new package gdb-ui.el provides an enhanced graphical interface to
*** orig/lisp/help-fns.el
--- mod/lisp/help-fns.el
***************
*** 267,273 ****
doc))
(defun help-highlight-arguments (usage doc &rest args)
! (when usage
(with-temp-buffer
(insert usage)
(goto-char (point-min))
--- 267,273 ----
doc))
(defun help-highlight-arguments (usage doc &rest args)
! (when (and usage (string-match "^(" usage))
(with-temp-buffer
(insert usage)
(goto-char (point-min))
***************
*** 309,314 ****
--- 309,321 ----
(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 (symbolp (symbol-function def))
(setq def (symbol-function def)))
***************
*** 428,436 ****
((or (stringp def)
(vectorp def))
(format "\nMacro: %s" (format-kbd-macro def)))
(t "[Missing arglist. Please make a bug report.]")))
(high (help-highlight-arguments use doc)))
! (insert (car high) "\n")
(setq doc (cdr high))))
(let ((obsolete (and
;; function might be a lambda construct.
--- 435,459 ----
((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)))
! (when (car high)
! (insert (car high) "\n"))
(setq doc (cdr high))))
(let ((obsolete (and
;; function might be a lambda construct.
*** orig/lisp/subr.el
--- mod/lisp/subr.el
***************
*** 2313,2319 ****
(error nil))
(eq (car-safe object) 'autoload)
(not (car-safe (cdr-safe (cdr-safe (cdr-safe (cdr-safe object)))))))
! (subrp object) (byte-code-function-p object)
(eq (car-safe object) 'lambda)))
(defun assq-delete-all (key alist)
--- 2313,2320 ----
(error nil))
(eq (car-safe object) 'autoload)
(not (car-safe (cdr-safe (cdr-safe (cdr-safe (cdr-safe object)))))))
! (subrp object)
! (funvecp object)
(eq (car-safe object) 'lambda)))
(defun assq-delete-all (key alist)
*** orig/lispref/elisp.texi
--- mod/lispref/elisp.texi
***************
*** 236,242 ****
* 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.
! * Byte-Code Type:: A function written in Lisp, then compiled.
* Autoload Type:: A type used for automatically loading seldom-used
functions.
--- 236,242 ----
* 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.
* Autoload Type:: A type used for automatically loading seldom-used
functions.
***************
*** 386,403 ****
Functions
! * What Is a Function:: Lisp functions vs primitives; terminology.
* Lambda Expressions:: How functions are expressed as Lisp objects.
* Function Names:: A symbol can serve as the name of a function.
* Defining Functions:: Lisp expressions for defining functions.
* Calling Functions:: How to use an existing function.
* Mapping Functions:: Applying a function to each element of a list, etc.
! * Anonymous Functions:: Lambda-expressions are functions with no names.
* Function Cells:: Accessing or setting the function definition
of a symbol.
* Related Topics:: Cross-references to specific Lisp primitives
! that have a special bearing on how
! functions work.
Lambda Expressions
--- 386,406 ----
Functions
! * What Is a Function:: Lisp functions vs. primitives; terminology.
* Lambda Expressions:: How functions are expressed as Lisp objects.
* Function Names:: A symbol can serve as the name of a function.
* Defining Functions:: Lisp expressions for defining functions.
* Calling Functions:: How to use an existing function.
* Mapping Functions:: Applying a function to each element of a list, etc.
! * Anonymous Functions:: Lambda expressions are functions with no names.
* Function Cells:: Accessing or setting the function definition
of a symbol.
+ * Inline Functions:: Defining functions that the compiler will open code.
+ * 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.
Lambda Expressions
*** orig/lispref/functions.texi
--- mod/lispref/functions.texi
***************
*** 1,6 ****
@c -*-texinfo-*-
@c This is part of the GNU Emacs Lisp Reference Manual.
! @c Copyright (C) 1990, 1991, 1992, 1993, 1994, 1995, 1998, 1999
@c Free Software Foundation, Inc.
@c See the file elisp.texi for copying conditions.
@setfilename ../info/functions
--- 1,6 ----
@c -*-texinfo-*-
@c This is part of the GNU Emacs Lisp Reference Manual.
! @c Copyright (C) 1990, 1991, 1992, 1993, 1994, 1995, 1998, 1999, 2004
@c Free Software Foundation, Inc.
@c See the file elisp.texi for copying conditions.
@setfilename ../info/functions
***************
*** 21,27 ****
* Anonymous Functions:: Lambda expressions are functions with no names.
* Function Cells:: Accessing or setting the function definition
of a symbol.
! * Inline Functions:: Defining functions that the compiler will open code.
* 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.
--- 21,29 ----
* Anonymous Functions:: Lambda expressions are functions with no names.
* Function Cells:: Accessing or setting the function definition
of a symbol.
! * Inline Functions:: Defining functions that the compiler will open code.
! * 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.
***************
*** 109,115 ****
@item byte-code function
A @dfn{byte-code function} is a function that has been compiled by the
! byte compiler. @xref{Byte-Code Type}.
@end table
@defun functionp object
--- 111,135 ----
@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
!
@end table
@defun functionp object
***************
*** 150,155 ****
--- 170,180 ----
@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
@tindex subr-arity
This function provides information about the argument list of a
***************
*** 1197,1202 ****
--- 1222,1270 ----
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 Function Safety
@section Determining whether a function is safe to call
@cindex function safety
*** orig/lispref/objects.texi
--- mod/lispref/objects.texi
***************
*** 1,6 ****
@c -*-texinfo-*-
@c This is part of the GNU Emacs Lisp Reference Manual.
! @c Copyright (C) 1990, 1991, 1992, 1993, 1994, 1995, 1998, 1999, 2003
@c Free Software Foundation, Inc.
@c See the file elisp.texi for copying conditions.
@setfilename ../info/objects
--- 1,6 ----
@c -*-texinfo-*-
@c This is part of the GNU Emacs Lisp Reference Manual.
! @c Copyright (C) 1990, 1991, 1992, 1993, 1994, 1995, 1998, 1999, 2003, 2004
@c Free Software Foundation, Inc.
@c See the file elisp.texi for copying conditions.
@setfilename ../info/objects
***************
*** 155,161 ****
* 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.
! * Byte-Code Type:: A function written in Lisp, then compiled.
* Autoload Type:: A type used for automatically loading seldom-used
functions.
@end menu
--- 155,161 ----
* 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.
* Autoload Type:: A type used for automatically loading seldom-used
functions.
@end menu
***************
*** 1200,1217 ****
@end group
@end example
! @node Byte-Code Type
! @subsection Byte-Code Function Type
! 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 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
--- 1200,1254 ----
@end group
@end example
! @node Funvec Type
! @subsection ``Function Vector' Type
! @cindex function vector
! @cindex funvec
!
! 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 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
@node Autoload Type
@subsection Autoload Type
***************
*** 1626,1632 ****
@xref{Buffer Basics, bufferp}.
@item byte-code-function-p
! @xref{Byte-Code Type, byte-code-function-p}.
@item case-table-p
@xref{Case Tables, case-table-p}.
--- 1663,1669 ----
@xref{Buffer Basics, bufferp}.
@item byte-code-function-p
! @xref{Funvec Type, byte-code-function-p}.
@item case-table-p
@xref{Case Tables, case-table-p}.
*** orig/lispref/vol1.texi
--- mod/lispref/vol1.texi
***************
*** 326,332 ****
* 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.
! * Byte-Code Type:: A function written in Lisp, then compiled.
* Autoload Type:: A type used for automatically loading seldom-used
functions.
--- 326,332 ----
* 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.
* Autoload Type:: A type used for automatically loading seldom-used
functions.
*** orig/lispref/vol2.texi
--- mod/lispref/vol2.texi
***************
*** 327,333 ****
* 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.
! * Byte-Code Type:: A function written in Lisp, then compiled.
* Autoload Type:: A type used for automatically loading seldom-used
functions.
--- 327,333 ----
* 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.
* Autoload Type:: A type used for automatically loading seldom-used
functions.
*** orig/src/alloc.c
--- mod/src/alloc.c
***************
*** 2643,2648 ****
--- 2643,2680 ----
}
+ /* 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 (kind, num_nil_slots, num_params, params)
+ Lisp_Object kind;
+ int num_nil_slots, 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]);
+
+ XSETFUNVEC (funvec, XVECTOR (funvec));
+
+ return funvec;
+ }
+
+
DEFUN ("make-char-table", Fmake_char_table, Smake_char_table, 1, 2, 0,
doc: /* Return a newly created char-table, with purpose PURPOSE.
Each element is initialized to INIT, which defaults to nil.
***************
*** 2707,2712 ****
--- 2739,2767 ----
}
+ 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) */)
+ (nargs, args)
+ register 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,
***************
*** 2722,2727 ****
--- 2777,2786 ----
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);
***************
*** 2743,2749 ****
args[index] = Fpurecopy (args[index]);
p->contents[index] = args[index];
}
! XSETCOMPILED (val, p);
return val;
}
--- 2802,2808 ----
args[index] = Fpurecopy (args[index]);
p->contents[index] = args[index];
}
! XSETFUNVEC (val, p);
return val;
}
***************
*** 4228,4234 ****
return make_pure_string (SDATA (obj), SCHARS (obj),
SBYTES (obj),
STRING_MULTIBYTE (obj));
! else if (COMPILEDP (obj) || VECTORP (obj))
{
register struct Lisp_Vector *vec;
register int i;
--- 4287,4293 ----
return make_pure_string (SDATA (obj), SCHARS (obj),
SBYTES (obj),
STRING_MULTIBYTE (obj));
! else if (FUNVECP (obj) || VECTORP (obj))
{
register struct Lisp_Vector *vec;
register int i;
***************
*** 4240,4247 ****
vec = XVECTOR (make_pure_vector (size));
for (i = 0; i < size; i++)
vec->contents[i] = Fpurecopy (XVECTOR (obj)->contents[i]);
! if (COMPILEDP (obj))
! XSETCOMPILED (obj, vec);
else
XSETVECTOR (obj, vec);
return obj;
--- 4299,4306 ----
vec = XVECTOR (make_pure_vector (size));
for (i = 0; i < size; i++)
vec->contents[i] = Fpurecopy (XVECTOR (obj)->contents[i]);
! if (FUNVECP (obj))
! XSETFUNVEC (obj, vec);
else
XSETVECTOR (obj, vec);
return obj;
***************
*** 4799,4805 ****
}
else if (GC_SUBRP (obj))
break;
! else if (GC_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. */
--- 4858,4864 ----
}
else if (GC_SUBRP (obj))
break;
! else if (GC_FUNVECP (obj) && FUNVEC_COMPILED_P (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. */
***************
*** 5758,5763 ****
--- 5817,5823 ----
defsubr (&Scons);
defsubr (&Slist);
defsubr (&Svector);
+ defsubr (&Sfunvec);
defsubr (&Smake_byte_code);
defsubr (&Smake_list);
defsubr (&Smake_vector);
*** orig/src/data.c
--- mod/src/data.c
***************
*** 92,98 ****
static Lisp_Object Qsymbol, Qstring, Qcons, Qmarker, Qoverlay;
static Lisp_Object Qfloat, Qwindow_configuration, Qwindow;
Lisp_Object Qprocess;
! static Lisp_Object Qcompiled_function, Qbuffer, Qframe, Qvector;
static Lisp_Object Qchar_table, Qbool_vector, Qhash_table;
static Lisp_Object Qsubrp, Qmany, Qunevalled;
--- 92,98 ----
static Lisp_Object Qsymbol, Qstring, Qcons, Qmarker, Qoverlay;
static Lisp_Object Qfloat, Qwindow_configuration, Qwindow;
Lisp_Object Qprocess;
! static Lisp_Object Qcompiled_function, Qfunction_vector, Qbuffer, Qframe, Qvector;
static Lisp_Object Qchar_table, Qbool_vector, Qhash_table;
static Lisp_Object Qsubrp, Qmany, Qunevalled;
***************
*** 231,238 ****
return Qwindow;
if (GC_SUBRP (object))
return Qsubr;
! if (GC_COMPILEDP (object))
! return Qcompiled_function;
if (GC_BUFFERP (object))
return Qbuffer;
if (GC_CHAR_TABLE_P (object))
--- 231,241 ----
return Qwindow;
if (GC_SUBRP (object))
return Qsubr;
! if (GC_FUNVECP (object))
! if (FUNVEC_COMPILED_P (object))
! return Qcompiled_function;
! else
! return Qfunction_vector;
if (GC_BUFFERP (object))
return Qbuffer;
if (GC_CHAR_TABLE_P (object))
***************
*** 444,449 ****
--- 447,460 ----
return Qnil;
}
+ DEFUN ("funvecp", Ffunvecp, Sfunvecp, 1, 1, 0,
+ doc: /* Return t if OBJECT is a `function vector' object. */)
+ (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 (an integer) or a string. */)
(object)
***************
*** 2040,2054 ****
{
int size = 0;
if (VECTORP (array))
! size = XVECTOR (array)->size;
! else if (COMPILEDP (array))
! size = XVECTOR (array)->size & PSEUDOVECTOR_SIZE_MASK;
else
wrong_type_argument (Qarrayp, array);
if (idxval < 0 || idxval >= size)
args_out_of_range (array, idx);
! return XVECTOR (array)->contents[idxval];
}
}
--- 2051,2065 ----
{
int size = 0;
if (VECTORP (array))
! size = ASIZE (array);
! else if (FUNVECP (array))
! size = FUNVEC_SIZE (array);
else
wrong_type_argument (Qarrayp, array);
if (idxval < 0 || idxval >= size)
args_out_of_range (array, idx);
! return AREF (array, idxval);
}
}
***************
*** 3221,3226 ****
--- 3232,3238 ----
Qwindow = intern ("window");
/* Qsubr = intern ("subr"); */
Qcompiled_function = intern ("compiled-function");
+ Qfunction_vector = intern ("function-vector");
Qbuffer = intern ("buffer");
Qframe = intern ("frame");
Qvector = intern ("vector");
***************
*** 3240,3245 ****
--- 3252,3258 ----
staticpro (&Qwindow);
/* staticpro (&Qsubr); */
staticpro (&Qcompiled_function);
+ staticpro (&Qfunction_vector);
staticpro (&Qbuffer);
staticpro (&Qframe);
staticpro (&Qvector);
***************
*** 3276,3281 ****
--- 3289,3295 ----
defsubr (&Smarkerp);
defsubr (&Ssubrp);
defsubr (&Sbyte_code_function_p);
+ defsubr (&Sfunvecp);
defsubr (&Schar_or_string_p);
defsubr (&Scar);
defsubr (&Scdr);
*** orig/src/doc.c
--- mod/src/doc.c
***************
*** 404,409 ****
--- 404,414 ----
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.");
*** orig/src/eval.c
--- mod/src/eval.c
***************
*** 93,98 ****
--- 93,99 ----
Lisp_Object Qand_rest, Qand_optional;
Lisp_Object Qdebug_on_error;
Lisp_Object Qdeclare;
+ Lisp_Object Qcurry;
/* This holds either the symbol `run-hooks' or nil.
It is nil at an early stage of startup, and when Emacs
***************
*** 2116,2122 ****
abort ();
}
}
! if (COMPILEDP (fun))
val = apply_lambda (fun, original_args, 1);
else
{
--- 2117,2123 ----
abort ();
}
}
! if (FUNVECP (fun))
val = apply_lambda (fun, original_args, 1);
else
{
***************
*** 2770,2776 ****
abort ();
}
}
! if (COMPILEDP (fun))
val = funcall_lambda (fun, numargs, args + 1);
else
{
--- 2771,2778 ----
abort ();
}
}
!
! if (FUNVECP (fun))
val = funcall_lambda (fun, numargs, args + 1);
else
{
***************
*** 2842,2847 ****
--- 2844,2900 ----
return tem;
}
+
+ /* Call a non-bytecode funvec object FUN, on the argments in ARGS (of
+ length NARGS). */
+
+ static Lisp_Object
+ funcall_funvec (fun, nargs, args)
+ 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. */
+ bcopy (curried_args, funcall_args + curried_args_offs,
+ num_curried_args * sizeof (Lisp_Object));
+ bcopy (args, funcall_args + user_args_offs,
+ nargs * sizeof (Lisp_Object));
+
+ return Ffuncall (num_funcall_args, funcall_args);
+ }
+ else
+ return Fsignal (Qinvalid_function, Fcons (fun, Qnil));
+ }
+
+
/* 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. */
***************
*** 2856,2861 ****
--- 2909,2919 ----
int count = SPECPDL_INDEX ();
int i, optional, rest;
+ 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))
{
syms_left = XCDR (fun);
***************
*** 3123,3128 ****
--- 3181,3207 ----
return value;
}
\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) */)
+ (nargs, args)
+ register 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. */)
***************
*** 3313,3318 ****
--- 3392,3400 ----
Qand_optional = intern ("&optional");
staticpro (&Qand_optional);
+ Qcurry = intern ("curry");
+ staticpro (&Qcurry);
+
DEFVAR_LISP ("stack-trace-on-error", &Vstack_trace_on_error,
doc: /* *Non-nil means errors display a backtrace buffer.
More precisely, this happens for any error that is handled
***************
*** 3430,3435 ****
--- 3512,3518 ----
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);
*** orig/src/fns.c
--- mod/src/fns.c
***************
*** 152,159 ****
XSETFASTINT (val, MAX_CHAR);
else if (BOOL_VECTOR_P (sequence))
XSETFASTINT (val, XBOOL_VECTOR (sequence)->size);
! else if (COMPILEDP (sequence))
! XSETFASTINT (val, XVECTOR (sequence)->size & PSEUDOVECTOR_SIZE_MASK);
else if (CONSP (sequence))
{
i = 0;
--- 152,159 ----
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 (CONSP (sequence))
{
i = 0;
***************
*** 579,585 ****
{
this = args[argnum];
if (!(CONSP (this) || NILP (this) || VECTORP (this) || STRINGP (this)
! || COMPILEDP (this) || BOOL_VECTOR_P (this)))
{
args[argnum] = wrong_type_argument (Qsequencep, this);
}
--- 579,585 ----
{
this = args[argnum];
if (!(CONSP (this) || NILP (this) || VECTORP (this) || STRINGP (this)
! || FUNVECP (this) || BOOL_VECTOR_P (this)))
{
args[argnum] = wrong_type_argument (Qsequencep, this);
}
***************
*** 605,611 ****
Lisp_Object ch;
int this_len_byte;
! if (VECTORP (this))
for (i = 0; i < len; i++)
{
ch = XVECTOR (this)->contents[i];
--- 605,611 ----
Lisp_Object ch;
int this_len_byte;
! if (VECTORP (this) || FUNVECP (this))
for (i = 0; i < len; i++)
{
ch = XVECTOR (this)->contents[i];
***************
*** 1408,1414 ****
{
if (CONSP (sequence) || NILP (sequence))
return Fcar (Fnthcdr (n, sequence));
! else if (STRINGP (sequence) || VECTORP (sequence)
|| BOOL_VECTOR_P (sequence) || CHAR_TABLE_P (sequence))
return Faref (sequence, n);
else
--- 1408,1414 ----
{
if (CONSP (sequence) || NILP (sequence))
return Fcar (Fnthcdr (n, sequence));
! else if (STRINGP (sequence) || VECTORP (sequence) || FUNVECP (sequence)
|| BOOL_VECTOR_P (sequence) || CHAR_TABLE_P (sequence))
return Faref (sequence, n);
else
***************
*** 2225,2235 ****
if (WINDOW_CONFIGURATIONP (o1))
return compare_window_configurations (o1, o2, 0);
! /* Aside from them, only true vectors, char-tables, and compiled
! functions are sensible to compare, so eliminate the others now. */
if (size & PSEUDOVECTOR_FLAG)
{
! if (!(size & (PVEC_COMPILED | PVEC_CHAR_TABLE)))
return 0;
size &= PSEUDOVECTOR_SIZE_MASK;
}
--- 2225,2235 ----
if (WINDOW_CONFIGURATIONP (o1))
return compare_window_configurations (o1, o2, 0);
! /* Aside from them, only true vectors, char-tables, and function
! vectors are sensible to compare, so eliminate the others now. */
if (size & PSEUDOVECTOR_FLAG)
{
! if (!(size & (PVEC_FUNVEC | PVEC_CHAR_TABLE)))
return 0;
size &= PSEUDOVECTOR_SIZE_MASK;
}
***************
*** 2912,2918 ****
/* We need not explicitly protect `tail' because it is used only on lists, and
1) lists are not relocated and 2) the list is marked via `seq' so will not be freed */
! if (VECTORP (seq))
{
for (i = 0; i < leni; i++)
{
--- 2912,2918 ----
/* We need not explicitly protect `tail' because it is used only on lists, and
1) lists are not relocated and 2) the list is marked via `seq' so will not be freed */
! if (VECTORP (seq) || FUNVECP (seq))
{
for (i = 0; i < leni; i++)
{
*** orig/src/image.c
--- mod/src/image.c
***************
*** 875,881 ****
case IMAGE_FUNCTION_VALUE:
value = indirect_function (value);
if (SUBRP (value)
! || COMPILEDP (value)
|| (CONSP (value) && EQ (XCAR (value), Qlambda)))
break;
return 0;
--- 875,881 ----
case IMAGE_FUNCTION_VALUE:
value = indirect_function (value);
if (SUBRP (value)
! || FUNVECP (value)
|| (CONSP (value) && EQ (XCAR (value), Qlambda)))
break;
return 0;
*** orig/src/keyboard.c
--- mod/src/keyboard.c
***************
*** 9658,9664 ****
return Fexecute_kbd_macro (final, prefixarg, Qnil);
}
! if (CONSP (final) || SUBRP (final) || COMPILEDP (final))
{
backtrace.next = backtrace_list;
backtrace_list = &backtrace;
--- 9658,9664 ----
return Fexecute_kbd_macro (final, prefixarg, Qnil);
}
! if (CONSP (final) || SUBRP (final) || FUNVECP (final))
{
backtrace.next = backtrace_list;
backtrace_list = &backtrace;
*** orig/src/lisp.h
--- mod/src/lisp.h
***************
*** 259,265 ****
PVEC_NORMAL_VECTOR = 0,
PVEC_PROCESS = 0x200,
PVEC_FRAME = 0x400,
! PVEC_COMPILED = 0x800,
PVEC_WINDOW = 0x1000,
PVEC_WINDOW_CONFIGURATION = 0x2000,
PVEC_SUBR = 0x4000,
--- 259,265 ----
PVEC_NORMAL_VECTOR = 0,
PVEC_PROCESS = 0x200,
PVEC_FRAME = 0x400,
! PVEC_FUNVEC = 0x800,
PVEC_WINDOW = 0x1000,
PVEC_WINDOW_CONFIGURATION = 0x2000,
PVEC_SUBR = 0x4000,
***************
*** 537,543 ****
#define XSETPROCESS(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_PROCESS))
#define XSETWINDOW(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_WINDOW))
#define XSETSUBR(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_SUBR))
! #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))
--- 537,543 ----
#define XSETPROCESS(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_PROCESS))
#define XSETWINDOW(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_WINDOW))
#define XSETSUBR(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_SUBR))
! #define XSETFUNVEC(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_FUNVEC))
#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))
***************
*** 548,553 ****
--- 548,556 ----
#define ASET(ARRAY, IDX, VAL) (AREF ((ARRAY), (IDX)) = (VAL))
#define ASIZE(ARRAY) XVECTOR ((ARRAY))->size
+ /* 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 SREF(string, index) (XSTRING (string)->data[index] + 0)
***************
*** 1263,1269 ****
typedef unsigned char UCHAR;
#endif
! /* Meanings of slots in a Lisp_Compiled: */
#define COMPILED_ARGLIST 0
#define COMPILED_BYTECODE 1
--- 1266,1272 ----
typedef unsigned char UCHAR;
#endif
! /* Meanings of slots in a byte-compiled function vector: */
#define COMPILED_ARGLIST 0
#define COMPILED_BYTECODE 1
***************
*** 1272,1277 ****
--- 1275,1298 ----
#define COMPILED_DOC_STRING 4
#define COMPILED_INTERACTIVE 5
+ /* 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
***************
*** 1440,1447 ****
#define GC_WINDOWP(x) GC_PSEUDOVECTORP (x, PVEC_WINDOW)
#define SUBRP(x) PSEUDOVECTORP (x, PVEC_SUBR)
#define GC_SUBRP(x) GC_PSEUDOVECTORP (x, PVEC_SUBR)
! #define COMPILEDP(x) PSEUDOVECTORP (x, PVEC_COMPILED)
! #define GC_COMPILEDP(x) GC_PSEUDOVECTORP (x, PVEC_COMPILED)
#define BUFFERP(x) PSEUDOVECTORP (x, PVEC_BUFFER)
#define GC_BUFFERP(x) GC_PSEUDOVECTORP (x, PVEC_BUFFER)
#define CHAR_TABLE_P(x) PSEUDOVECTORP (x, PVEC_CHAR_TABLE)
--- 1461,1468 ----
#define GC_WINDOWP(x) GC_PSEUDOVECTORP (x, PVEC_WINDOW)
#define SUBRP(x) PSEUDOVECTORP (x, PVEC_SUBR)
#define GC_SUBRP(x) GC_PSEUDOVECTORP (x, PVEC_SUBR)
! #define FUNVECP(x) PSEUDOVECTORP (x, PVEC_FUNVEC)
! #define GC_FUNVECP(x) GC_PSEUDOVECTORP (x, PVEC_FUNVEC)
#define BUFFERP(x) PSEUDOVECTORP (x, PVEC_BUFFER)
#define GC_BUFFERP(x) GC_PSEUDOVECTORP (x, PVEC_BUFFER)
#define CHAR_TABLE_P(x) PSEUDOVECTORP (x, PVEC_CHAR_TABLE)
***************
*** 1628,1634 ****
#define FUNCTIONP(OBJ) \
((CONSP (OBJ) && EQ (XCAR (OBJ), Qlambda)) \
|| (SYMBOLP (OBJ) && !NILP (Ffboundp (OBJ))) \
! || COMPILEDP (OBJ) \
|| SUBRP (OBJ))
/* defsubr (Sname);
--- 1649,1655 ----
#define FUNCTIONP(OBJ) \
((CONSP (OBJ) && EQ (XCAR (OBJ), Qlambda)) \
|| (SYMBOLP (OBJ) && !NILP (Ffboundp (OBJ))) \
! || FUNVECP (OBJ) \
|| SUBRP (OBJ))
/* defsubr (Sname);
***************
*** 2451,2456 ****
--- 2472,2478 ----
extern Lisp_Object allocate_misc P_ ((void));
EXFUN (Fmake_vector, 2);
EXFUN (Fvector, MANY);
+ EXFUN (Ffunvec, MANY);
EXFUN (Fmake_symbol, 1);
EXFUN (Fmake_marker, 0);
EXFUN (Fmake_string, 2);
***************
*** 2468,2473 ****
--- 2490,2496 ----
extern Lisp_Object pure_cons P_ ((Lisp_Object, Lisp_Object));
extern Lisp_Object make_pure_vector P_ ((EMACS_INT));
EXFUN (Fgarbage_collect, 0);
+ extern Lisp_Object make_funvec P_ ((Lisp_Object, int, int, Lisp_Object *));
EXFUN (Fmake_byte_code, MANY);
EXFUN (Fmake_bool_vector, 2);
EXFUN (Fmake_char_table, 2);
*** orig/src/lread.c
--- mod/src/lread.c
***************
*** 2021,2034 ****
Qnil));
}
if (c == '[')
! {
! /* 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;
--- 2021,2028 ----
Qnil));
}
if (c == '[')
! /* `function vector' objects, including byte-compiled functions. */
! return read_vector (readcharfun, 1);
if (c == '(')
{
Lisp_Object tmp;
***************
*** 2796,2804 ****
\f
static Lisp_Object
! read_vector (readcharfun, bytecodeflag)
Lisp_Object readcharfun;
! int bytecodeflag;
{
register int i;
register int size;
--- 2790,2798 ----
\f
static Lisp_Object
! read_vector (readcharfun, read_funvec)
Lisp_Object readcharfun;
! int read_funvec;
{
register int i;
register int size;
***************
*** 2806,2811 ****
--- 2800,2810 ----
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);
***************
*** 2816,2826 ****
for (i = 0; i < size; i++)
{
item = Fcar (tem);
/* 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 (bytecodeflag && load_force_doc_strings)
{
if (i == COMPILED_BYTECODE)
{
--- 2815,2833 ----
for (i = 0; i < size; i++)
{
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 (i == COMPILED_BYTECODE)
{
***************
*** 2864,2869 ****
--- 2871,2884 ----
tem = Fcdr (tem);
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;
}
*** orig/src/print.c
--- mod/src/print.c
***************
*** 1303,1309 ****
loop:
if (STRINGP (obj) || CONSP (obj) || VECTORP (obj)
! || COMPILEDP (obj) || CHAR_TABLE_P (obj)
|| (! NILP (Vprint_gensym)
&& SYMBOLP (obj)
&& !SYMBOL_INTERNED_P (obj)))
--- 1303,1309 ----
loop:
if (STRINGP (obj) || CONSP (obj) || VECTORP (obj)
! || FUNVECP (obj) || CHAR_TABLE_P (obj)
|| (! NILP (Vprint_gensym)
&& SYMBOLP (obj)
&& !SYMBOL_INTERNED_P (obj)))
***************
*** 1406,1412 ****
/* Detect circularities and truncate them. */
if (STRINGP (obj) || CONSP (obj) || VECTORP (obj)
! || COMPILEDP (obj) || CHAR_TABLE_P (obj)
|| (! NILP (Vprint_gensym)
&& SYMBOLP (obj)
&& !SYMBOL_INTERNED_P (obj)))
--- 1406,1412 ----
/* Detect circularities and truncate them. */
if (STRINGP (obj) || CONSP (obj) || VECTORP (obj)
! || FUNVECP (obj) || CHAR_TABLE_P (obj)
|| (! NILP (Vprint_gensym)
&& SYMBOLP (obj)
&& !SYMBOL_INTERNED_P (obj)))
***************
*** 1933,1939 ****
else
{
EMACS_INT size = XVECTOR (obj)->size;
! if (COMPILEDP (obj))
{
PRINTCHAR ('#');
size &= PSEUDOVECTOR_SIZE_MASK;
--- 1933,1939 ----
else
{
EMACS_INT size = XVECTOR (obj)->size;
! if (FUNVECP (obj))
{
PRINTCHAR ('#');
size &= PSEUDOVECTOR_SIZE_MASK;
[-- Attachment #3: Type: text/plain, Size: 147 bytes --]
--
Love is a snowmobile racing across the tundra. Suddenly it flips over,
pinning you underneath. At night the ice weasels come. --Nietzsche
[-- Attachment #4: Type: text/plain, Size: 141 bytes --]
_______________________________________________
Emacs-devel mailing list
Emacs-devel@gnu.org
http://mail.gnu.org/mailman/listinfo/emacs-devel
next prev parent reply other threads:[~2004-05-19 22:32 UTC|newest]
Thread overview: 86+ messages / expand[flat|nested] mbox.gz Atom feed top
[not found] <E1BH4Nx-000730-Dq@fencepost.gnu.org>
[not found] ` <85k7036eqr.fsf@junk.nocrew.org>
[not found] ` <E1BI6nw-0005F4-Hl@fencepost.gnu.org>
[not found] ` <85smepfzqo.fsf@junk.nocrew.org>
[not found] ` <E1BIm46-0001Ha-5A@fencepost.gnu.org>
2004-04-28 10:43 ` User-reserved element in byte code vectors (was: Emacs Common Lisp) Lars Brinkhoff
2004-04-28 13:48 ` Stefan Monnier
2004-04-28 15:08 ` User-reserved element in byte code vectors Lars Brinkhoff
2004-04-28 15:38 ` Stefan Monnier
2004-04-28 16:51 ` Lars Brinkhoff
2004-04-28 17:12 ` Stefan Monnier
2004-05-02 7:59 ` Lars Brinkhoff
2004-05-02 9:43 ` Miles Bader
2004-05-02 16:02 ` Lars Brinkhoff
2004-05-03 14:03 ` Richard Stallman
2004-05-03 19:57 ` Miles Bader
2004-05-05 5:23 ` Lars Brinkhoff
2004-05-05 20:21 ` Richard Stallman
2004-05-06 3:55 ` Miles Bader
2004-05-06 4:56 ` Miles Bader
2004-05-06 11:48 ` Richard Stallman
2004-05-14 17:53 ` Miles Bader
2004-05-14 18:27 ` Stefan Monnier
2004-05-14 19:50 ` Lars Brinkhoff
2004-05-14 22:03 ` Miles Bader
2004-05-14 22:14 ` Stefan Monnier
2004-05-15 18:34 ` Richard Stallman
2004-05-15 23:10 ` Miles Bader
2004-05-17 11:04 ` Richard Stallman
2004-05-17 11:28 ` Lars Brinkhoff
2004-05-17 16:30 ` Stefan Monnier
2004-05-17 22:06 ` Miles Bader
2004-05-17 22:33 ` David Kastrup
2004-05-18 1:29 ` Miles Bader
2004-05-18 13:17 ` Stefan Monnier
2004-05-18 23:45 ` Miles Bader
2004-05-19 6:28 ` David Kastrup
2004-05-19 6:37 ` Miles Bader
2004-05-19 19:00 ` Richard Stallman
2004-05-19 22:32 ` Miles Bader [this message]
2004-05-19 7:34 ` Kim F. Storm
2004-05-19 13:45 ` Richard Stallman
2004-05-19 14:28 ` Miles Bader
2004-05-19 15:19 ` Stefan Monnier
2004-05-20 0:31 ` Miles Bader
2004-05-20 13:17 ` Richard Stallman
2004-05-21 1:28 ` Miles Bader
2004-05-22 7:31 ` Richard Stallman
2004-05-22 9:37 ` Miles Bader
2004-05-18 14:53 ` Richard Stallman
2004-05-18 17:34 ` Miles Bader
2004-05-18 14:53 ` Richard Stallman
2004-05-16 23:53 ` Stefan Monnier
[not found] ` <E1BP3ym-0007oy-F7@fencepost.gnu.org>
[not found] ` <20040515231754.GB20052@fencepost>
2004-05-16 4:02 ` Function vectors: +funvec-20030516-0-c.patch Miles Bader
2004-05-16 12:28 ` Function vectors: +funvec-20030516-1-c.patch Miles Bader
2004-05-16 23:58 ` Function vectors: +funvec-20030516-0-c.patch Stefan Monnier
2004-05-17 0:03 ` Miles Bader
2004-05-17 0:14 ` Stefan Monnier
2004-05-17 0:30 ` Miles Bader
2004-05-17 16:09 ` Stefan Monnier
2004-05-17 22:21 ` Miles Bader
2004-05-18 13:30 ` Stefan Monnier
2004-05-17 11:04 ` Richard Stallman
2004-05-17 11:04 ` Richard Stallman
2004-05-17 22:54 ` Miles Bader
2004-05-18 14:54 ` Richard Stallman
2004-05-18 6:04 ` Function vectors: +funvec-20030518-0-c.patch Miles Bader
2004-05-06 6:17 ` User-reserved element in byte code vectors Lars Brinkhoff
2004-05-06 14:24 ` Stefan Monnier
2004-05-06 20:39 ` Miles Bader
2004-05-02 16:37 ` Stefan Monnier
2004-05-02 18:59 ` Lars Brinkhoff
2004-05-02 19:21 ` Stefan Monnier
2004-05-02 19:27 ` Lars Brinkhoff
2004-05-02 19:54 ` Stefan Monnier
2004-05-02 20:28 ` Lars Brinkhoff
2004-05-02 21:07 ` Stefan Monnier
2004-05-03 6:08 ` Lars Brinkhoff
2004-05-02 19:52 ` Richard Stallman
2004-04-28 15:38 ` User-reserved element in byte code vectors (was: Emacs Common Lisp) Miles Bader
2004-05-01 5:30 ` Lars Brinkhoff
2004-05-01 23:58 ` Miles Bader
2004-05-01 7:01 ` get-internal-run-time Lars Brinkhoff
2004-05-01 18:53 ` get-internal-run-time Lars Brinkhoff
2004-05-02 14:44 ` get-internal-run-time Eli Zaretskii
2004-05-02 15:45 ` get-internal-run-time Lars Brinkhoff
2004-05-02 18:41 ` get-internal-run-time Lars Brinkhoff
2004-05-03 0:10 ` get-internal-run-time Kevin Ryde
2004-05-03 5:38 ` get-internal-run-time Lars Brinkhoff
2004-05-03 14:03 ` get-internal-run-time Richard Stallman
2004-10-28 16:30 ` get-internal-run-time Lars Brinkhoff
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://www.gnu.org/software/emacs/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=87d650120n.fsf_-_@tc-1-100.kawasaki.gol.ne.jp \
--to=miles@gnu.org \
--cc=emacs-devel@gnu.org \
--cc=lars@nocrew.org \
--cc=monnier@iro.umontreal.ca \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/emacs.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).