From mboxrd@z Thu Jan 1 00:00:00 1970 Path: main.gmane.org!not-for-mail From: Miles Bader Newsgroups: gmane.emacs.devel Subject: Function vectors: +funvec-20030518-0-c.patch Date: Tue, 18 May 2004 02:04:49 -0400 Sender: emacs-devel-bounces+emacs-devel=quimby.gnus.org@gnu.org Message-ID: <20040518060449.GA1298@fencepost> References: <85ekpz5twj.fsf@junk.nocrew.org> <874qqiao9o.fsf@tc-1-100.kawasaki.gol.ne.jp> <20040515231754.GB20052@fencepost> <87r7tlggue.fsf_-_@tc-1-100.kawasaki.gol.ne.jp> NNTP-Posting-Host: deer.gmane.org Mime-Version: 1.0 Content-Type: text/plain; charset=us-ascii X-Trace: sea.gmane.org 1084860426 5529 80.91.224.253 (18 May 2004 06:07:06 GMT) X-Complaints-To: usenet@sea.gmane.org NNTP-Posting-Date: Tue, 18 May 2004 06:07:06 +0000 (UTC) Cc: emacs-devel@gnu.org, Miles Bader Original-X-From: emacs-devel-bounces+emacs-devel=quimby.gnus.org@gnu.org Tue May 18 08:06:56 2004 Return-path: Original-Received: from quimby.gnus.org ([80.91.224.244]) by deer.gmane.org with esmtp (Exim 3.35 #1 (Debian)) id 1BPxke-0003fL-00 for ; Tue, 18 May 2004 08:06:56 +0200 Original-Received: from monty-python.gnu.org ([199.232.76.173]) by quimby.gnus.org with esmtp (Exim 3.35 #1 (Debian)) id 1BPxkd-00010i-00 for ; Tue, 18 May 2004 08:06:55 +0200 Original-Received: from localhost ([127.0.0.1] helo=monty-python.gnu.org) by monty-python.gnu.org with esmtp (Exim 4.34) id 1BPxk6-0005Di-26 for emacs-devel@quimby.gnus.org; Tue, 18 May 2004 02:06:22 -0400 Original-Received: from list by monty-python.gnu.org with tmda-scanned (Exim 4.34) id 1BPxjF-0005DY-66 for emacs-devel@gnu.org; Tue, 18 May 2004 02:05:29 -0400 Original-Received: from mail by monty-python.gnu.org with spam-scanned (Exim 4.34) id 1BPxii-00050Q-4e for emacs-devel@gnu.org; Tue, 18 May 2004 02:05:28 -0400 Original-Received: from [199.232.76.164] (helo=fencepost.gnu.org) by monty-python.gnu.org with esmtp (Exim 4.34) id 1BPxih-00050N-Ly for emacs-devel@gnu.org; Tue, 18 May 2004 02:04:55 -0400 Original-Received: from miles by fencepost.gnu.org with local (Exim 4.34) id 1BPxib-0000fv-D8; Tue, 18 May 2004 02:04:49 -0400 Original-To: Richard Stallman Content-Disposition: inline In-Reply-To: User-Agent: Mutt/1.3.28i Blat: Foop X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.1.4 Precedence: list List-Id: "Emacs development discussions." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: emacs-devel-bounces+emacs-devel=quimby.gnus.org@gnu.org Xref: main.gmane.org gmane.emacs.devel:23613 X-Report-Spam: http://spam.gmane.org/gmane.emacs.devel:23613 This is a new patch. Changes: (1) Remove `rcurry' functionality and function. (2) Remove Fmake_funvec (3) Add reserved slot to curry funvecs, currently always nil. (3) Comment / doc fixes, as suggested. lisp/ChangeLog: 2004-05-14 Miles Bader * subr.el (functionp): Use `funvecp' instead of `byte-compiled-function-p'. lispref/ChangeLog: 2004-05-16 Miles Bader * 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-16 Miles Bader * 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. * 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/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 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,3505 ---- ** 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 functions curry allows constructing `curried functions' + (see the node `Function Currying' in the Emacs Lisp Reference Manual). + + *** New functions funvecp, make-funvec, and funvec allow primitive access + to funvecs + ** New packages: *** The new package gdb-ui.el provides an enhanced graphical interface to *** 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,133 ---- @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 @defun functionp object *************** *** 1197,1202 **** --- 1215,1263 ---- 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,2768 ---- } + DEFUN ("funvec", Ffunvec, Sfunvec, 1, MANY, 0, + doc: /* Return a newly created `function vector' of kind 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 reserved slot + (currently always nil), 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 **** --- 2778,2787 ---- 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; } --- 2803,2809 ---- 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; --- 4288,4294 ---- 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; --- 4300,4307 ---- 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. */ --- 4859,4865 ---- } 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 **** --- 5818,5824 ---- 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/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,2901 ---- 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 a reserved slot, currently always nil, the + third is the wrapped function, and remaining elements are the + attached arguments. */ + int num_curried_args = size - 3; + /* 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 + 2; + /* 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 **** --- 2910,2920 ---- 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 **** --- 3182,3208 ---- return value; } + + 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, 1, nargs, args); + } + + DEFUN ("backtrace-debug", Fbacktrace_debug, Sbacktrace_debug, 2, 2, 0, doc: /* Set the debug-on-exit flag of eval frame LEVEL levels down to FLAG. The debugger is entered when that frame exits, if the flag is non-nil. */) *************** *** 3313,3318 **** --- 3393,3401 ---- 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 **** --- 3513,3519 ---- 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); } *************** *** 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; } *** 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, *************** *** 535,541 **** #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)) --- 535,541 ---- #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)) *************** *** 546,551 **** --- 546,554 ---- #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) *************** *** 1261,1267 **** typedef unsigned char UCHAR; #endif ! /* Meanings of slots in a Lisp_Compiled: */ #define COMPILED_ARGLIST 0 #define COMPILED_BYTECODE 1 --- 1264,1270 ---- typedef unsigned char UCHAR; #endif ! /* Meanings of slots in a byte-compiled function vector: */ #define COMPILED_ARGLIST 0 #define COMPILED_BYTECODE 1 *************** *** 1270,1275 **** --- 1273,1296 ---- #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 thinks that MULE (MUlti-Lingual Emacs) might need 22 bits for the character value *************** *** 1438,1445 **** #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) --- 1459,1466 ---- #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) *************** *** 1626,1632 **** #define FUNCTIONP(OBJ) \ ((CONSP (OBJ) && EQ (XCAR (OBJ), Qlambda)) \ || (SYMBOLP (OBJ) && !NILP (Ffboundp (OBJ))) \ ! || COMPILEDP (OBJ) \ || SUBRP (OBJ)) /* defsubr (Sname); --- 1647,1653 ---- #define FUNCTIONP(OBJ) \ ((CONSP (OBJ) && EQ (XCAR (OBJ), Qlambda)) \ || (SYMBOLP (OBJ) && !NILP (Ffboundp (OBJ))) \ ! || FUNVECP (OBJ) \ || SUBRP (OBJ)) /* defsubr (Sname); *************** *** 2449,2454 **** --- 2470,2476 ---- 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); *************** *** 2466,2471 **** --- 2488,2494 ---- 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 **** static Lisp_Object ! read_vector (readcharfun, bytecodeflag) Lisp_Object readcharfun; ! int bytecodeflag; { register int i; register int size; --- 2790,2798 ---- 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;