Function vectors: +funvec-20030518-0-c.patch

[Miles Bader <miles@gnu.org>]

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  <miles@gnu.org>

	* subr.el (functionp): Use `funvecp' instead of
	`byte-compiled-function-p'.

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-16  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.

	* 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;
  }
  \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, 1, 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 ****
--- 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 <rms@gnu.ai.mit.edu> 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 ****
  
  \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;