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

[Miles Bader <miles@gnu.org>]

[-- Attachment #1: Type: text/plain, Size: 292 bytes --]

Here's a new version of the function-vector / currying patch with
following changes:

  (1) Lisp Reference Manual and NEWS entries added

  (2) `rcurry' (reverse-currying) function added

  (3) make_funvec internal function added, which makes all the callers
      simpler

  etc.


Patch:



[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: +funvec-20030516-0-c.patch --]
[-- Type: text/x-patch, Size: 46407 bytes --]

lisp/ChangeLog:
2004-05-14  Miles Bader  <miles@gnu.org>

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

src/ChangeLog:
2004-05-16  Miles Bader  <miles@gnu.org>

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

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 non-@code{nil} 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 non-@code{nil} 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;
  }
  \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.
+ 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);
+ }
+ \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 ****
--- 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 <rms@gnu.ai.mit.edu> thinks that MULE
     (MUlti-Lingual Emacs) might need 22 bits for the character value
***************
*** 1440,1447 ****
  #define GC_WINDOWP(x) GC_PSEUDOVECTORP (x, PVEC_WINDOW)
  #define SUBRP(x) PSEUDOVECTORP (x, PVEC_SUBR)
  #define GC_SUBRP(x) GC_PSEUDOVECTORP (x, PVEC_SUBR)
! #define COMPILEDP(x) PSEUDOVECTORP (x, PVEC_COMPILED)
! #define GC_COMPILEDP(x) GC_PSEUDOVECTORP (x, PVEC_COMPILED)
  #define BUFFERP(x) PSEUDOVECTORP (x, PVEC_BUFFER)
  #define GC_BUFFERP(x) GC_PSEUDOVECTORP (x, PVEC_BUFFER)
  #define CHAR_TABLE_P(x) PSEUDOVECTORP (x, PVEC_CHAR_TABLE)
--- 1461,1468 ----
  #define GC_WINDOWP(x) GC_PSEUDOVECTORP (x, PVEC_WINDOW)
  #define SUBRP(x) PSEUDOVECTORP (x, PVEC_SUBR)
  #define GC_SUBRP(x) GC_PSEUDOVECTORP (x, PVEC_SUBR)
! #define FUNVECP(x) PSEUDOVECTORP (x, PVEC_FUNVEC)
! #define GC_FUNVECP(x) GC_PSEUDOVECTORP (x, PVEC_FUNVEC)
  #define BUFFERP(x) PSEUDOVECTORP (x, PVEC_BUFFER)
  #define GC_BUFFERP(x) GC_PSEUDOVECTORP (x, PVEC_BUFFER)
  #define CHAR_TABLE_P(x) PSEUDOVECTORP (x, PVEC_CHAR_TABLE)
***************
*** 1628,1634 ****
  #define FUNCTIONP(OBJ)					\
       ((CONSP (OBJ) && EQ (XCAR (OBJ), Qlambda))		\
        || (SYMBOLP (OBJ) && !NILP (Ffboundp (OBJ)))	\
!       || COMPILEDP (OBJ)				\
        || SUBRP (OBJ))
  
  /* defsubr (Sname);
--- 1649,1655 ----
  #define FUNCTIONP(OBJ)					\
       ((CONSP (OBJ) && EQ (XCAR (OBJ), Qlambda))		\
        || (SYMBOLP (OBJ) && !NILP (Ffboundp (OBJ)))	\
!       || FUNVECP (OBJ)					\
        || SUBRP (OBJ))
  
  /* defsubr (Sname);
***************
*** 2451,2456 ****
--- 2472,2478 ----
  extern Lisp_Object allocate_misc P_ ((void));
  EXFUN (Fmake_vector, 2);
  EXFUN (Fvector, MANY);
+ EXFUN (Ffunvec, MANY);
  EXFUN (Fmake_symbol, 1);
  EXFUN (Fmake_marker, 0);
  EXFUN (Fmake_string, 2);
***************
*** 2468,2473 ****
--- 2490,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 ****
  
  \f
  static Lisp_Object
! read_vector (readcharfun, bytecodeflag)
       Lisp_Object readcharfun;
!      int bytecodeflag;
  {
    register int i;
    register int size;
--- 2790,2798 ----
  
  \f
  static Lisp_Object
! read_vector (readcharfun, read_funvec)
       Lisp_Object readcharfun;
!      int read_funvec;
  {
    register int i;
    register int size;
***************
*** 2806,2811 ****
--- 2800,2810 ----
    register Lisp_Object tem, item, vector;
    register struct Lisp_Cons *otem;
    Lisp_Object len;
+   /* If we're reading a funvec object we start out assuming it's also a
+      byte-code object (a subset of funvecs), so we can do any special
+      processing needed.  If it's just an ordinary funvec object, we'll
+      realize that as soon as we've read the first element.  */
+   int read_bytecode = read_funvec;
  
    tem = read_list (1, readcharfun);
    len = Flength (tem);
***************
*** 2816,2826 ****
    for (i = 0; i < size; i++)
      {
        item = Fcar (tem);
        /* If `load-force-doc-strings' is t when reading a lazily-loaded
  	 bytecode object, the docstring containing the bytecode and
  	 constants values must be treated as unibyte and passed to
  	 Fread, to get the actual bytecode string and constants vector.  */
!       if (bytecodeflag && load_force_doc_strings)
  	{
  	  if (i == COMPILED_BYTECODE)
  	    {
--- 2815,2833 ----
    for (i = 0; i < size; i++)
      {
        item = Fcar (tem);
+ 
+       /* If READ_BYTECODE is set, check whether this is really a byte-code
+ 	 object, or just an ordinary `funvec' object -- non-byte-code
+ 	 funvec objects use the same reader syntax.  We can tell from the
+ 	 first element which one it is.  */
+       if (read_bytecode && i == 0 && ! FUNVEC_COMPILED_TAG_P (item))
+ 	read_bytecode = 0;	/* Nope. */
+ 
        /* If `load-force-doc-strings' is t when reading a lazily-loaded
  	 bytecode object, the docstring containing the bytecode and
  	 constants values must be treated as unibyte and passed to
  	 Fread, to get the actual bytecode string and constants vector.  */
!       if (read_bytecode && load_force_doc_strings)
  	{
  	  if (i == COMPILED_BYTECODE)
  	    {
***************
*** 2864,2869 ****
--- 2871,2884 ----
        tem = Fcdr (tem);
        free_cons (otem);
      }
+ 
+   if (read_bytecode && size >= 4)
+     /* Convert this vector to a bytecode object.  */
+     vector = Fmake_byte_code (size, XVECTOR (vector)->contents);
+   else if (read_funvec && size >= 1)
+     /* Convert this vector to an ordinary funvec object.  */
+     XSETFUNVEC (vector, XVECTOR (vector));
+ 
    return vector;
  }
  


*** orig/src/print.c
--- mod/src/print.c
***************
*** 1303,1309 ****
  
   loop:
    if (STRINGP (obj) || CONSP (obj) || VECTORP (obj)
!       || COMPILEDP (obj) || CHAR_TABLE_P (obj)
        || (! NILP (Vprint_gensym)
  	  && SYMBOLP (obj)
  	  && !SYMBOL_INTERNED_P (obj)))
--- 1303,1309 ----
  
   loop:
    if (STRINGP (obj) || CONSP (obj) || VECTORP (obj)
!       || FUNVECP (obj) || CHAR_TABLE_P (obj)
        || (! NILP (Vprint_gensym)
  	  && SYMBOLP (obj)
  	  && !SYMBOL_INTERNED_P (obj)))
***************
*** 1406,1412 ****
  
    /* Detect circularities and truncate them.  */
    if (STRINGP (obj) || CONSP (obj) || VECTORP (obj)
!       || COMPILEDP (obj) || CHAR_TABLE_P (obj)
        || (! NILP (Vprint_gensym)
  	  && SYMBOLP (obj)
  	  && !SYMBOL_INTERNED_P (obj)))
--- 1406,1412 ----
  
    /* Detect circularities and truncate them.  */
    if (STRINGP (obj) || CONSP (obj) || VECTORP (obj)
!       || FUNVECP (obj) || CHAR_TABLE_P (obj)
        || (! NILP (Vprint_gensym)
  	  && SYMBOLP (obj)
  	  && !SYMBOL_INTERNED_P (obj)))
***************
*** 1933,1939 ****
        else
  	{
  	  EMACS_INT size = XVECTOR (obj)->size;
! 	  if (COMPILEDP (obj))
  	    {
  	      PRINTCHAR ('#');
  	      size &= PSEUDOVECTOR_SIZE_MASK;
--- 1933,1939 ----
        else
  	{
  	  EMACS_INT size = XVECTOR (obj)->size;
! 	  if (FUNVECP (obj))
  	    {
  	      PRINTCHAR ('#');
  	      size &= PSEUDOVECTOR_SIZE_MASK;




[-- Attachment #3: Type: text/plain, Size: 208 bytes --]



-Miles
-- 
`Cars give people wonderful freedom and increase their opportunities.
 But they also destroy the environment, to an extent so drastic that
 they kill all social life' (from _A Pattern Language_)

[-- Attachment #4: Type: text/plain, Size: 141 bytes --]

_______________________________________________
Emacs-devel mailing list
Emacs-devel@gnu.org
http://mail.gnu.org/mailman/listinfo/emacs-devel