lisp/ChangeLog: 2004-05-14 Miles Bader * subr.el (functionp): Use `funvecp' instead of `byte-compiled-function-p'. src/ChangeLog: 2004-05-16 Miles Bader * lisp.h: Declare make_funvec, Ffunvec, and Fmake_funvec. (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, Fmake_funvec, funvec): New functions. (Fmake_byte_code): Make sure the first element is a list. * eval.c (Qcurry): New variable. (syms_of_eval): Initialize it. (Ffuncall): Handle curried and byte-code funvec objects. (Fcurry, Frcurry): New functions. * 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. 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. 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' or `rcurry' for curried functions. See the node `Funvec Type' + in the Emacs Lisp Reference Manual for more information. + + *** New functions curry and rcurry allow 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 *************** *** 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,140 ---- @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 ! which is callable as a function. @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}. ! ! @item rcurry ! A ``reverse curried function''. This is like a curried function, but ! the arguments following the function in the funvec are appended to ! user arguments rather than prepended. ! @end table ! @end table @defun functionp object *************** *** 1197,1202 **** --- 1222,1282 ---- 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 + when called with string arguments, will in turn call @code{concat} + with @code{"The "} and the string arguments: + + @example + (funcall (curry 'concat "The ") "end") + @result{} "The end" + @end example + + or more usefully, used as a function with @code{mapcar}: + + @example + (mapcar (curry 'concat "The ") '("big" "red" "balloon")) + @result{} ("The big" "The red" "The balloon") + @end example + @end defun + + @defun rcurry function &rest args + Return a function-like object that will prepend any arguments it is + called with to @var{args}, and call @var{function} with the resulting + list of arguments. + + For example: + @example + (mapcar (rcurry 'concat "ability") '("read" "mut" "foo")) + @result{} ("readability" "mutability" "fooability") + @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 *************** *** 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,1274 ---- @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 ! which is callable as a function. Like a normal vector, its elements ! can be examined or set 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 copmiler; 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. ! ! When such a funvec is called, the embedded function is called with an ! argument list composed of the arguments in the funvec followed by the ! arguments the funvec was called with. @xref{Function Currying}. ! ! @item The symbol @code{rcurry} ! A funvec with @code{rcurry} as its first element is a ``reverse ! curried function''. ! ! It is like a normal curried function (see above), but when called, ! the arguments in the funvec are @emph{appended} to the arguments the ! funvec was called with to form the complete arg list. ! @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 make-funvec kind num-params ! @code{make-funvec} returns a new function vector containing @var{kind} ! and @var{num-params} more elements (initialized to @code{nil}). ! @var{kind} should be a address@hidden symbol describing the type of ! funvec. ! ! This function cannot be used to make byte-code functions, even though ! they are a sort of funvec --- to do that, use the ! @code{make-byte-code} function. ! @end defun ! ! @defun funvec kind &rest params ! @code{funvec} returns a new function vector containing @var{kind} and ! @var{params}. @var{kind} should be a address@hidden symbol describing ! the type of funvec. ! ! This function cannot be used to make byte-code functions, even though ! they are a sort of funvec --- to do that, use the ! @code{make-byte-code} function. ! @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}. --- 1683,1689 ---- @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,2709 ---- } + /* make_funvec is a C-only version of Fmake_funvec that uses a more + convenient argument passing convention for being called from other + C-functions. + + It makes a new `function vector' containing KIND as the first + element, and further elements copied from the vector PARAMS of + length NUM_PARAMS (so the total length of the resulting vector is + NUM_PARAMS + 1). + + As a special case, if PARAMS is zero, all parameters are set to nil + instead (NUM_PARAMS is still used in that case to calculate the + length). + + See Fmake_funvec for a description of what a `funvec' is. */ + + Lisp_Object + make_funvec (kind, num_params, params) + Lisp_Object kind; + int num_params; + Lisp_Object *params; + { + Lisp_Object funvec; + + funvec = Fmake_vector (make_number (num_params + 1), Qnil); + + ASET (funvec, 0, kind); + + if (params) + { + int index; + for (index = 0; index < num_params; index++) + ASET (funvec, index + 1, params[index]); + } + + XSETFUNVEC (funvec, XVECTOR (funvec)); + + return funvec; + } + + + DEFUN ("make-funvec", Fmake_funvec, Smake_funvec, 2, 2, 0, + doc: /* Return a new `function vector' containing KIND, and NUM_PARAMS more elements. + A `function vector', a.k.a. `funvec', is a funcallable vector in Emacs Lisp. + KIND should be a non-nil symbol describing the type of funvec. + The resulting vector-like object will have KIND as the first element, and + NUM_PARAMS further elements initialized to nil. + See the function `funvec' for more detail. */) + (kind, num_params) + register Lisp_Object kind, num_params; + { + Lisp_Object funvec; + + CHECK_NATNUM (num_params); + + if (NILP (kind) || !SYMBOLP (kind)) + error ("Invalid funvec kind"); + + return make_funvec (kind, num_params, 0); + } + + 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 **** --- 2768,2800 ---- } + 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 should be a non-nil symbol specifying the kind of funvec. + + The meaning of the remaining arguments depends on KIND; + currently implemented values of KIND are: + `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. + `rcurry' -- A `reverse curried function'; like `curry', but the + arguments following the function in the vector are + appended to user arguments rather than prepended; + see the `curry' function. + + The `funvec' function cannot be used to construct a byte-code object (even + though they are actually a type of funvec); to do that, use `make-byte-code'. + + usage: (funvec KIND &rest OBJECTS) */) + (nargs, args) + register int nargs; + Lisp_Object *args; + { + return make_funvec (args[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 **** --- 2810,2819 ---- 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; } --- 2835,2841 ---- 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; --- 4320,4326 ---- 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; --- 4332,4339 ---- 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. */ --- 4891,4897 ---- } 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,5766 **** --- 5850,5860 ---- defsubr (&Scons); defsubr (&Slist); defsubr (&Svector); + defsubr (&Sfunvec); defsubr (&Smake_byte_code); defsubr (&Smake_list); defsubr (&Smake_vector); + defsubr (&Smake_funvec); defsubr (&Smake_char_table); defsubr (&Smake_string); defsubr (&Smake_bool_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, Qrcurry; /* This holds either the symbol `run-hooks' or nil. It is nil at an early stage of startup, and when Emacs *************** *** 2770,2777 **** abort (); } } ! if (COMPILEDP (fun)) ! val = funcall_lambda (fun, numargs, args + 1); else { if (!CONSP (fun)) --- 2771,2835 ---- abort (); } } ! ! if (FUNVECP (fun)) ! { ! /* A `function vector' object holds various types of funcallable ! vectors. */ ! Lisp_Object tag; ! int size = FUNVEC_SIZE (fun); ! ! if (size > 0) ! tag = AREF (fun, 0); ! else ! tag = Qnil; ! ! if (FUNVEC_COMPILED_TAG_P (tag)) ! /* Byte-compiled function. */ ! val = funcall_lambda (fun, numargs, args + 1); ! else if (EQ (tag, Qcurry) || EQ (tag, Qrcurry)) ! { ! /* A curried function is a way to attach arguments to a another ! function. The first element of the vector is the identifier ! `curry' or `rcurry', the second is the wrapped function, and ! remaining elements are the attached arguments. */ ! int num_curried_args = size - 2; ! /* The curried function and arguments. */ ! Lisp_Object *curried_fun_args = XVECTOR (fun)->contents + 1; ! /* Offset of the curried and user args in the final arglist. */ ! int curried_args_offs, user_args_offs; ! ! internal_args = (Lisp_Object *) alloca ((num_curried_args + nargs) ! * sizeof (Lisp_Object)); ! ! if (EQ (tag, Qcurry)) ! { ! /* For a standard curry, curried args are first in the new ! arg vector, after the function. User args follow. */ ! curried_args_offs = 1; ! user_args_offs = curried_args_offs + num_curried_args; ! } ! else ! { ! /* For a `reverse curry', the order is reversed. */ ! user_args_offs = 1; ! curried_args_offs = user_args_offs + (nargs - 1); ! } ! ! /* First comes the real function. */ ! internal_args[0] = curried_fun_args[0]; ! ! /* Then the arguments in the appropriate order. */ ! bcopy (curried_fun_args + 1, internal_args + curried_args_offs, ! num_curried_args * sizeof (Lisp_Object)); ! bcopy (args + 1, internal_args + user_args_offs, ! (nargs - 1) * sizeof (Lisp_Object)); ! ! val = Ffuncall (num_curried_args + nargs, internal_args); ! } ! else ! return Fsignal (Qinvalid_function, Fcons (fun, Qnil)); ! } else { if (!CONSP (fun)) *************** *** 3123,3128 **** --- 3181,3228 ---- 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. + Also see `rcurry'. + + 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, nargs, args); + } + + DEFUN ("rcurry", Frcurry, Srcurry, 1, MANY, 0, + doc: /* Return FUN reverse-curried with ARGS. + The result is a function-like object that will prepend any arguments it + is called with to ARGS, and call FUN with the resulting list of arguments. + Also see `curry'. + + For instance: + (funcall (rcurry '+ 3 4 5) 2) is the same as (funcall '+ 2 3 4 5) + and: + (mapcar (rcurry 'concat " etc") '("a" "b" "c")) + => ("a etc" "b etc" "c etc") + + usage: (rcurry FUN &rest ARGS) */) + (nargs, args) + register int nargs; + Lisp_Object *args; + { + return make_funvec (Qrcurry, 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 **** --- 3413,3423 ---- Qand_optional = intern ("&optional"); staticpro (&Qand_optional); + Qcurry = intern ("curry"); + staticpro (&Qcurry); + Qrcurry = intern ("rcurry"); + staticpro (&Qrcurry); + 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 **** --- 3535,3542 ---- defsubr (&Srun_hook_with_args_until_success); defsubr (&Srun_hook_with_args_until_failure); defsubr (&Sfetch_bytecode); + defsubr (&Scurry); + defsubr (&Srcurry); 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, *************** *** 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 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,2497 ---- 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, Lisp_Object *)); + EXFUN (Fmake_funvec, 2); 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;