User-reserved element in byte code vectors (was: Emacs Common Lisp)

User-reserved element in byte code vectors (was: Emacs Common Lisp)

[Lars Brinkhoff]

[Cc to emacs-devel.  Context: It can be useful to store user-defined
objects in a byte code vector.]

Richard Stallman <rms@gnu.org> writes:
>     The make-byte-code function takes any number of arguments, so it
>     already works.  The problem is that there's no guarantee that future
>     versions of Emacs won't start to use more than the first six elements.
> Now I see the issue.  We could decide to leave the 7th element
> unused, and document that.

Yes, that would be good enough for my purposes.  Obviously, when more
than one object needs to be stored, I can just put them in a list or a
vector and put that in element 7.

In my case, I frequently do want to store more than one object, so it
would be more efficient if there were more than one element available
in the code vector.  However, other than extending the above solution
to something ugly like "decide to leave the 7th, 8th, and 9th element
unused", I don't see a good way to do that.

Or maybe... How about defining a variable like this:

  (defvar byte-code-user-elements 6
    "The lowest index of elements in a byte-code object which a user may use.
     Elements below this index are used by Emacs.  Elements including and
     above this index may be used freely by a user (e.g. by calling
     make-byte-code); Emacs won't use them for any purpose.")

Then future versions of Emacs could raise this limit as needed.

-- 
Lars Brinkhoff,         Services for Unix, Linux, GCC, HTTP
Brinkhoff Consulting    http://www.brinkhoff.se/

Re: User-reserved element in byte code vectors (was: Emacs Common Lisp)

[Stefan Monnier]

> [Cc to emacs-devel.  Context: It can be useful to store user-defined
> objects in a byte code vector.]

I can't think of why that would be useful.  Could you give us some examples?


        Stefan

Re: User-reserved element in byte code vectors

[Lars Brinkhoff]

Stefan Monnier <monnier@iro.umontreal.ca> writes:
> > It can be useful to store user-defined objects in a byte code
> > vector.
> I can't think of why that would be useful.  Could you give us some
> examples?

It can be useful when compiling languages other than Emacs Lisp to
byte code.  In my case, I'm writing a Common Lisp compiler, and it
would be nice to store in the byte code vector things like a closure
environment, a function name, the original lambda expression, and
other meta data that Common Lisp can associate with a function object.

-- 
Lars Brinkhoff,         Services for Unix, Linux, GCC, HTTP
Brinkhoff Consulting    http://www.brinkhoff.se/

Re: User-reserved element in byte code vectors

[Stefan Monnier]

> It can be useful when compiling languages other than Emacs Lisp to
> byte code.  In my case, I'm writing a Common Lisp compiler, and it
> would be nice to store in the byte code vector things like a closure
> environment, a function name, the original lambda expression, and
> other meta data that Common Lisp can associate with a function object.

I'm beginning to better understand, thank you.

>From your examples, I get the impression that other than the closure's
environment you only need meta-data which can just as well be put in an
alist, so you just need 2 extra slots: one for the closure and one for the
extra slot.  Is that right?


        Stefan


PS: I'd argue that the closure's enviornment should be put as the first
element in the constants-vector rather than in a separate slot in the byte
code object: it makes closure construction slower and more clostly, but it
makes the function call faster (it's just a normal function call and you can
access the closure's vars directly from the byte code without explicitly
passing them as an extra argument).

Re: User-reserved element in byte code vectors (was: Emacs Common Lisp)

[Miles Bader]

On Wed, Apr 28, 2004 at 12:43:23PM +0200, Lars Brinkhoff wrote:
> >     The make-byte-code function takes any number of arguments, so it
> >     already works.  The problem is that there's no guarantee that future
> >     versions of Emacs won't start to use more than the first six elements.
> >
> > Now I see the issue.  We could decide to leave the 7th element
> > unused, and document that.
> 
> Yes, that would be good enough for my purposes.  Obviously, when more
> than one object needs to be stored, I can just put them in a list or a
> vector and put that in element 7.

Indeed, my lexical binding extension already uses element 7...

What do you need to store in the byte-vector?

-Miles
-- 
Yo mama's so fat when she gets on an elevator it HAS to go down.

Re: User-reserved element in byte code vectors

[Lars Brinkhoff]

Stefan Monnier <monnier@iro.umontreal.ca> writes:
> From your examples, I get the impression that other than the
> closure's environment you only need meta-data which can just as well
> be put in an alist, so you just need 2 extra slots: one for the
> closure and one for the extra slot.  Is that right?

So far, that would be quite fine by me, yes.  However, I still haven't
implemented all aspects of Common Lisp, e.g. funcallable instances and
generic functions, so I don't yet know if there would be more data I
would like to be in the byte code vector.

> I'd argue that the closure's enviornment should be put as the first
> element in the constants-vector rather than in a separate slot in
> the byte code object: it makes closure construction slower and more
> clostly, but it makes the function call faster (it's just a normal
> function call and you can access the closure's vars directly from
> the byte code without explicitly passing them as an extra argument).

Yes, that would be nice.  What I do right now is actually conceptually
like

        (defun make-closure (fn env)
          (byte-compile
            `(lambda (&rest args)
               (let ((env ,env))
                 (apply ,fn args)))))
             
(but more optimized) which makes the environment end up in the
constants vector.

I guess it would be best if closures were implemented the same way,
regardless of whether they are compiled from Emacs Lisp or Common
Lisp.  So whatever Miles Bader's lexical stuff ends up doing, I'd
like to be able to do the same.

So, in summary:
(aref 0-5: as before)
 aref 6: closure environment (or as the first constant)
 aref 7: meta data, as an alist (or plist?)
 aref 8 and above: reserved for emacs?  any slots for wacky users?

I guess a very extensible scheme would be to create a new function
allocate-byte-code-element which returnes an index to a byte code
vector element which can be used for any purpose the caller likes, but
then, is the complexity (though small) worth it?

  (defvar byte-code-vector-index-free 6)  ;; or 7 for Miles B
  (defun allocate-byte-code-element ()
    (prog1 byte-code-vector-index-free
      (setq byte-code-vector-index-free (1+ byte-code-vector-index-free))))

-- 
Lars Brinkhoff,         Services for Unix, Linux, GCC, HTTP
Brinkhoff Consulting    http://www.brinkhoff.se/

Re: User-reserved element in byte code vectors

[Stefan Monnier]

>> I'd argue that the closure's enviornment should be put as the first
>> element in the constants-vector rather than in a separate slot in
>> the byte code object: it makes closure construction slower and more
>> clostly, but it makes the function call faster (it's just a normal
>> function call and you can access the closure's vars directly from
>> the byte code without explicitly passing them as an extra argument).

> Yes, that would be nice.  What I do right now is actually conceptually
> like

>         (defun make-closure (fn env)
>           (byte-compile
>             `(lambda (&rest args)
>                (let ((env ,env))
>                  (apply ,fn args)))))
             
> (but more optimized) which makes the environment end up in the
> constants vector.

Right, but in the constants-vector if the wrapper function used for the
closure, whereas I was thinking of removing the indirection and do
something more like

   (defun make-closure (env args bytes csts &rest rest)
     (apply 'make-byte-code args bytes (vconcat (vector env) csts) rest))

> I guess a very extensible scheme would be to create a new function
> allocate-byte-code-element which returnes an index to a byte code
> vector element which can be used for any purpose the caller likes, but
> then, is the complexity (though small) worth it?

I think it's way overkill.


        Stefan

Re: User-reserved element in byte code vectors (was: Emacs Common Lisp)

[Lars Brinkhoff]

Miles Bader <miles@gnu.org> writes:
> Indeed, my lexical binding extension already uses element 7...

Is there any documentation describing your extension?  Does any of
these describe the current situation?
  http://mail.gnu.org/archive/html/emacs-devel/2001-10/msg00085.html
  http://mail.gnu.org/archive/html/emacs-devel/2001-10/txt00003.txt

I checked out the lexbind branch from CVS.  Is that the right one?

-- 
Lars Brinkhoff,         Services for Unix, Linux, GCC, HTTP
Brinkhoff Consulting    http://www.brinkhoff.se/

get-internal-run-time

[Lars Brinkhoff]

Richard Stallman <rms@gnu.org> writes:
> [Lars Brinkhoff wrote:]
>     [I wish there were a] function that returns the amount of
>     processor time used [by Emacs], for implementing [the Common
>     Lisp function] get-internal-run-time.
> 
>     ANSI CL says:
> 	    The intent is that the difference between the values of
> 	    two calls to this function be the amount of time between
> 	    the two calls during which computational effort was
> 	    expended on behalf of the executing program.
>     I haven't found a suitable function for this in Emacs.
> 
> Would you like to contribute such a function?

Here's a first attempt, submitted for comment.


2004-05-01  Lars Brinkhoff  <lars@nocrew.org>

	* editfns.c (Fget_internal_run_time): New function.
	(syms_of_data): Defsubr it.

Index: editfns.c
===================================================================
RCS file: /cvsroot/emacs/emacs/src/editfns.c,v
retrieving revision 1.372
diff -c -r1.372 editfns.c
*** editfns.c	27 Apr 2004 13:28:38 -0000	1.372
--- editfns.c	1 May 2004 06:57:46 -0000
***************
*** 39,44 ****
--- 39,48 ----
  #include <stdio.h>
  #endif
  
+ #ifdef HAVE_SYS_RESOURCE_H
+ #include <sys/resource.h>
+ #endif
+ 
  #include <ctype.h>
  
  #include "lisp.h"
***************
*** 1375,1380 ****
--- 1379,1425 ----
  
    return Flist (3, result);
  }
+ 
+ DEFUN ("get-internal-run-time", Fget_internal_run_time, Sget_internal_run_time,
+        0, 0, 0,
+        doc: /* Return the current run time used by Emacs.
+ The time is returned as a list of three integers.  The first has the
+ most significant 16 bits of the seconds, while the second has the
+ least significant 16 bits.  The third integer gives the microsecond
+ count.
+ 
+ On systems that can't determine the run time, get-internal-run-time
+ does the same thing as current-time.  The microsecond count is zero on
+ systems that do not provide resolution finer than a second.  */)
+      ()
+ {
+ #ifdef HAVE_SYS_RESOURCE_H
+   struct rusage usage;
+   Lisp_Object result[3];
+   int secs, usecs;
+ 
+   if (getrusage (RUSAGE_SELF, &usage) < 0)
+     /* This shouldn't happen.  What action is appropriate?  */
+     Fsignal (Qerror, Qnil);
+ 
+   /* Sum up user time and system time.  */
+   secs = usage.ru_utime.tv_sec + usage.ru_stime.tv_sec;
+   usecs = usage.ru_utime.tv_usec + usage.ru_stime.tv_usec;
+   if (usecs >= 1000000)
+     {
+       usecs -= 1000000;
+       secs++;
+     }
+ 
+   XSETINT (result[0], (secs >> 16) & 0xffff);
+   XSETINT (result[1], (secs >> 0)  & 0xffff);
+   XSETINT (result[2], usecs);
+ 
+   return Flist (3, result);
+ #else
+   return Fcurrent_time ();
+ #endif
+ }
  \f
  
  int
***************
*** 4280,4285 ****
--- 4325,4331 ----
    defsubr (&Suser_full_name);
    defsubr (&Semacs_pid);
    defsubr (&Scurrent_time);
+   defsubr (&Sget_internal_run_time);
    defsubr (&Sformat_time_string);
    defsubr (&Sfloat_time);
    defsubr (&Sdecode_time);

Re: get-internal-run-time

[Lars Brinkhoff]

Lars Brinkhoff <lars@nocrew.org> writes:
> Richard Stallman <rms@gnu.org> writes:
> > [Lars Brinkhoff wrote:]
> >     [I wish there were a] function that returns the amount of
> >     processor time used [by Emacs], for implementing [the Common
> >     Lisp function] get-internal-run-time.
> > 
> >     ANSI CL says:
> > 	    The intent is that the difference between the values of
> > 	    two calls to this function be the amount of time between
> > 	    the two calls during which computational effort was
> > 	    expended on behalf of the executing program.
> >     I haven't found a suitable function for this in Emacs.
> > 
> > Would you like to contribute such a function?
> 
> Here's a first attempt, submitted for comment.

Here's a more complete patch:

etc/NEWS:
** The new primitive `get-internal-run-time' returns the processor
run time used by Emacs so far.

src/ChangeLog:
2004-05-01  Lars Brinkhoff  <lars@nocrew.org>

	* editfns.c (Fget_internal_run_time): New function.
	(syms_of_data): Defsubr it.

lispref/ChangeLog:
2004-05-01  Lars Brinkhoff  <lars@nocrew.org>

	* os.texi (Processor Run Time): New section documenting
	get-internal-run-time.

Index: src/editfns.c
===================================================================
RCS file: /cvsroot/emacs/emacs/src/editfns.c,v
retrieving revision 1.372
diff -c -r1.372 editfns.c
*** src/editfns.c	27 Apr 2004 13:28:38 -0000	1.372
--- src/editfns.c	1 May 2004 07:26:07 -0000
***************
*** 39,44 ****
--- 39,48 ----
  #include <stdio.h>
  #endif
  
+ #ifdef HAVE_SYS_RESOURCE_H
+ #include <sys/resource.h>
+ #endif
+ 
  #include <ctype.h>
  
  #include "lisp.h"
***************
*** 1375,1380 ****
--- 1379,1425 ----
  
    return Flist (3, result);
  }
+ 
+ DEFUN ("get-internal-run-time", Fget_internal_run_time, Sget_internal_run_time,
+        0, 0, 0,
+        doc: /* Return the current run time used by Emacs.
+ The time is returned as a list of three integers.  The first has the
+ most significant 16 bits of the seconds, while the second has the
+ least significant 16 bits.  The third integer gives the microsecond
+ count.
+ 
+ On systems that can't determine the run time, get-internal-run-time
+ does the same thing as current-time.  The microsecond count is zero on
+ systems that do not provide resolution finer than a second.  */)
+      ()
+ {
+ #ifdef HAVE_SYS_RESOURCE_H
+   struct rusage usage;
+   Lisp_Object result[3];
+   int secs, usecs;
+ 
+   if (getrusage (RUSAGE_SELF, &usage) < 0)
+     /* This shouldn't happen.  What action is appropriate?  */
+     Fsignal (Qerror, Qnil);
+ 
+   /* Sum up user time and system time.  */
+   secs = usage.ru_utime.tv_sec + usage.ru_stime.tv_sec;
+   usecs = usage.ru_utime.tv_usec + usage.ru_stime.tv_usec;
+   if (usecs >= 1000000)
+     {
+       usecs -= 1000000;
+       secs++;
+     }
+ 
+   XSETINT (result[0], (secs >> 16) & 0xffff);
+   XSETINT (result[1], (secs >> 0)  & 0xffff);
+   XSETINT (result[2], usecs);
+ 
+   return Flist (3, result);
+ #else
+   return Fcurrent_time ();
+ #endif
+ }
  \f
  
  int
***************
*** 4280,4285 ****
--- 4325,4331 ----
    defsubr (&Suser_full_name);
    defsubr (&Semacs_pid);
    defsubr (&Scurrent_time);
+   defsubr (&Sget_internal_run_time);
    defsubr (&Sformat_time_string);
    defsubr (&Sfloat_time);
    defsubr (&Sdecode_time);
Index: lispref/os.texi
===================================================================
RCS file: /cvsroot/emacs/emacs/lispref/os.texi,v
retrieving revision 1.62
diff -c -r1.62 os.texi
*** lispref/os.texi	17 Feb 2004 01:06:10 -0000	1.62
--- lispref/os.texi	1 May 2004 07:26:08 -0000
***************
*** 23,28 ****
--- 23,29 ----
  * Time of Day::		Getting the current time.
  * Time Conversion::     Converting a time from numeric form to a string, or
                            to calendrical data (or vice versa).
+ * Processor Run Time::  Getting the run time used by Emacs.
  * Time Calculations::   Adding, subtracting, comparing times, etc.
  * Timers::		Setting a timer to call a function at a certain time.
  * Terminal Input::      Recording terminal input for debugging.
***************
*** 1247,1252 ****
--- 1248,1275 ----
  if you try to encode a time that is out of range, an error results.
  For instance, years before 1970 do not work on some systems;
  on others, years as early as 1901 do work.
+ @end defun
+ 
+ @node Processor Run Time
+ @section Processor Run time
+ 
+ @defun get-internal-run-time
+ This function returns the processor run time used by Emacs as a list
+ of three integers: @code{(@var{high} @var{low} @var{microsec})}.  The
+ integers @var{high} and @var{low} combine to give the number of
+ seconds, which is
+ @ifnottex
+ @var{high} * 2**16 + @var{low}.
+ @end ifnottex
+ @tex
+ $high*2^{16}+low$.
+ @end tex
+ 
+ The third element, @var{microsec}, gives the microseconds (or 0 for
+ systems that return time with the resolution of only one second).
+ 
+ If the system doesn't provide a way to determine the processor run
+ time, get-internal-run-time returns the same time as current-time.
  @end defun
  
  @node Time Calculations

Re: User-reserved element in byte code vectors (was: Emacs Common Lisp)

[Miles Bader]

On Sat, May 01, 2004 at 07:30:53AM +0200, Lars Brinkhoff wrote:
> Is there any documentation describing your extension?  Does any of
> these describe the current situation?
>
>   http://mail.gnu.org/archive/html/emacs-devel/2001-10/msg00085.html

That's my original post.

>   http://mail.gnu.org/archive/html/emacs-devel/2001-10/txt00003.txt

No, this is someone else's design.  The link you posted doesn't contain any
names, but if I remember correctly it used a somewhat more complex mechanism.

> I checked out the lexbind branch from CVS.  Is that the right one?

Yes.

The authoritative source is the arch branch:

   miles@gnu.org--gnu-2004/emacs--lexbind--0

But I keep the CVS branch updated.

-Miles.
-- 
"I distrust a research person who is always obviously busy on a task."
   --Robert Frosch, VP, GM Research

Re: User-reserved element in byte code vectors

[Lars Brinkhoff]

Stefan Monnier <monnier@iro.umontreal.ca> writes:
> I'd argue that the closure's enviornment should be put as the first
> element in the constants-vector rather than in a separate slot in
> the byte code object: it makes closure construction slower and more
> clostly, but it makes the function call faster.

The downside to that is that you would have to create both a new byte
code object, and a new constants vector every time a closure is
creates, e.g.:

  (defun make-closure (template env)
    (let ((args (aref template 0))
          (code (aref template 1))
          (constants (aref template 2))
          (stack-size (aref template 3))
          (doc (aref template 4))
          (interactive (aref template 5)))
      (setq constants (copy-sequence constants))
      (setq (aref constants 0) env)
      (make-byte-code args code constants stack-size doc interactive)))

Whereas if the environment is located directly in the function, you
only have to create a new byte code object:

  (defun make-closure (template env)
    (let ((args (aref template 0))
          (code (aref template 1))
          (constants (aref template 2))
          (stack-size (aref template 3))
          (doc (aref template 4))
          (interactive (aref template 5)))
      (make-byte-code args code constants stack-size doc interactive env)))

-- 
Lars Brinkhoff,         Services for Unix, Linux, GCC, HTTP
Brinkhoff Consulting    http://www.brinkhoff.se/

Re: User-reserved element in byte code vectors

[Miles Bader]

On Sun, May 02, 2004 at 09:59:24AM +0200, Lars Brinkhoff wrote:
> The downside to that is that you would have to create both a new byte
> code object, and a new constants vector every time a closure is
> creates, e.g.:

The way my lexical-binding branch makes closures is basically with a new
`curried function' type, e.g.:

   (funcall (curry '+ 2 3 4) 5) => 14

So a closure is just:

  (curry (lambda (env arg1 ...) ...)
         environment-vector)

Since the curried-functions are very, very, simple[*], I think it shouldn't
be a problem to merge that into the trunk.

[*] basically my patch just makes lisp vectors funcallable

-Miles
-- 
We live, as we dream -- alone....

Re: get-internal-run-time

[Eli Zaretskii]

> From: Lars Brinkhoff <lars@nocrew.org>
> Date: 01 May 2004 20:53:01 +0200
> 
> + #ifdef HAVE_SYS_RESOURCE_H
> +   struct rusage usage;
> +   Lisp_Object result[3];
> +   int secs, usecs;
> + 
> +   if (getrusage (RUSAGE_SELF, &usage) < 0)
> +     /* This shouldn't happen.  What action is appropriate?  */
> +     Fsignal (Qerror, Qnil);

Is it enough to test for sys/resource.h to deduce that getrusage is
available?  Or perhaps we need to test for the function as well?

Re: get-internal-run-time

[Lars Brinkhoff]

"Eli Zaretskii" <eliz@gnu.org> writes:
> > From: Lars Brinkhoff <lars@nocrew.org>
> > + #ifdef HAVE_SYS_RESOURCE_H
> > +   struct rusage usage;
> > +   Lisp_Object result[3];
> > +   int secs, usecs;
> > + 
> > +   if (getrusage (RUSAGE_SELF, &usage) < 0)
> > +     /* This shouldn't happen.  What action is appropriate?  */
> > +     Fsignal (Qerror, Qnil);
> Is it enough to test for sys/resource.h to deduce that getrusage is
> available?  Or perhaps we need to test for the function as well?

Yes, I guess we'd better check to be on the safe side.

-- 
Lars Brinkhoff,         Services for Unix, Linux, GCC, HTTP
Brinkhoff Consulting    http://www.brinkhoff.se/

Re: User-reserved element in byte code vectors

[Lars Brinkhoff]

Miles Bader <miles@gnu.org> writes:
> So a closure is just:
>   (curry (lambda (env arg1 ...) ...)
>          environment-vector)
> Since the curried-functions are very, very, simple[*], I think it shouldn't
> be a problem to merge that into the trunk.

I checked your modfication to funcall, so I see a closure can be a
two-element vector [fn env], which is very nice.  But then why do you
also use element 7 in byte code objects?

> [*] basically my patch just makes lisp vectors funcallable

I think that's great!  I've been reading up on Common Lisp
"funcallable instances", which are function objects that are
simultaneously class instances.  With standard byte code objects, I
could store instance slots in an unused byte code element, but with
funcallable vectors, I can store the slots in the vector.

-- 
Lars Brinkhoff,         Services for Unix, Linux, GCC, HTTP
Brinkhoff Consulting    http://www.brinkhoff.se/

Re: User-reserved element in byte code vectors

[Stefan Monnier]

>> I'd argue that the closure's enviornment should be put as the first
>> element in the constants-vector rather than in a separate slot in
>> the byte code object: it makes closure construction slower and more
>> costly, but it makes the function call faster.

> The downside to that is that you would have to create both a new byte
> code object, and a new constants vector every time a closure is
> created.

Yes, as I said above, "it makes closure construction slower and more
costly".  But it does make calling a closure faster since closures are then
plain old normal byte-code objects supported natively whereas in your case
you need to do some massaging before doing the actual `funcall'.

Furthermore, with your scheme you can't call closures in the same way as
built-in functions.  How do you deal with that without slowing down function
calls or closure construction too much?


        Stefan

Re: get-internal-run-time

[Lars Brinkhoff]

"Eli Zaretskii" <eliz@gnu.org> writes:
> Is it enough to test for sys/resource.h to deduce that getrusage is
> available?  Or perhaps we need to test for the function as well?

Here's an updated patch.  I believe I've signed copyright assignment
papers for contributions to Emacs, but that was many years ago, so I
don't know if they're still on file.

etc/NEWS (Lisp Changes):
** The new primitive `get-internal-run-time' returns the processor
run time used by Emacs since start-up.

./ChangeLog:
2004-05-02  Lars Brinkhoff  <lars@nocrew.org>

	* configure.in: Add check for getrusage.

src/ChangeLog:
2004-05-02  Lars Brinkhoff  <lars@nocrew.org>

	* editfns.c (Fget_internal_run_time): New function.
	(syms_of_data): Defsubr it.

lispref/ChangeLog:
2004-05-02  Lars Brinkhoff  <lars@nocrew.org>

	* os.texi (Processor Run Time): New section documenting
	get-internal-run-time.

Index: configure.in
===================================================================
RCS file: /cvsroot/emacs/emacs/configure.in,v
retrieving revision 1.366
diff -c -r1.366 configure.in
*** configure.in	29 Apr 2004 18:59:27 -0000	1.366
--- configure.in	2 May 2004 16:41:37 -0000
***************
*** 2344,2350 ****
  AC_CHECK_HEADERS(maillock.h)
  
  AC_CHECK_FUNCS(gethostname getdomainname dup2 \
! rename closedir mkdir rmdir sysinfo \
  random lrand48 bcopy bcmp logb frexp fmod rint cbrt ftime res_init setsid \
  strerror fpathconf select mktime euidaccess getpagesize tzset setlocale \
  utimes setrlimit setpgid getcwd getwd shutdown getaddrinfo \
--- 2344,2350 ----
  AC_CHECK_HEADERS(maillock.h)
  
  AC_CHECK_FUNCS(gethostname getdomainname dup2 \
! rename closedir mkdir rmdir sysinfo getrusage \
  random lrand48 bcopy bcmp logb frexp fmod rint cbrt ftime res_init setsid \
  strerror fpathconf select mktime euidaccess getpagesize tzset setlocale \
  utimes setrlimit setpgid getcwd getwd shutdown getaddrinfo \
Index: src/editfns.c
===================================================================
RCS file: /cvsroot/emacs/emacs/src/editfns.c,v
retrieving revision 1.372
diff -c -r1.372 editfns.c
*** src/editfns.c	27 Apr 2004 13:28:38 -0000	1.372
--- src/editfns.c	2 May 2004 16:41:38 -0000
***************
*** 39,44 ****
--- 39,48 ----
  #include <stdio.h>
  #endif
  
+ #if defined HAVE_SYS_RESOURCE_H && defined HAVE_GETRUSAGE
+ #include <sys/resource.h>
+ #endif
+ 
  #include <ctype.h>
  
  #include "lisp.h"
***************
*** 1375,1380 ****
--- 1379,1425 ----
  
    return Flist (3, result);
  }
+ 
+ DEFUN ("get-internal-run-time", Fget_internal_run_time, Sget_internal_run_time,
+        0, 0, 0,
+        doc: /* Return the current run time used by Emacs.
+ The time is returned as a list of three integers.  The first has the
+ most significant 16 bits of the seconds, while the second has the
+ least significant 16 bits.  The third integer gives the microsecond
+ count.
+ 
+ On systems that can't determine the run time, get-internal-run-time
+ does the same thing as current-time.  The microsecond count is zero on
+ systems that do not provide resolution finer than a second.  */)
+      ()
+ {
+ #ifdef HAVE_GETRUSAGE
+   struct rusage usage;
+   Lisp_Object result[3];
+   int secs, usecs;
+ 
+   if (getrusage (RUSAGE_SELF, &usage) < 0)
+     /* This shouldn't happen.  What action is appropriate?  */
+     Fsignal (Qerror, Qnil);
+ 
+   /* Sum up user time and system time.  */
+   secs = usage.ru_utime.tv_sec + usage.ru_stime.tv_sec;
+   usecs = usage.ru_utime.tv_usec + usage.ru_stime.tv_usec;
+   if (usecs >= 1000000)
+     {
+       usecs -= 1000000;
+       secs++;
+     }
+ 
+   XSETINT (result[0], (secs >> 16) & 0xffff);
+   XSETINT (result[1], (secs >> 0)  & 0xffff);
+   XSETINT (result[2], usecs);
+ 
+   return Flist (3, result);
+ #else
+   return Fcurrent_time ();
+ #endif
+ }
  \f
  
  int
***************
*** 4280,4285 ****
--- 4325,4331 ----
    defsubr (&Suser_full_name);
    defsubr (&Semacs_pid);
    defsubr (&Scurrent_time);
+   defsubr (&Sget_internal_run_time);
    defsubr (&Sformat_time_string);
    defsubr (&Sfloat_time);
    defsubr (&Sdecode_time);
Index: lispref/os.texi
===================================================================
RCS file: /cvsroot/emacs/emacs/lispref/os.texi,v
retrieving revision 1.62
diff -c -r1.62 os.texi
*** lispref/os.texi	17 Feb 2004 01:06:10 -0000	1.62
--- lispref/os.texi	2 May 2004 16:41:39 -0000
***************
*** 23,28 ****
--- 23,29 ----
  * Time of Day::		Getting the current time.
  * Time Conversion::     Converting a time from numeric form to a string, or
                            to calendrical data (or vice versa).
+ * Processor Run Time::  Getting the run time used by Emacs.
  * Time Calculations::   Adding, subtracting, comparing times, etc.
  * Timers::		Setting a timer to call a function at a certain time.
  * Terminal Input::      Recording terminal input for debugging.
***************
*** 1247,1252 ****
--- 1248,1275 ----
  if you try to encode a time that is out of range, an error results.
  For instance, years before 1970 do not work on some systems;
  on others, years as early as 1901 do work.
+ @end defun
+ 
+ @node Processor Run Time
+ @section Processor Run time
+ 
+ @defun get-internal-run-time
+ This function returns the processor run time used by Emacs as a list
+ of three integers: @code{(@var{high} @var{low} @var{microsec})}.  The
+ integers @var{high} and @var{low} combine to give the number of
+ seconds, which is
+ @ifnottex
+ @var{high} * 2**16 + @var{low}.
+ @end ifnottex
+ @tex
+ $high*2^{16}+low$.
+ @end tex
+ 
+ The third element, @var{microsec}, gives the microseconds (or 0 for
+ systems that return time with the resolution of only one second).
+ 
+ If the system doesn't provide a way to determine the processor run
+ time, get-internal-run-time returns the same time as current-time.
  @end defun
  
  @node Time Calculations

Re: User-reserved element in byte code vectors

[Lars Brinkhoff]

Stefan Monnier <monnier@iro.umontreal.ca> writes:
> > > I'd argue that the closure's enviornment should be put as the
> > > first element in the constants-vector rather than in a separate
> > > slot in the byte code object: it makes closure construction
> > > slower and more costly, but it makes the function call faster.
> > The downside to that is that you would have to create both a new
> > byte code object, and a new constants vector every time a closure
> > is created.
> Yes, as I said above, "it makes closure construction slower and more
> costly".  But it does make calling a closure faster since closures
> are then plain old normal byte-code objects supported natively
> whereas in your case you need to do some massaging before doing the
> actual `funcall'.

No, that's not necessary.  As long as the first six element in the
byte code object are as Emacs expects them to be, anything can be
stuffed into additional elements.  At least in GNU Emacs 20.7, 21.3,
and CVS.

> Furthermore, with your scheme you can't call closures in the same
> way as built-in functions.  How do you deal with that without
> slowing down function calls or closure construction too much?

A closure can be a byte code object with an extra element.

-- 
Lars Brinkhoff,         Services for Unix, Linux, GCC, HTTP
Brinkhoff Consulting    http://www.brinkhoff.se/

Re: User-reserved element in byte code vectors

[Stefan Monnier]

> No, that's not necessary.  As long as the first six element in the
> byte code object are as Emacs expects them to be, anything can be
> stuffed into additional elements.  At least in GNU Emacs 20.7, 21.3,
> and CVS.

But then how does your bytecode access this 7th element?


        Stefan

Re: User-reserved element in byte code vectors

[Lars Brinkhoff]

Stefan Monnier <monnier@iro.umontreal.ca> writes:
> > No, that's not necessary.  As long as the first six element in the
> > byte code object are as Emacs expects them to be, anything can be
> > stuffed into additional elements.  At least in GNU Emacs 20.7,
> > 21.3, and CVS.
> But then how does your bytecode access this 7th element?

Yes, that's a problem.  I don't think there is a way.  Something would
have to be invented for this to work.

Miles Bader said something about using the 7th element for closures,
but I don't know the details.

-- 
Lars Brinkhoff,         Services for Unix, Linux, GCC, HTTP
Brinkhoff Consulting    http://www.brinkhoff.se/

Re: User-reserved element in byte code vectors

[Richard Stallman]

    Whereas if the environment is located directly in the function, you
    only have to create a new byte code object:

That argument seems strong to me.

Re: User-reserved element in byte code vectors

[Stefan Monnier]

>> > No, that's not necessary.  As long as the first six element in the
>> > byte code object are as Emacs expects them to be, anything can be
>> > stuffed into additional elements.  At least in GNU Emacs 20.7,
>> > 21.3, and CVS.
>> But then how does your bytecode access this 7th element?
> Yes, that's a problem.  I don't think there is a way.

Heh?  Do you mean to say that "your way" has the downside that it plain
does not work?  I thought you already had it implemented.

> Something would have to be invented for this to work.
> Miles Bader said something about using the 7th element for closures,
> but I don't know the details.

Well, there are two questions:
- how best to implement closures, given the current Emacs C code.
- how best to implement closures, assuming we get to change the C code.

I'm talking about the first question.  Miles's work is within the context
of the second.


        Stefan

Re: User-reserved element in byte code vectors

[Lars Brinkhoff]

Stefan Monnier <monnier@iro.umontreal.ca> writes:
> >> > No, that's not necessary.  As long as the first six element in the
> >> > byte code object are as Emacs expects them to be, anything can be
> >> > stuffed into additional elements.  At least in GNU Emacs 20.7,
> >> > 21.3, and CVS.
> >> But then how does your bytecode access this 7th element?
> > Yes, that's a problem.  I don't think there is a way.
> Heh?  Do you mean to say that "your way" has the downside that it
> plain does not work?

Yes, that's a slight disadvantage. :)  This would only be under
consideration for "question two" below.  But then, Miles's funcallable
vectors may be better.

> I thought you already had it implemented.

I'm using another way which I sketched in a message a few days ago.

> Well, there are two questions:
> - how best to implement closures, given the current Emacs C code.
> - how best to implement closures, assuming we get to change the C code.
> 
> I'm talking about the first question.  Miles's work is within the context
> of the second.

I'm interested in both.

-- 
Lars Brinkhoff,         Services for Unix, Linux, GCC, HTTP
Brinkhoff Consulting    http://www.brinkhoff.se/

Re: User-reserved element in byte code vectors

[Stefan Monnier]

>> I thought you already had it implemented.
> I'm using another way which I sketched in a message a few days ago.

OK, so I understood it right.  My argument is that my way is better than
your current way.

In your current way (at least what I can tell from your sketch), calling
a closure involves really two function calls (you first call the wrapper
which then calls the bytecode with the extra environment argument, which is
the massaging I was talking about).

Constructing a closure in your scheme involves creating the wrapper which
boils down to constructing one new byte-compiled-object as well as one new
"constants" vector which holds the static environment, the real
byte-compiled code and maybe one or two more constants.
I.e. one byte-compiled-object and one vector.

I.e. the downside of my approach (constructing one byte-compiled-object
plus one constants vector) doesn't seem nearly as bad when seen in
this light.  Admittedly my constants vector will generally be larger so
your closure-construction is still usually more efficient, but
only profiling can tell if the difference is significant.

>> Well, there are two questions:
>> - how best to implement closures, given the current Emacs C code.
>> - how best to implement closures, assuming we get to change the C code.
>> I'm talking about the first question.  Miles's work is within the context
>> of the second.

> I'm interested in both.

I'm also interested in both, but we can't say "answer 1 to question 1 sucks
because answer 2 to question 2 is better".

To get back to the original question, I now don't see how you can usefully
put the static environment in slot 7 without making changes to the C code,
so there's no point deciding it's reserved for use by elisp packages.

As for the rest of the meta-data you might want to put in
byte-compiled-objects, maybe we should dedicate one of the slots (maybe the
7th or 8th) for an alist where people can put whatever they want.


        Stefan

Re: get-internal-run-time

[Kevin Ryde]

Lars Brinkhoff <lars@nocrew.org> writes:
>
> + #if defined HAVE_SYS_RESOURCE_H && defined HAVE_GETRUSAGE
> + #include <sys/resource.h>

It's normally enough to just test HAVE_FOO_H for a header.  (Unless
you know it's actively harmful in some particular circumstances.)

Re: get-internal-run-time

[Lars Brinkhoff]

Kevin Ryde <user42@zip.com.au> writes:
> Lars Brinkhoff <lars@nocrew.org> writes:
> > + #if defined HAVE_SYS_RESOURCE_H && defined HAVE_GETRUSAGE
> > + #include <sys/resource.h>
> It's normally enough to just test HAVE_FOO_H for a header.  (Unless
> you know it's actively harmful in some particular circumstances.)

Ok, will revise.

-- 
Lars Brinkhoff,         Services for Unix, Linux, GCC, HTTP
Brinkhoff Consulting    http://www.brinkhoff.se/

Re: User-reserved element in byte code vectors

[Lars Brinkhoff]

Stefan Monnier <monnier@iro.umontreal.ca> writes:
> > > I thought you already had it implemented.
> > I'm using another way which I sketched in a message a few days ago.
> OK, so I understood it right.  My argument is that my way is better
> than your current way.

Yes, I agree.

> Constructing a closure in your scheme involves creating the wrapper
> which boils down to constructing one new byte-compiled-object as
> well as one new "constants" vector which holds the static
> environment, the real byte-compiled code and maybe one or two more
> constants.  I.e. one byte-compiled-object and one vector.

Yes, and maybe some consing of the &rest argument to the wrapper?

> I.e. the downside of my approach (constructing one byte-compiled-
> object plus one constants vector) doesn't seem nearly as bad when
> seen in this light.  Admittedly my constants vector will generally
> be larger so your closure-construction is still usually more
> efficient, but only profiling can tell if the difference is
> significant.

Right.  For reference, my wrapper function looks like this:
#[(&rest args) "<8 bytes>" [env args <environment> apply <function>] 3]

> I'm also interested in both, but we can't say "answer 1 to question
> 1 sucks because answer 2 to question 2 is better".

Sorry, I didn't mean to imply that anything sucks.

> To get back to the original question, I now don't see how you can
> usefully put the static environment in slot 7 without making changes
> to the C code, so there's no point deciding it's reserved for use by
> elisp packages.

Not as an environment slot for current Emacs Lisp code, no.

> As for the rest of the meta-data you might want to put in byte-
> compiled-objects, maybe we should dedicate one of the slots (maybe
> the 7th or 8th) for an alist where people can put whatever they
> want.

That would be nice.

-- 
Lars Brinkhoff,         Services for Unix, Linux, GCC, HTTP
Brinkhoff Consulting    http://www.brinkhoff.se/

Re: User-reserved element in byte code vectors

[Richard Stallman]

All else being equal, I would rather use bytecode objects than vectors
for something funcallable.

Re: get-internal-run-time

[Richard Stallman]

Your old papers covered only past changes, so we need new ones.

Re: User-reserved element in byte code vectors

[Miles Bader]

On Mon, May 03, 2004 at 10:03:24AM -0400, Richard Stallman wrote:
> All else being equal, I would rather use bytecode objects than vectors
> for something funcallable.

What I'm proposing -- `curried functions' -- are not related to bytecode
objects at all, they may simply be used as a (more general) alternative to
the functionality Lars was trying to accomplish by stuffing stuff into
bytecode vectors.

Because they are more general (and indeed are generally very useful), I think
they're a better solution than a special-case hack for bytecode objects.

If you just don't like vectors being funcallable, then of course (e.g.)
another special-purpose vector type could be used instead.  However it would
be nice if it were printable, and if users could set/access the elements
easily; by using standard vectors, these things come for free.

-Miles
-- 
I'm beginning to think that life is just one long Yoko Ono album; no rhyme
or reason, just a lot of incoherent shrieks and then it's over.  --Ian Wolff

Re: User-reserved element in byte code vectors

[Lars Brinkhoff]

Miles Bader <miles@gnu.org> writes:
> On Mon, May 03, 2004 at 10:03:24AM -0400, Richard Stallman wrote:
> > All else being equal, I would rather use bytecode objects than
> > vectors for something funcallable.
> If you just don't like vectors being funcallable, then of course
> (e.g.) another special-purpose vector type could be used instead.
> However it would be nice if it were printable, and if users could
> set/access the elements easily; by using standard vectors, these
> things come for free.

It occurred to me that there already is funcallable vector-like type
with all those nice properties: the bytecode type.  If funcall was
changed (and I don't know if this is acceptable) to "curry" in all
bytecode elements after the 6th, that would work as well as Miles's
funcallable vectors.

E.g. Ffuncall could be changed to something like:

        if (COMPILEDP (fun))
          {
            int size = XVECTOR (fun)->size & PSEUDOVECTOR_SIZE_MASK;
            if (size <= 6)
              /* The usual case, as before.  */
              val = funcall_lambda (fun, numargs, args + 1);
            else
              {
                /* This is adapted from Miles's funcallable vectors.  */
                int num_curried_args = size - 6;
                internal_args =
                  (Lisp_Object *) alloca ((num_curried_args + numargs)
                                          * sizeof (Lisp_Object));
                
                /* Curried args are first in the new arg vector.  */
                bcopy (XVECTOR (fun)->contents, internal_args,
                       num_curried_args * sizeof (Lisp_Object));

                /* User args are last.  */
                bcopy (args + 1, internal_args + num_curried_args,
                       numargs * sizeof (Lisp_Object));
                
                val = funcall_lambda (fun, num_curried_args + numargs,
                                      internal_args);
              }
          }

This would be an incompatible change, but I don't think anyone relies
on the old behaviour.

-- 
Lars Brinkhoff,         Services for Unix, Linux, GCC, HTTP
Brinkhoff Consulting    http://www.brinkhoff.se/

Re: User-reserved element in byte code vectors

[Richard Stallman]

The change you are proposing would eliminate any possibility of
storing anything else in the bytecode object.  That would be a
mistake.

Instead we could dedicate slot 7 to a vector of curried args.  That
would not interfere with other uses of other slots.

Re: User-reserved element in byte code vectors

[Miles Bader]

Richard Stallman <rms@gnu.org> writes:
> Instead we could dedicate slot 7 to a vector of curried args.  That
> would not interfere with other uses of other slots.

I'm a bit confused by how Lars is suggesting that byte-code vectors be
used for currying.  From the Ffuncall code-snipped he posted, I gather
that he was saying that the curried args be just a way to attach magic
arguments to an existing byte-code vector.

However currying is usually used as a way of _wrapping_ an existing
function.  Morever, it should (1) support interpreted functions as well,
and (2) be efficient (no consing when calling a curried function, and
ideally, little additional overhead compared to calling a non-curried
function).

Using his code, one could use byte-code objects with the traditional
first 6-slots containing a special `currying trampoline' function, but
really I'm not sure the point -- doing that seems to have lots of
disadvantages:

  (1) It would require consing for each call in many cases

  (2) It would incur extra time overhead when calling the curried
       function (executing the trampoline function),

  (3) Constructing curried functions would be a lot more heavyweight,
      because the various magic byte-code bits have to be constructed
      (_especially_ if you tried to do analysis to avoid some consing
      overhead by not using &rest when possible).

  (4) If you're going to construct special trampoline functions anyway,
      why not just stick the curried arguments into the byte-code
      constant vector in the first place?

So while I can see that maybe using a non-standard vector type like
byte-code vectors could be a good idea, the current suggestions don't
seem very good.

How about the following:  If a byte-code vector's first element is
`curry', treat the remaining elements the same way my current (normal
vector) currying implementation works, otherwise treat it as a normal
byte-code function.  Since the first element in a normal byte-code
object is an arg-list, it should never be an atom, so there shouldn't be
any conflict between the two uses.

So for example:

   (curry '+ 1 2 3)
   => #[curry + 1 2 3]

-Miles
-- 
o The existentialist, not having a pillow, goes everywhere with the book by
  Sullivan, _I am going to spit on your graves_.

Re: User-reserved element in byte code vectors

[Miles Bader]

Miles Bader <miles@lsi.nec.co.jp> writes:
> How about the following:  If a byte-code vector's first element is
> `curry', treat the remaining elements the same way my current (normal
> vector) currying implementation works, otherwise treat it as a normal
> byte-code function.  Since the first element in a normal byte-code
> object is an arg-list, it should never be an atom, so there shouldn't be
> any conflict between the two uses.
> 
> So for example:
> 
>    (curry '+ 1 2 3)
>    => #[curry + 1 2 3]

BTW, some other advantage of such a representation --

  * Having a name explicitly attached make it easier to see what it is,
    even if you've never encountered such a thing before, the "#[" tells
    you `hey it's connected with the lisp evaluator', and the
    first-element name gives you strong clue to determine just exactly
    what.

  * It leaves a clear path for other special magic-callable objects.
    E.g., another very useful notion is that of `reverse currying',
    where the curried arguments get attached to the _end_ of the
    argument list at call time, which could look like #[rcurry ...].

-Miles
-- 
P.S.  All information contained in the above letter is false,
      for reasons of military security.

Re: User-reserved element in byte code vectors

[Lars Brinkhoff]

Miles Bader <miles@lsi.nec.co.jp> writes:
> I'm a bit confused by how Lars is suggesting that byte-code vectors be
> used for currying.

It was only an idea thrown out for consideration.  I'm glad it spawned
some new ideas.

> From the Ffuncall code-snipped he posted, I gather that he was
> saying that the curried args be just a way to attach magic arguments
> to an existing byte-code vector.

To curry a function, you could copy the first six elements from the
byte-code object and put them into a new byte-code object along with
the curried arguments.  I don't think that usage would be quite as bad
as you envisioned (no trampoline, no consing when calling, etc), but
anway, I'm not defending it as your suggestion seems much more elegant:

> How about the following: If a byte-code vector's first element is
> `curry', treat the remaining elements the same way my current
> (normal vector) currying implementation works, otherwise treat it as
> a normal byte-code function.

Sounds good to me.

-- 
Lars Brinkhoff,         Services for Unix, Linux, GCC, HTTP
Brinkhoff Consulting    http://www.brinkhoff.se/

Re: User-reserved element in byte code vectors

[Richard Stallman]

    > So for example:
    > 
    >    (curry '+ 1 2 3)
    >    => #[curry + 1 2 3]

    BTW, some other advantage of such a representation --

      * Having a name explicitly attached make it easier to see what it is,
	even if you've never encountered such a thing before, the "#[" tells
	you `hey it's connected with the lisp evaluator', and the
	first-element name gives you strong clue to determine just exactly
	what.

      * It leaves a clear path for other special magic-callable objects.
	E.g., another very useful notion is that of `reverse currying',
	where the curried arguments get attached to the _end_ of the
	argument list at call time, which could look like #[rcurry ...].

This seems like a good idea to me.

Re: User-reserved element in byte code vectors

[Stefan Monnier]

>    (curry '+ 1 2 3)
>    => #[curry + 1 2 3]

Sounds like a very good way to implement currying within Elisp.
Much better than your current use of plain vectors.
But of course it will break some elisp code that expects a byte-compiled-p
object to have a particular shape (typically code that wants to get at the
docstring, or the arglist, or the interactive spec).

I'm still not sure I understand what it would be used for.

Is that how you construct closures in your lexbind branch?
I thought you used extra arguments in byte-compiled-objects for that.


        Stefan

Re: User-reserved element in byte code vectors

[Miles Bader]

On Thu, May 06, 2004 at 10:24:18AM -0400, Stefan Monnier wrote:
> >    (curry '+ 1 2 3)
> >    => #[curry + 1 2 3]
...
> But of course it will break some elisp code that expects a byte-compiled-p
> object to have a particular shape (typically code that wants to get at the
> docstring, or the arglist, or the interactive spec).

I think such code will be (1) extremely rare, and (2) the sort of very
specialized thing that will not be done by externally-maintained user
packages.  So it should be no problem to look for and fix it ahead of time
(and once fixed, such code will kosher for future uses of byte-vectors in
this manner, with different first-element tags).

> I'm still not sure I understand what it would be used for.
> 
> Is that how you construct closures in your lexbind branch?

Yes (well, of course there I currently still use normal vectors, but I'll
obviously change to this new representation if it can go into the trunk).

> I thought you used extra arguments in byte-compiled-objects for that.

No; the extra arg in byte-compiled-objects is a flag telling eval to use
lexical binding for the arguments -- it's a static part of the
byte-code-object, and only applies to byte-code-objects, so it makes sense to
put it there.

[Remember closures are created dynamically, so all the extra futzing around
required to use an `extra argument in byte-compiled-objects' would be pretty
annoying.  See my earlier reply to Lars for a list of reasons...]

-Miles
-- 
.Numeric stability is probably not all that important when you're guessing.

Re: User-reserved element in byte code vectors

[Miles Bader]

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

This is a patch that adds `curried functions' as discussed, using the
#[...] syntax.

E.g., 

   (curry 'concat "The ")
   => #[curry concat "The "]

   (mapcar (curry 'concat "The ") '("a" "b" "c"))
   => ("The a" "The b" "The c")

Does this look useful for your purposes Lars?


Patch:



[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: +funvec-20030514-2.patch --]
[-- Type: text/x-patch, Size: 27855 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-14  Miles Bader  <miles@gnu.org>

	* lisp.h: Declare 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 (Fmake_char_table, Fmake_byte_code): 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): New function.
	* 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  src/data.c
M  src/ChangeLog
M  src/alloc.c
M  src/keyboard.c
M  src/fns.c
M  src/lisp.h
M  src/lread.c
M  src/print.c
M  lisp/ChangeLog
M  lisp/subr.el

* modified files

*** 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/src/alloc.c
--- mod/src/alloc.c
***************
*** 2643,2648 ****
--- 2643,2674 ----
  }
  
  
+ DEFUN ("make-funvec", Fmake_funvec, Smake_funvec, 2, 3, 0,
+        doc: /* Return a new `function vector' containing KIND, and NUM_PARAMS more elements.
+ A `function vector', AKA, `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 initialize to INIT (which defaults to nil).
+ See also the function `funvec'.  */)
+   (kind, num_params, init)
+      register Lisp_Object kind, num_params, init;
+ {
+   Lisp_Object funvec;
+ 
+   CHECK_NATNUM (num_params);
+ 
+   if (NILP (kind) || !SYMBOLP (kind))
+     error ("Invalid funvec kind");
+ 
+   funvec = Fmake_vector (make_number (XFASTINT (num_params) + 1), init);
+ 
+   ASET (funvec, 0, kind);
+   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 ****
--- 2733,2761 ----
  }
  
  
+ DEFUN ("funvec", Ffunvec, Sfunvec, 1, MANY, 0,
+        doc: /* Return a newly created `function vector' of kind KIND.
+ A `function vector', AKA, `funvec' is a funcallable vector in emacs lisp.
+ KIND is a non-nil symbol specifying the kind of funvec.  The meaning of the
+ remaining arguments depends on KIND.
+ usage: (funvec KIND &rest OBJECTS)  */)
+      (nargs, args)
+      register int nargs;
+      Lisp_Object *args;
+ {
+   register int index;
+   register Lisp_Object num_params, funvec;
+ 
+   XSETFASTINT (num_params, nargs - 1);
+   funvec = Fmake_funvec (args[0], num_params, Qnil);
+ 
+   for (index = 1; index < nargs; index++)
+     ASET (funvec, index, args[index]);
+ 
+   return funvec;
+ }
+ 
+ 
  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 ****
--- 2771,2780 ----
    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;
  }
  
--- 2796,2802 ----
  	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;
--- 4281,4287 ----
      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;
--- 4293,4300 ----
        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.  */
--- 4852,4858 ----
  	}
        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 ****
--- 5811,5821 ----
    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;
  
  /* 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,2812 ----
  	  abort ();
  	}
      }
! 
!   if (FUNVECP (fun))
!     /* A `function vector' object holds various types of funcallable
!        vectors.  */
!     {
!       if (FUNVEC_COMPILED_P (fun))
! 	val = funcall_lambda (fun, numargs, args + 1);
!       else
! 	{
! 	  int size = FUNVEC_SIZE (fun);
! 
! 	  if (size > 1 && EQ (AREF (fun, 0), Qcurry))
! 	    {
! 	      /* A curried function is a way to attach arguments to a
! 		 another function. The first element of the vector is
! 		 the identifier `curry', the second is the wrapped
! 		 function, and remaining elements are the attached
! 		 arguments.  */
! 	      int num_curried_args = size - 2;
! 
! 	      internal_args = (Lisp_Object *) alloca ((num_curried_args + nargs)
! 						      * sizeof (Lisp_Object));
! 
! 	      /* Curried function + curried args are first in the new arg vector.  */
! 	      bcopy (XVECTOR (fun)->contents + 1, internal_args,
! 		     (num_curried_args + 1) * sizeof (Lisp_Object));
! 	      /* User args (not including the old function) are last.  */
! 	      bcopy (args + 1, internal_args + num_curried_args + 1,
! 		     (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 ****
--- 3158,3193 ----
    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;
+ {
+   register int index;
+   register Lisp_Object num_params, funvec;
+ 
+   XSETFASTINT (num_params, nargs);
+   funvec = Fmake_funvec (Qcurry, num_params, Qnil);
+ 
+   for (index = 0; index < nargs; index++)
+     ASET (funvec, index + 1, args[index]);
+ 
+   return funvec;
+ }
+ \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 ****
--- 3378,3386 ----
    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 ****
--- 3498,3504 ----
    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);
+ EXFUN (Fmake_funvec, 3);
  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: 53 bytes --]



-Miles
-- 
`Life is a boundless sea of bitterness'

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

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

Re: User-reserved element in byte code vectors

[Stefan Monnier]

> This is a patch that adds `curried functions' as discussed, using the
> #[...] syntax.

>    (curry 'concat "The ")
>    => #[curry concat "The "]

>    (mapcar (curry 'concat "The ") '("a" "b" "c"))
>    => ("The a" "The b" "The c")

> Does this look useful for your purposes Lars?

Just some nitpicking: `curry' is the action of taking a function of
2 arguments and turning it into a function of one arg that returns another
function that expects the second arg.  I.e. (in pseudo Lisp):

     (curry 'concat)
     => (lambda (x) (lambda (y) (concat x y)))

     (funcall (curry 'concat) "The ")
     => (lambda (y) (concat "The " y))

     (mapcar (funcall (curry 'concat) "The ") '("a" "b" "c"))
     => ("The a" "The b" "The c")

I do not mean to say that you should change your `curry' to behave
differently, but just that the name `curry' is not quite correct for your
use (although your operation is definitely related to currying).

What your `curry' does is a combination of curry and function application,
which results in a partial function application.  Maybe we should call it
`partial-funcall'?


        Stefan "not good with names"

Re: User-reserved element in byte code vectors

[Lars Brinkhoff]

Miles Bader writes:
> This is a patch that adds `curried functions' as discussed, using the
> #[...] syntax.
>
>    (curry 'concat "The ")
>    => #[curry concat "The "]
>
>    (mapcar (curry 'concat "The ") '("a" "b" "c"))
>    => ("The a" "The b" "The c")
>
> Does this look useful for your purposes Lars?

Yes, very!

Stefan Monnier writes:
> Just some nitpicking: `curry' is the action of taking a function of
> 2 arguments and turning it into a function of one arg that returns
> another function that expects the second arg.

When reading about currying in the context of Lisp, I've seen
this many times:

  (defun curry (function &rest args1)
    (lambda (&rest args2)
      (apply function (append args1 args2))))

which I believe matches Miles' definition.

-- 
Lars Brinkhoff,         Services for Unix, Linux, GCC, HTTP
Brinkhoff Consulting    http://www.brinkhoff.se/

Re: User-reserved element in byte code vectors

[Miles Bader]

On Fri, May 14, 2004 at 09:50:45PM +0200, Lars Brinkhoff wrote:
> When reading about currying in the context of Lisp, I've seen
> this many times:
> 
>   (defun curry (function &rest args1)
>     (lambda (&rest args2)
>       (apply function (append args1 args2))))
> 
> which I believe matches Miles' definition.

Also I think Dylan's standard `curry' function operates this way (ie my way).
[Dylan is a lisp-like language with an algolish syntax; it's very kewl.]

-miles
-- 
Fast, small, soon; pick any 2.

Re: User-reserved element in byte code vectors

[Stefan Monnier]

>> When reading about currying in the context of Lisp, I've seen
>> this many times:
>> 
>> (defun curry (function &rest args1)
>> (lambda (&rest args2)
>> (apply function (append args1 args2))))
>> 
>> which I believe matches Miles' definition.

> Also I think Dylan's standard `curry' function operates this way (ie my way).
> [Dylan is a lisp-like language with an algolish syntax; it's very kewl.]

Oh well, just put that on my being a lambda-calculus fundamentalist.
I guess I need to gather more troops if I want my crusade to have a slight
chance of success.


        Stefan

Re: User-reserved element in byte code vectors

[Richard Stallman]

I recommend leaving the first slot after `curry' unused.  That way it
could be used later to control extensions, such as a feature to
specify the order of curried and noncurried arguments.

Meanwhile, the biggest part of this job remains to be done.  That is
to update etc/NEWS and the Lisp manual.  I think that we should not
install this feature unless those changes are written first.

Re: User-reserved element in byte code vectors

[Miles Bader]

On Sat, May 15, 2004 at 02:34:01PM -0400, Richard Stallman wrote:
> I recommend leaving the first slot after `curry' unused.  That way it
> could be used later to control extensions, such as a feature to
> specify the order of curried and noncurried arguments.

I don't think that's really necessary.

My plan for reverse-currying was to simply use another tag, e.g. `rcurry',
and that solution serves for other extensions too.

Unless someone has a pretty good idea of _what_ such an extra field would be
used for, it seems like just wasted space to add it now.  If in the future
it's discovered that we really do want a new enhanced curry function, we
could add it using a `super-curry' tag or something [and even then, existing
applications that don't need that (hypothetical) functionality might want to
keep using the plain `curry' tag just to save space].

> Meanwhile, the biggest part of this job remains to be done.  That is
> to update etc/NEWS and the Lisp manual.  I think that we should not
> install this feature unless those changes are written first.

Yeah.

Thanks,

-Miles
-- 
A zen-buddhist walked into a pizza shop and
said, "Make me one with everything."

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

[Miles Bader]

[-- 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

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

[Miles Bader]

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

Here's an even newer version.  In addition to the previous patch I sent
today, this moves most of the handling of non-bytecode funvecs in eval.c
into a separate `funcall_funvec' function, called from funcall_lambda;
this makes the code easier to understand and more correct than before
(for instance, function calls from Feval now properly handle funvecs):



[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: +funvec-20030516-1-c.patch --]
[-- Type: text/x-patch, Size: 47654 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.
	(funcall_funvec, Fcurry, Frcurry): New functions.
	(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.

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
***************
*** 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,2911 ----
    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) || 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;
+       /* Offset of the curried and user args in the final arglist.  */
+       int curried_args_offs, user_args_offs;
+       /* The curried function and arguments.  */
+       Lisp_Object *curry_params = XVECTOR (fun)->contents + 1;
+       /* The arguments in the curry vector.  */
+       Lisp_Object *curried_args = curry_params + 1;
+       /* The number of arguments with which we'll call funcall, and the
+ 	 arguments themselves.  */
+       int num_funcall_args = 1 + num_curried_args + nargs;
+       Lisp_Object *funcall_args
+ 	= (Lisp_Object *) alloca (num_funcall_args * sizeof (Lisp_Object));
+ 
+       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;
+ 	}
+ 
+       /* 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 ****
--- 2920,2930 ----
    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 ****
--- 3192,3239 ----
    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 ****
--- 3424,3434 ----
    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 ****
--- 3546,3553 ----
    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: 80 bytes --]



-Miles
-- 
Ich bin ein Virus. Mach' mit und kopiere mich in Deine .signature.

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

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

Re: User-reserved element in byte code vectors

[Stefan Monnier]

> I recommend leaving the first slot after `curry' unused.  That way it
> could be used later to control extensions, such as a feature to
> specify the order of curried and noncurried arguments.

We can already represent `curry' just fine with something like:

   (defun curry (f &rest args1)
     `(lambda (&rest args2)
        (apply ,f (nconc ',args1 args2))))

I.e. the only reason for the new construct proposed by Miles is to get
better performance, so it only makes sense in cases where it's
heavily used.  The case that Miles is thinking about is closures.
I don't know of any other case where such a construct would need good
performance while not fitting within the mold of Miles's `curry'.

Even just a "reverse curry" already sounds pointless: for the rare cases
where you might want it, you can always easily replace a call like

   (reverse-curry f foo)

into

   (curry (lambda (z y x) (f x y z)) foo)

which is only slightly slower.


        Stefan

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

[Stefan Monnier]

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

I'd rather not add such a thing.  Unless you have some concrete
justification for it.  It's a very unusal operation in my experience.


        Stefan

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

[Miles Bader]

On Sun, May 16, 2004 at 07:58:31PM -0400, Stefan Monnier wrote:
> >   (2) `rcurry' (reverse-currying) function added
> 
> I'd rather not add such a thing.  Unless you have some concrete
> justification for it.  It's a very unusal operation in my experience.

I was mainly following the example of dylan, which provides both operators.
The added implementation complexity is pretty negligible.

In the distant past when I was using dylan I do recall using rcurry, for
what it's worth.

-Miles
-- 
We have met the enemy, and he is us.  -- Pogo

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

[Stefan Monnier]

>> >   (2) `rcurry' (reverse-currying) function added
>> I'd rather not add such a thing.  Unless you have some concrete
>> justification for it.  It's a very unusal operation in my experience.
> I was mainly following the example of dylan, which provides both operators.
> The added implementation complexity is pretty negligible.

It adds yet-anoter-form-of-function.  I.e. it makes function calls yet
a tiny bit slower, forces placed that look inside functions (like
describe-function) to deal with yet-another-case, ...

> In the distant past when I was using dylan I do recall using rcurry, for
> what it's worth.

But we can provide such a rarely used operator on top of other primitives
just fine.  It only deserves the fast implementation you suggest if its
performance is worth it.
>From what I can tell, rcurry will simply never be used.


        Stefan

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

[Miles Bader]

On Sun, May 16, 2004 at 08:14:51PM -0400, Stefan Monnier wrote:
> It adds yet-anoter-form-of-function.  I.e. it makes function calls yet
> a tiny bit slower, forces placed that look inside functions (like
> describe-function) to deal with yet-another-case, ...

Well, as I said, the cost is `negligible' -- it's essentially another EQ
test, a branch, and some adds, in a non-fast-path location.  It shares 99% of
its code with normal curry.

Probably the biggest cost is actually the docstring.

> From what I can tell, rcurry will simply never be used.

Er, I just said that I'd used it in the past; don't you believe me?

It's good to think about cost/benefit tradeoffs, but there's a point at
which it can become silly.

-Miles
-- 
`The suburb is an obsolete and contradictory form of human settlement'

Re: User-reserved element in byte code vectors

[Richard Stallman]

    > I recommend leaving the first slot after `curry' unused.  That way it
    > could be used later to control extensions, such as a feature to
    > specify the order of curried and noncurried arguments.

    I don't think that's really necessary.

    My plan for reverse-currying was to simply use another tag, e.g. `rcurry',
    and that solution serves for other extensions too.

    Unless someone has a pretty good idea of _what_ such an extra field would be
    used for, it seems like just wasted space to add it now.

My idea is that it would say where to fit the new args around the old
args.  For instance, you might want to curry args 2 and 3.  This would
be easy if the first slot has a list saying where the curried args go.
For instance, a list of integers saying which positions to use
the curried args in.

Yes, we could use another tag to say that this feature is in use.
I think it is cleaner to consider it a part of the currying feature.
But I don't say let's implement it now, just leave the slot open.

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

[Richard Stallman]

Now that I see what you had in mind for rcurry, it isn't really as
general as what I had in mind.  curry and rcurry together don't
add up to complete flexibility in controlling where in the arglist
the curried args go.  I don't think rcurry is worth adding.

I don't think we should implement the more general feature now--now's
not the time to propose more features.  I just suggested leaving one
slot empty, to be used for such features later.

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

[Richard Stallman]

Here are comments on the manual text.

    + 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:

That's not easy to read.  To make it clear,

    + 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"}:

followed by the same example.

    + or more usefully, used as a function with @code{mapcar}:

Better is

  The @dfn{curried function} is useful as an argument to @code{mapcar}:

    + 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

I don't think this precise code works reliably in Emacs Lisp.
(Lisp should be capitalized.)

    ! A @dfn{function vector}, or @dfn{funvec}, is a vector-like object
    ! which is callable as a function.

whose purpose is to define special kinds of functions.

      Like a normal vector, its elements
    ! can be examined or set using the @code{aref} and @code{aset}
    ! functions.
    ! 

Please avoid passive.

    A funvec with a list as its first element is a byte-compiled function,
    ! produced by the byte copmiler;

Typo.

    ! 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}.

Calling such a funvec operates by calling the embedded function with...

    ! @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}).

Is this function really worth having?  Why not use only `funvec'?

    ! This function cannot be used to make byte-code functions, even though
    ! they are a sort of funvec --- to do that, use the

Our style is no spaces around ---.

To say "cannot" is not clear.  What does that mean?  It gets an error?
You should avoid such usage?

Re: User-reserved element in byte code vectors

[Lars Brinkhoff]

Richard Stallman <rms@gnu.org> writes:
>     > I recommend leaving the first slot after `curry' unused.  That
>     > way it could be used later to control extensions, such as a
>     > feature to specify the order of curried and noncurried
>     > arguments.
>     I don't think that's really necessary.
> My idea is that it would say where to fit the new args around the
> old args.  For instance, you might want to curry args 2 and 3.  This
> would be easy if the first slot has a list saying where the curried
> args go.  For instance, a list of integers saying which positions to
> use the curried args in.

For what it's worth, I agree with Stefan Monnier.  There's really no
need to over-engineer this.  Emacs Lisp can already do all kinds of
fancy currying without the proposed change.

-- 
Lars Brinkhoff,         Services for Unix, Linux, GCC, HTTP
Brinkhoff Consulting    http://www.brinkhoff.se/

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

[Stefan Monnier]

>> It adds yet-anoter-form-of-function.  I.e. it makes function calls yet
>> a tiny bit slower, forces placed that look inside functions (like
>> describe-function) to deal with yet-another-case, ...
> Well, as I said, the cost is `negligible' -- it's essentially another EQ
> test, a branch, and some adds, in a non-fast-path location.  It shares 99%
> of its code with normal curry.

Well, "negligible" is always "w.r.t" something, typically the upside.
You conveniently ignored `describe-function' and `defadvice'...

> Probably the biggest cost is actually the docstring.
>> From what I can tell, rcurry will simply never be used.
> Er, I just said that I'd used it in the past; don't you believe me?

You said in Dylan.  Dylan is not Elisp.  And if someday somewhere someone
uses rcurry, I still don't find this very compeling since an elisp
implementation on top of existing functionality would work just as well.

> It's good to think about cost/benefit tradeoffs, but there's a point at
> which it can become silly.

Think about what happens to the byte-code optimizer when it inlines
a function: will it treat rcurry specially as well?  What about mixed-curry
when we add it (which would also be a negligible addition, after all)?

Let's only add things we need.  For one I don't believe that we even need
"curry" as such.  What we need is a cheap&fast way to implement closures.
"curry" is a way to do that, so it makes sense to add it in the C core.
"rcurry" provides no such useful functionality and can thus just as well be
implemented in elisp.  If we later on see that it indeed should deserve
a more efficient treatment, then we can always put it back in C.


        Stefan

Re: User-reserved element in byte code vectors

[Stefan Monnier]

> My idea is that it would say where to fit the new args around the old
> args.  For instance, you might want to curry args 2 and 3.  This would
> be easy if the first slot has a list saying where the curried args go.
> For instance, a list of integers saying which positions to use
> the curried args in.

We already have a very simple way to express such things:

   (curry (lambda (x2 x3 x1 x4) (f x1 x2 x3 x4) arg2 arg3)

this also has the advangtage that it is naturally extends to

   (curry (lambda (x23 x1 x4) (f x1 x23 x23 x4) arg23)

and many other cases we can't even think of yet.
And it requires ZERO extra C code.


        Stefan

Re: User-reserved element in byte code vectors

[Miles Bader]

On Mon, May 17, 2004 at 12:30:05PM -0400, Stefan Monnier wrote:
> > My idea is that it would say where to fit the new args around the old
> > args.  For instance, you might want to curry args 2 and 3.  This would
> > be easy if the first slot has a list saying where the curried args go.
> > For instance, a list of integers saying which positions to use
> > the curried args in.
> 
> We already have a very simple way to express such things:

I think the case where using `lambda' becomes annoying is when you have a
variable-length arglist, which with lambda would require using &rest or
something, and so do lots of run-time consing.

It's probably true that at this point it's over-engineering, but perhaps
Richard's stance of just leaving a single nil slot available for future
exploration is reasonable.  A single vector slot is not very expensive.

On the other hand, I'm not sure it's really better than omitting the slot
now, and later adding a `super-curry' funvec-kind that has the slot -- code
that cares about funvec layout would have to be amended to deal with non-nil
values of the slot anyay, so making it understand `super-curry' isn't much
different, right?  If Stefan's intuition proves right, and `super-curry'
never gets added, then it will represent a small savings.

Oh bother, I'm not sure what to do...

[Well, actually since it's Richard's decision in the end, and he currently
wants the slot, I'll add it unless you guys convince him it's a bad idea...]

-Miles
-- 
`The suburb is an obsolete and contradictory form of human settlement'

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

[Miles Bader]

On Mon, May 17, 2004 at 12:09:32PM -0400, Stefan Monnier wrote:
> Let's only add things we need.  For one I don't believe that we even need
> "curry" as such.  What we need is a cheap&fast way to implement closures.
> "curry" is a way to do that, so it makes sense to add it in the C core.
> "rcurry" provides no such useful functionality and can thus just as well be
> implemented in elisp.  If we later on see that it indeed should deserve
> a more efficient treatment, then we can always put it back in C.

Fair enough; nobody likes rcurry, so I'll take it out.

BTW, this brings back a question you asked in private email a loooong time
ago (which I never answered): why are the two different representations for
compiled and interpreted closures in my lexical-binding implementation.

My (unsent) answer then was because the lexical binding implementations for
the interpreter is `weird', so needs special treatment to implement closures
-- the interpreter depends on funcall &c `resetting' the interpreter's
lexical-binding stack at appropriate times to avoid bindings being visible in
called functions.

My old implementation adds special code to Feval, Ffuncall, etc., to do this,
and when it sees a `closure' special form (instead instead of a `lambda'),
explicitly uses the intepreted closure's environment instead of setting the
interpreter lexical-binding stack to nil.

Working on this closure stuff, I now realize I can get rid of the special
code and instead use a #[] closure that calls a special
`call-interpreted-closure' internal function which just passes its args to
the guts of funcall, bypassing the normal `resetting' mechanism.  Essentially
the same thing, but it gets rid of special-case code in central places like
Ffuncall &c.

-Miles
-- 
"1971 pickup truck; will trade for guns"

Re: User-reserved element in byte code vectors

[David Kastrup]

Miles Bader <miles@gnu.org> writes:

> On Mon, May 17, 2004 at 12:30:05PM -0400, Stefan Monnier wrote:
> > > My idea is that it would say where to fit the new args around the old
> > > args.  For instance, you might want to curry args 2 and 3.  This would
> > > be easy if the first slot has a list saying where the curried args go.
> > > For instance, a list of integers saying which positions to use
> > > the curried args in.
> > 
> > We already have a very simple way to express such things:
> 
> I think the case where using `lambda' becomes annoying is when you have a
> variable-length arglist, which with lambda would require using &rest or
> something, and so do lots of run-time consing.

Without lexical binding, currying a curried function would probably
not work when using the lambda approach (haven't thought this through
in detail, though).

-- 
David Kastrup, Kriemhildstr. 15, 44793 Bochum

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

[Miles Bader]

On Mon, May 17, 2004 at 07:04:34AM -0400, Richard Stallman wrote:
>     ! @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}).
> 
> Is this function really worth having?  Why not use only `funvec'?

Hmmm, I was mostly just following the example of the `vector' type.  It does
seem marginally useful to be able to create a vector-like type without
explicitly specifying all the elements at creation-time, but perhaps for a
special purpose type like funvecs it's not worth the extra overhead.

[In my previous patches, Fmake_funvec was also called by other C functions to
do the basic creation, but has since been supplanted by the `make_funvec' C
function (which has different, somewhat more convenient for C functions,
arguments) in that role.]

My only personal use of funvecs (creating a closure) just calls `curry'.

So I'll take it out, and if there's demand, it can be added back later.

>     ! This function cannot be used to make byte-code functions, even though
>     ! they are a sort of funvec --- to do that, use the
> 
> To say "cannot" is not clear.  What does that mean?  It gets an error?
> You should avoid such usage?

Currently, yes, it does return an error if the KIND argument is not a symbol
(in byte-code objects it's a list); see my additional reply for more about
that.

-Miles
-- 
`To alcohol!  The cause of, and solution to,
 all of life's problems' --Homer J. Simpson

Re: User-reserved element in byte code vectors

[Miles Bader]

David Kastrup <dak@gnu.org> writes:
> Without lexical binding, currying a curried function would probably
> not work when using the lambda approach (haven't thought this through
> in detail, though).

It should, I'd think -- the method suggested for using lambda to do it
is to construct a lambda expression at runtime, e.g.,

   (defun curry (fun &rest args)
       `(lambda (&rest user-args) (apply #',fun ,@args user-args)))

So currying a curried function does work, if rather `consily':

   (curry (curry 'concat "a" "b") "x" "y")
   => (lambda (&rest user-args)
	(apply (function
		(lambda (&rest user-args)
		  (apply (function concat) "a" "b" user-args)))
	       "x" "y" user-args))

   (mapcar (curry (curry 'concat "a" "b") "x" "y") '("p" "q"))
   => ("abxyp" "abxyq")

-Miles
-- 
"Whatever you do will be insignificant, but it is very important that
 you do it."  Mahatma Gandhi

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

[Miles Bader]

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;

Re: User-reserved element in byte code vectors

[Stefan Monnier]

>> > My idea is that it would say where to fit the new args around the old
>> > args.  For instance, you might want to curry args 2 and 3.  This would
>> > be easy if the first slot has a list saying where the curried args go.
>> > For instance, a list of integers saying which positions to use
>> > the curried args in.
>> 
>> We already have a very simple way to express such things:

> I think the case where using `lambda' becomes annoying is when you have a
> variable-length arglist, which with lambda would require using &rest or
> something, and so do lots of run-time consing.

I haven't noticed anybody complain about it until now.  It'll work just
fine, although a bit slower, but a lot of Elisp code is not speed-sensitive
and if you care about speed and don't have rcurry, you can almost always
reorganize your code a bit such that your arguments come in the right order.

> It's probably true that at this point it's over-engineering, but perhaps
> Richard's stance of just leaving a single nil slot available for future
> exploration is reasonable.  A single vector slot is not very expensive.

Not even necessary.  We can easily do

  (defmacro rcurry (f &rest args)
    `(curry rcurry-helper f ,@args))

and make a rcurry-helper subroutine.  And for Richard's permutation of
args, we can also do it that way with curry-reorg auxiliary function.

> On the other hand, I'm not sure it's really better than omitting the slot
> now, and later adding a `super-curry' funvec-kind that has the slot -- code
> that cares about funvec layout would have to be amended to deal with non-nil
> values of the slot anyay, so making it understand `super-curry' isn't much
> different, right?  If Stefan's intuition proves right, and `super-curry'
> never gets added, then it will represent a small savings.

There are many ways to provide the proposed behaviors, but since we haven't
seen them needed, we have no clue which implementation would be best.

I think paying one extra word for each and every closure ever created from
now on, just because of the remote possibility that someone will want
something like rcurry and will want it to be really efficient and that
someone will not prefer some other implementation....
Are you people serious?


        Stefan

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

[Stefan Monnier]

> BTW, this brings back a question you asked in private email a loooong time

Ah, glad to see you *did* receive (and read) it ;-)

> Working on this closure stuff, I now realize I can get rid of the special
> code and instead use a #[] closure that calls a special
> `call-interpreted-closure' internal function which just passes its args to
> the guts of funcall, bypassing the normal `resetting' mechanism.  Essentially
> the same thing, but it gets rid of special-case code in central places like
> Ffuncall &c.

Yes.  Your `curry' objects are extremely flexible indeed.  That's why
I think an extra nil slow for some unlikely special case is
completely unnecessary.


        Stefan

Re: User-reserved element in byte code vectors

[Richard Stallman]

    On the other hand, I'm not sure it's really better than omitting the slot
    now, and later adding a `super-curry' funvec-kind that has the slot -- code
    that cares about funvec layout would have to be amended to deal with non-nil
    values of the slot anyay, so making it understand `super-curry' isn't much
    different, right?

If we add this feature, such funvec objects will probably get written
into files, or otherwise saved.  It would be better to avoid
changing the format incompatibly.

Re: User-reserved element in byte code vectors

[Richard Stallman]

    We already have a very simple way to express such things:

       (curry (lambda (x2 x3 x1 x4) (f x1 x2 x3 x4) arg2 arg3)

The parens don't balance.  Did you mean

       (curry (lambda (x2 x3 x1 x4) (f x1 x2 x3 x4)) arg2 arg3)

I guess you are right that this will do the job.  So maybe the
extension that I had in mind is simply unnecessary.

Still, it is wise to leave room for extension in any data structure
when there is no strong reason not to do so.

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

[Richard Stallman]

    Hmmm, I was mostly just following the example of the `vector' type.  It does
    seem marginally useful to be able to create a vector-like type without
    explicitly specifying all the elements at creation-time, but perhaps for a
    special purpose type like funvecs it's not worth the extra overhead.

It is common to want a vector of variable size without specifying
a list of arguments, but I doubt that is useful for funvecs.

Re: User-reserved element in byte code vectors

[Miles Bader]

On Tue, May 18, 2004 at 10:53:07AM -0400, Richard Stallman wrote:
>     On the other hand, I'm not sure it's really better than omitting the
>     slot now, and later adding a `super-curry' funvec-kind that has the
>     slot -- code that cares about funvec layout would have to be amended to
>     deal with non-nil values of the slot anyay, so making it understand
>     `super-curry' isn't much different, right?
> 
> If we add this feature, such funvec objects will probably get written
> into files, or otherwise saved.  It would be better to avoid
> changing the format incompatibly.

Well, what I meant was that if `super-curry' were later added, we'd support
_both_ -- they could share 99% of the implementation (like rcurry and curry
did [before I took out rcurry :-]).  Presumably in that case, `ordinary' uses
of curry would continue to use the "old" `curry' tag.

-Miles
-- 
.Numeric stability is probably not all that important when you're guessing.

Re: User-reserved element in byte code vectors

[Miles Bader]

On Tue, May 18, 2004 at 09:17:44AM -0400, Stefan Monnier wrote:
> Not even necessary.  We can easily do
> 
>   (defmacro rcurry (f &rest args)
>     `(curry rcurry-helper f ,@args))
> 
> and make a rcurry-helper subroutine.  And for Richard's permutation of
> args, we can also do it that way with curry-reorg auxiliary function.

Hmmm, I think I'm convinced.

There is one little wrinkle though -- by the time something like
`rcurry-helper' gets called, some information has been lost: which args are
from the funvec, and which are user args.

So I think you'd have to explicitly include the dividing point, e.g.:

   (defmacro rcurry (f &rest args)
     `(curry rcurry-helper (length args) f ,@args))

Still, since presumably such cases will be much rarer than typical curry uses
(e.g., closures), I agree that it seems better to pay the small extra cost
there, rather than adding it to every curry.

Since you've got to include the extra slot anyway, you could make it
something more general, e.g., called it `permuted-funcall' instead of
`rcurry-helper', and allow wackiness to ensue. :-)  In either case, it could
be useful for direct use by programmers too, e.g., to cheaply convert from
one argument convention to another, you could make a curry-object that omits
the arguments, but still specifies the `permutation recipe'.

> I think paying one extra word for each and every closure ever created from
> now on, just because of the remote possibility that someone will want
> something like rcurry and will want it to be really efficient and that
> someone will not prefer some other implementation....

Well, OK, I'm now on your side, but it's still Richard's call.

Richard, if you don't care very much though, I'll just take out the reserved
slot; I agree with Stefan that there's ample room for expansion without it,
and that it's better to add a slight extra expense to exceptional cases
rather than to every curry object.

-Miles
-- 
((lambda (x) (list x x)) (lambda (x) (list x x)))

Re: User-reserved element in byte code vectors

[David Kastrup]

Miles Bader <miles@gnu.org> writes:

> On Tue, May 18, 2004 at 09:17:44AM -0400, Stefan Monnier wrote:
> > Not even necessary.  We can easily do
> > 
> >   (defmacro rcurry (f &rest args)
> >     `(curry rcurry-helper f ,@args))
> > 
> > and make a rcurry-helper subroutine.  And for Richard's permutation of
> > args, we can also do it that way with curry-reorg auxiliary function.
> 
> There is one little wrinkle though -- by the time something like
> `rcurry-helper' gets called, some information has been lost: which args are
> from the funvec, and which are user args.
> 
> So I think you'd have to explicitly include the dividing point, e.g.:
> 
>    (defmacro rcurry (f &rest args)
>      `(curry rcurry-helper (length args) f ,@args))

If one does need a helper, one could probably just do

(defmacro rcurry (f &rest args)
  `(curry rcurry-helper f ,args))

-- 
David Kastrup, Kriemhildstr. 15, 44793 Bochum

Re: User-reserved element in byte code vectors

[Miles Bader]

David Kastrup <dak@gnu.org> writes:
> > So I think you'd have to explicitly include the dividing point, e.g.:
> > 
> >    (defmacro rcurry (f &rest args)
> >      `(curry rcurry-helper (length args) f ,@args))
> 
> If one does need a helper, one could probably just do
> 
> (defmacro rcurry (f &rest args)
>   `(curry rcurry-helper f ,args))

Hmmm, I presume you meant:

   (defmacro rcurry (f &rest args)
     `(curry rcurry-helper f (list ,@args)))

But I think given the way the implementation works, just including the
dividing point as an integer would be faster (can use bcopy instead of
list traversal) and consume less space overall (a vector slot for each
arg is cheaper than a cons cell for each).

-Miles
-- 
If you can't beat them, arrange to have them beaten.  [George Carlin]

Re: User-reserved element in byte code vectors

[Kim F. Storm]

Stefan Monnier <monnier@iro.umontreal.ca> writes:

> I think paying one extra word for each and every closure ever created from
> now on, just because of the remote possibility that someone will want
> something like rcurry and will want it to be really efficient and that
> someone will not prefer some other implementation....
> Are you people serious?

I agree with Stefan -- I see no need for that extra slot.

-- 
Kim F. Storm <storm@cua.dk> http://www.cua.dk

Re: User-reserved element in byte code vectors

[Richard Stallman]

    I think paying one extra word for each and every closure ever created from
    now on, just because of the remote possibility that someone will want
    something like rcurry and will want it to be really efficient and that
    someone will not prefer some other implementation....

We're talking about currying--what does that have to do with
closures?  There is some similarity between the two, but I don't
think we want to use `curry' to implement closures.
It seems to me that if we add any facility for closures
we might as well make it a primitive that does precisely closures.

Re: User-reserved element in byte code vectors

[Miles Bader]

On Wed, May 19, 2004 at 09:45:43AM -0400, Richard Stallman wrote:
>     I think paying one extra word for each and every closure ever created
>     from now on, just because of the remote possibility that someone will
>     want something like rcurry and will want it to be really efficient and
>     that someone will not prefer some other implementation....
> 
> We're talking about currying--what does that have to do with
> closures?  There is some similarity between the two, but I don't
> think we want to use `curry' to implement closures.
> It seems to me that if we add any facility for closures
> we might as well make it a primitive that does precisely closures.

For what sort of closures?  This currying implementation originated with the
closures in my lexical-binding implementation -- _after_ I had implemented
the mechanism for doing closures, I realized that it was precisely the same
as the currying operator, and so now I called it that, as that's a more
interesting operation in standard emacs.  But it's the same thing as closures
for me (not just similar, the same).

Do you some sort of closure implementation in mind that's necessarily
different?

-Miles
-- 
The secret to creativity is knowing how to hide your sources.
  --Albert Einstein

Re: User-reserved element in byte code vectors

[Stefan Monnier]

> For what sort of closures?  This currying implementation originated with
> the closures in my lexical-binding implementation -- _after_ I had
> implemented the mechanism for doing closures, I realized that it was
> precisely the same as the currying operator, and so now I called it that,
> as that's a more interesting operation in standard emacs.  But it's the
> same thing as closures for me (not just similar, the same).

I'd be interested to see how you use those `curry' thingies, BTW.
E.g. what does

     (let ((x 0))
       (lambda () (setq x (+ x 1))))

get translated into?

The reason I ask is because a common closure representation is almost the
one you suggested except that instead of

    (funcall #[closure f a1 a2] a3 a4)
      => (f a1 a2 a3 a4)

the reduction rule looks like:

    (funcall #[closure f a1 a2] a3 a4)
      => (f #[closure f a1 a2] a3 a4)

so that the function `f' can modify the vector in order to perform a `setq'
on the free variable.  Of course, the above representation doesn't work
as straightforwardly if the free variable is shared by more than
one closure.


        Stefan

Re: User-reserved element in byte code vectors

[Richard Stallman]

I'm ok with using a helper function if we ever want to
extend the curry feature.  So I no longer say we should
leave a slot empty for extensions.

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

[Miles Bader]

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

Ok, here's a new patch that gets rid of the reserved slot for #[curry]
objects, and does some more minor tweaking (doc tweaks, add some
description to describe-function, etc).

-Miles


Patch:



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

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

	* subr.el (functionp): Use `funvecp' instead of
	`byte-compiled-function-p'.
	* help-fns.el (describe-function-1): Describe curried functions
	and other funvecs as such.
	(help-highlight-arguments): Only format things that look like a
	function.

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

	* objects.texi (Funvec Type): Renamed from `Byte-Code Type'.
	Add description of general funvec objects.
	* functions.texi (What Is a Function): Add entry for funvecs,
	adjust byte-code function entry accordingly.
	(Function Currying): New node.

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

	* lisp.h: Declare make_funvec and Ffunvec.
	(enum pvec_type): Rename `PVEC_COMPILED' to `PVEC_FUNVEC'.
	(XSETFUNVEC): Renamed from `XSETCOMPILED'.
	(FUNVEC_SIZE, FUNVEC_COMPILED_TAG_P, FUNVEC_COMPILED_P): New macros.
	(COMPILEDP): Define in terms of funvec macros.
	(FUNVECP, GC_FUNVECP): Renamed from `COMPILEDP' & `GC_COMPILEDP'.
	(FUNCTIONP): Use FUNVECP instead of COMPILEDP.
	* alloc.c (make_funvec, funvec): New functions.
	(Fmake_byte_code): Make sure the first element is a list.

	* eval.c (Qcurry): New variable.
	(funcall_funvec, Fcurry): New functions.
	(syms_of_eval): Initialize them.
	(funcall_lambda): Handle non-bytecode funvec objects by calling
	funcall_funvec.
	(Ffuncall, Feval): Use FUNVECP insetad of COMPILEDP.
	* lread.c (read1): Return result of read_vector for `#[' syntax
	directly; read_vector now does any extra work required.
	(read_vector): Handle both funvec and byte-code objects, converting the
	type as necessary.  `bytecodeflag' argument is now called
	`read_funvec'.
	* data.c (Ffunvecp): New function.
	* doc.c (Fdocumentation): Return nil for unknown funvecs.
	* fns.c (mapcar1, Felt, concat): Allow funvecs.

	* eval.c (Ffunctionp): Use `funvec' operators instead of `compiled'
	operators.
	* alloc.c (Fmake_byte_code, Fpurecopy, mark_object): Likewise.
	* keyboard.c (Fcommand_execute): Likewise.
	* image.c (parse_image_spec): Likewise.
	* fns.c (Flength, concat, internal_equal): Likewise.
	* data.c (Faref, Ftype_of): Likewise.
	* print.c (print_preprocess, print_object): Likewise.


M  src/eval.c
M  src/image.c
M  etc/NEWS
M  src/data.c
M  lispref/functions.texi
M  src/doc.c
M  src/ChangeLog
M  src/alloc.c
M  src/keyboard.c
M  src/fns.c
M  lispref/vol1.texi
M  lispref/objects.texi
M  lispref/ChangeLog
M  src/lisp.h
M  lisp/help-fns.el
M  src/lread.c
M  src/print.c
M  lispref/vol2.texi
M  lisp/ChangeLog
M  lisp/subr.el
M  lispref/elisp.texi

* modified files

*** orig/etc/NEWS
--- mod/etc/NEWS
***************
*** 3485,3490 ****
--- 3485,3504 ----
  ** Arguments for remove-overlays are now optional, so that you can remove
  all overlays in the buffer by just calling (remove-overlay).
  
+ ** New `function vector' type, including function currying
+ The `function vector', or `funvec' type extends the old
+ byte-compiled-function vector type to have other uses as well, and
+ includes existing byte-compiled functions as a special case.  The kind
+ of funvec is determined by the first element: a list is a byte-compiled
+ function, and a non-nil atom is one of the new extended uses, currently
+ `curry' for curried functions.  See the node `Funvec Type' in the Emacs
+ Lisp Reference Manual for more information.
+ 
+ *** New function curry allows constructing `curried functions'
+ (see the node `Function Currying' in the Emacs Lisp Reference Manual).
+ 
+ *** New functions funvec and funvecp allow primitive access to funvecs
+ 
  ** New packages:
  
  *** The new package gdb-ui.el provides an enhanced graphical interface to


*** orig/lisp/help-fns.el
--- mod/lisp/help-fns.el
***************
*** 267,273 ****
      doc))
  
  (defun help-highlight-arguments (usage doc &rest args)
!   (when usage
      (with-temp-buffer
        (insert usage)
        (goto-char (point-min))
--- 267,273 ----
      doc))
  
  (defun help-highlight-arguments (usage doc &rest args)
!   (when (and usage (string-match "^(" usage))
      (with-temp-buffer
        (insert usage)
        (goto-char (point-min))
***************
*** 309,314 ****
--- 309,321 ----
  		   (concat beg "built-in function")))
  		((byte-code-function-p def)
  		 (concat beg "compiled Lisp function"))
+ 		((and (funvecp def) (eq (aref def 0) 'curry))
+ 		 (if (symbolp (aref def 1))
+ 		     (format "a curried function calling `%s'" (aref def 1))
+ 		   "a curried function"))
+ 		((funvecp def)
+ 		 (format "a function-vector (funvec) of type `%s'"
+ 			 (aref def 0)))
  		((symbolp def)
  		 (while (symbolp (symbol-function def))
  		   (setq def (symbol-function def)))
***************
*** 428,436 ****
                          ((or (stringp def)
                               (vectorp def))
                           (format "\nMacro: %s" (format-kbd-macro def)))
                          (t "[Missing arglist.  Please make a bug report.]")))
                   (high (help-highlight-arguments use doc)))
!             (insert (car high) "\n")
              (setq doc (cdr high))))
          (let ((obsolete (and
                           ;; function might be a lambda construct.
--- 435,459 ----
                          ((or (stringp def)
                               (vectorp def))
                           (format "\nMacro: %s" (format-kbd-macro def)))
+ 			((and (funvecp def) (eq (aref def 0) 'curry))
+ 			 ;; Describe a curried-function's function and args
+ 			 (let ((slot 0))
+ 			   (mapconcat (lambda (arg)
+ 					(setq slot (1+ slot))
+ 					(cond
+ 					 ((= slot 1) "")
+ 					 ((= slot 2)
+ 					  (format "  Function: %S" arg))
+ 					 (t
+ 					  (format "Argument %d: %S"
+ 						  (- slot 3) arg))))
+ 				      def
+ 				      "\n")))
+ 			((funvecp def) nil)
                          (t "[Missing arglist.  Please make a bug report.]")))
                   (high (help-highlight-arguments use doc)))
! 	    (when (car high)
! 	      (insert (car high) "\n"))
              (setq doc (cdr high))))
          (let ((obsolete (and
                           ;; function might be a lambda construct.


*** orig/lisp/subr.el
--- mod/lisp/subr.el
***************
*** 2313,2319 ****
  	     (error nil))
  	   (eq (car-safe object) 'autoload)
  	   (not (car-safe (cdr-safe (cdr-safe (cdr-safe (cdr-safe object)))))))
!       (subrp object) (byte-code-function-p object)
        (eq (car-safe object) 'lambda)))
  
  (defun assq-delete-all (key alist)
--- 2313,2320 ----
  	     (error nil))
  	   (eq (car-safe object) 'autoload)
  	   (not (car-safe (cdr-safe (cdr-safe (cdr-safe (cdr-safe object)))))))
!       (subrp object)
!       (funvecp object)
        (eq (car-safe object) 'lambda)))
  
  (defun assq-delete-all (key alist)


*** orig/lispref/elisp.texi
--- mod/lispref/elisp.texi
***************
*** 236,242 ****
  * Macro Type::          A method of expanding an expression into another
                            expression, more fundamental but less pretty.
  * Primitive Function Type::     A function written in C, callable from Lisp.
! * Byte-Code Type::      A function written in Lisp, then compiled.
  * Autoload Type::       A type used for automatically loading seldom-used
                            functions.
  
--- 236,242 ----
  * Macro Type::          A method of expanding an expression into another
                            expression, more fundamental but less pretty.
  * Primitive Function Type::     A function written in C, callable from Lisp.
! * Funvec Type::         A vector type callable as a function.
  * Autoload Type::       A type used for automatically loading seldom-used
                            functions.
  
***************
*** 386,403 ****
  
  Functions
  
! * What Is a Function::      Lisp functions vs primitives; terminology.
  * Lambda Expressions::      How functions are expressed as Lisp objects.
  * Function Names::          A symbol can serve as the name of a function.
  * Defining Functions::      Lisp expressions for defining functions.
  * Calling Functions::       How to use an existing function.
  * Mapping Functions::       Applying a function to each element of a list, etc.
! * Anonymous Functions::     Lambda-expressions are functions with no names.
  * Function Cells::          Accessing or setting the function definition
                                of a symbol.
  * Related Topics::          Cross-references to specific Lisp primitives
!                               that have a special bearing on how
!                               functions work.
  
  Lambda Expressions
  
--- 386,406 ----
  
  Functions
  
! * What Is a Function::      Lisp functions vs. primitives; terminology.
  * Lambda Expressions::      How functions are expressed as Lisp objects.
  * Function Names::          A symbol can serve as the name of a function.
  * Defining Functions::      Lisp expressions for defining functions.
  * Calling Functions::       How to use an existing function.
  * Mapping Functions::       Applying a function to each element of a list, etc.
! * Anonymous Functions::     Lambda expressions are functions with no names.
  * Function Cells::          Accessing or setting the function definition
                                of a symbol.
+ * Inline Functions::        Defining functions that the compiler will open code.
+ * Function Currying::       Making wrapper functions that pre-specify
+                               some arguments.
+ * Function Safety::         Determining whether a function is safe to call.
  * Related Topics::          Cross-references to specific Lisp primitives
!                               that have a special bearing on how functions work.
  
  Lambda Expressions
  


*** orig/lispref/functions.texi
--- mod/lispref/functions.texi
***************
*** 1,6 ****
  @c -*-texinfo-*-
  @c This is part of the GNU Emacs Lisp Reference Manual.
! @c Copyright (C) 1990, 1991, 1992, 1993, 1994, 1995, 1998, 1999
  @c   Free Software Foundation, Inc.
  @c See the file elisp.texi for copying conditions.
  @setfilename ../info/functions
--- 1,6 ----
  @c -*-texinfo-*-
  @c This is part of the GNU Emacs Lisp Reference Manual.
! @c Copyright (C) 1990, 1991, 1992, 1993, 1994, 1995, 1998, 1999, 2004
  @c   Free Software Foundation, Inc.
  @c See the file elisp.texi for copying conditions.
  @setfilename ../info/functions
***************
*** 21,27 ****
  * Anonymous Functions::   Lambda expressions are functions with no names.
  * Function Cells::        Accessing or setting the function definition
                              of a symbol.
! * Inline Functions::	  Defining functions that the compiler will open code.
  * Function Safety::       Determining whether a function is safe to call.
  * Related Topics::        Cross-references to specific Lisp primitives
                              that have a special bearing on how functions work.
--- 21,29 ----
  * Anonymous Functions::   Lambda expressions are functions with no names.
  * Function Cells::        Accessing or setting the function definition
                              of a symbol.
! * Inline Functions::      Defining functions that the compiler will open code.
! * Function Currying::     Making wrapper functions that pre-specify
!                             some arguments.
  * Function Safety::       Determining whether a function is safe to call.
  * Related Topics::        Cross-references to specific Lisp primitives
                              that have a special bearing on how functions work.
***************
*** 109,115 ****
  
  @item byte-code function
  A @dfn{byte-code function} is a function that has been compiled by the
! byte compiler.  @xref{Byte-Code Type}.
  @end table
  
  @defun functionp object
--- 111,135 ----
  
  @item byte-code function
  A @dfn{byte-code function} is a function that has been compiled by the
! byte compiler.  A byte-code function is actually a special case of a
! @dfn{funvec} object (see below).
! 
! @item function vector
! A @dfn{function vector}, or @dfn{funvec} is a vector-like object whose
! purpose is to define special kinds of functions.  @xref{Funvec Type}.
! 
! The exact meaning of the vector elements is determined by the type of
! funvec: the most common use is byte-code functions, which have a
! list---the argument list---as the first element.  Further types of
! funvec object are:
! 
! @table @code
! @item curry
! A curried function.  Remaining arguments in the funvec are function to
! call, and arguments to prepend to user arguments at the time of the
! call; @xref{Function Currying}.
! @end table
! 
  @end table
  
  @defun functionp object
***************
*** 150,155 ****
--- 170,180 ----
  @end example
  @end defun
  
+ @defun funvecp object
+ @code{funvecp} returns @code{t} if @var{object} is a function vector
+ object (including byte-code objects), and @code{nil} otherwise.
+ @end defun
+ 
  @defun subr-arity subr
  @tindex subr-arity
  This function provides information about the argument list of a
***************
*** 1197,1202 ****
--- 1222,1270 ----
  Inline functions can be used and open-coded later on in the same file,
  following the definition, just like macros.
  
+ @node Function Currying
+ @section Function Currying
+ @cindex function currying
+ @cindex currying
+ @cindex partial-application
+ 
+ Function currying is a way to make a new function that calls an
+ existing function with a partially pre-determined argument list.
+ 
+ @defun curry function &rest args
+ Return a function-like object that will append any arguments it is
+ called with to @var{args}, and call @var{function} with the resulting
+ list of arguments.
+ 
+ For example, @code{(curry 'concat "The ")} returns a function that
+ concatenates @code{"The "} and its arguments.  Calling this function
+ on @code{"end"} returns @code{"The end"}:
+ 
+ @example
+ (funcall (curry 'concat "The ") "end")
+      @result{} "The end"
+ @end example
+ 
+ The @dfn{curried function} is useful as an argument to @code{mapcar}:
+ 
+ @example
+ (mapcar (curry 'concat "The ") '("big" "red" "balloon"))
+      @result{} ("The big" "The red" "The balloon")
+ @end example
+ @end defun
+ 
+ Function currying may be implemented in any Lisp by constructing a
+ @code{lambda} expression, for instance:
+ 
+ @example
+ (defun curry (function &rest args)
+   `(lambda (&rest call-args)
+       (apply #',function ,@@args call-args)))
+ @end example
+ 
+ However in Emacs Lisp, a special curried function object is used for
+ efficiency.  @xref{Funvec Type}.
+ 
  @node Function Safety
  @section Determining whether a function is safe to call
  @cindex function safety


*** orig/lispref/objects.texi
--- mod/lispref/objects.texi
***************
*** 1,6 ****
  @c -*-texinfo-*-
  @c This is part of the GNU Emacs Lisp Reference Manual.
! @c Copyright (C) 1990, 1991, 1992, 1993, 1994, 1995, 1998, 1999, 2003
  @c   Free Software Foundation, Inc.
  @c See the file elisp.texi for copying conditions.
  @setfilename ../info/objects
--- 1,6 ----
  @c -*-texinfo-*-
  @c This is part of the GNU Emacs Lisp Reference Manual.
! @c Copyright (C) 1990, 1991, 1992, 1993, 1994, 1995, 1998, 1999, 2003, 2004
  @c   Free Software Foundation, Inc.
  @c See the file elisp.texi for copying conditions.
  @setfilename ../info/objects
***************
*** 155,161 ****
  * Macro Type::          A method of expanding an expression into another
                            expression, more fundamental but less pretty.
  * Primitive Function Type::     A function written in C, callable from Lisp.
! * Byte-Code Type::      A function written in Lisp, then compiled.
  * Autoload Type::       A type used for automatically loading seldom-used
                          functions.
  @end menu
--- 155,161 ----
  * Macro Type::          A method of expanding an expression into another
                            expression, more fundamental but less pretty.
  * Primitive Function Type::     A function written in C, callable from Lisp.
! * Funvec Type::         A vector type callable as a function.
  * Autoload Type::       A type used for automatically loading seldom-used
                          functions.
  @end menu
***************
*** 1200,1217 ****
  @end group
  @end example
  
! @node Byte-Code Type
! @subsection Byte-Code Function Type
  
! The byte compiler produces @dfn{byte-code function objects}.
! Internally, a byte-code function object is much like a vector; however,
! the evaluator handles this data type specially when it appears as a
! function to be called.  @xref{Byte Compilation}, for information about
! the byte compiler.
! 
! The printed representation and read syntax for a byte-code function
! object is like that for a vector, with an additional @samp{#} before the
! opening @samp{[}.
  
  @node Autoload Type
  @subsection Autoload Type
--- 1200,1254 ----
  @end group
  @end example
  
! @node Funvec Type
! @subsection ``Function Vector' Type
! @cindex function vector
! @cindex funvec
! 
! A @dfn{function vector}, or @dfn{funvec} is a vector-like object whose
! purpose is to define special kinds of functions.  You can examine or
! modify the contents of a funvec like a normal vector, using the
! @code{aref} and @code{aset} functions.
! 
! The behavior of a funvec when called is dependent on the kind of
! funvec it is, and that is determined by its first element (a
! zero-length funvec will signal an error if called):
! 
! @table @asis
! @item A list
! A funvec with a list as its first element is a byte-compiled function,
! produced by the byte compiler; such funvecs are known as
! @dfn{byte-code function objects}.  @xref{Byte Compilation}, for
! information about the byte compiler.
! 
! @item The symbol @code{curry}
! A funvec with @code{curry} as its first element is a ``curried function''.
! 
! The second element in such a funvec is the function which is
! being curried, and the remaining elements are a list of arguments.
! 
! Calling such a funvec operates by calling the embedded function with
! an argument list composed of the arguments in the funvec followed by
! the arguments the funvec was called with.  @xref{Function Currying}.
! @end table
! 
! The printed representation and read syntax for a funvec object is like
! that for a vector, with an additional @samp{#} before the opening
! @samp{[}.
! 
! @defun funvecp object
! @code{funvecp} returns @code{t} if @var{object} is a function vector
! object (including byte-code objects), and @code{nil} otherwise.
! @end defun
  
! @defun funvec kind &rest params
! @code{funvec} returns a new function vector containing @var{kind} and
! @var{params}.  @var{kind} determines the type of funvec; it should be
! one of the choices listed in the table above.
! 
! Typically you should use the @code{make-byte-code} function to create
! byte-code objects, though they are a type of funvec.
! @end defun
  
  @node Autoload Type
  @subsection Autoload Type
***************
*** 1626,1632 ****
  @xref{Buffer Basics, bufferp}.
  
  @item byte-code-function-p
! @xref{Byte-Code Type, byte-code-function-p}.
  
  @item case-table-p
  @xref{Case Tables, case-table-p}.
--- 1663,1669 ----
  @xref{Buffer Basics, bufferp}.
  
  @item byte-code-function-p
! @xref{Funvec Type, byte-code-function-p}.
  
  @item case-table-p
  @xref{Case Tables, case-table-p}.


*** orig/lispref/vol1.texi
--- mod/lispref/vol1.texi
***************
*** 326,332 ****
  * Macro Type::          A method of expanding an expression into another
                            expression, more fundamental but less pretty.
  * Primitive Function Type::     A function written in C, callable from Lisp.
! * Byte-Code Type::      A function written in Lisp, then compiled.
  * Autoload Type::       A type used for automatically loading seldom-used
                          functions.
  
--- 326,332 ----
  * Macro Type::          A method of expanding an expression into another
                            expression, more fundamental but less pretty.
  * Primitive Function Type::     A function written in C, callable from Lisp.
! * Funvec Type::         A vector type callable as a function.
  * Autoload Type::       A type used for automatically loading seldom-used
                          functions.
  


*** orig/lispref/vol2.texi
--- mod/lispref/vol2.texi
***************
*** 327,333 ****
  * Macro Type::          A method of expanding an expression into another
                            expression, more fundamental but less pretty.
  * Primitive Function Type::     A function written in C, callable from Lisp.
! * Byte-Code Type::      A function written in Lisp, then compiled.
  * Autoload Type::       A type used for automatically loading seldom-used
                          functions.
  
--- 327,333 ----
  * Macro Type::          A method of expanding an expression into another
                            expression, more fundamental but less pretty.
  * Primitive Function Type::     A function written in C, callable from Lisp.
! * Funvec Type::         A vector type callable as a function.
  * Autoload Type::       A type used for automatically loading seldom-used
                          functions.
  


*** orig/src/alloc.c
--- mod/src/alloc.c
***************
*** 2643,2648 ****
--- 2643,2680 ----
  }
  
  
+ /* Return a new `function vector' containing KIND as the first element,
+    followed by NUM_NIL_SLOTS nil elements, and further elements copied from
+    the vector PARAMS of length NUM_PARAMS (so the total length of the
+    resulting vector is 1 + NUM_NIL_SLOTS + NUM_PARAMS).
+ 
+    If NUM_PARAMS is zero, then PARAMS may be NULL.
+ 
+    A `function vector', a.k.a. `funvec', is a funcallable vector in Emacs Lisp.
+    See the function `funvec' for more detail.  */
+ 
+ Lisp_Object
+ make_funvec (kind, num_nil_slots, num_params, params)
+      Lisp_Object kind;
+      int num_nil_slots, num_params;
+      Lisp_Object *params;
+ {
+   int param_index;
+   Lisp_Object funvec;
+ 
+   funvec = Fmake_vector (make_number (1 + num_nil_slots + num_params), Qnil);
+ 
+   ASET (funvec, 0, kind);
+ 
+   for (param_index = 0; param_index < num_params; param_index++)
+     ASET (funvec, 1 + num_nil_slots + param_index, params[param_index]);
+ 
+   XSETFUNVEC (funvec, XVECTOR (funvec));
+ 
+   return funvec;
+ }
+ 
+ 
  DEFUN ("make-char-table", Fmake_char_table, Smake_char_table, 1, 2, 0,
         doc: /* Return a newly created char-table, with purpose PURPOSE.
  Each element is initialized to INIT, which defaults to nil.
***************
*** 2707,2712 ****
--- 2739,2767 ----
  }
  
  
+ DEFUN ("funvec", Ffunvec, Sfunvec, 1, MANY, 0,
+        doc: /* Return a newly created `function vector' of type KIND.
+ A `function vector', a.k.a. `funvec', is a funcallable vector in Emacs Lisp.
+ KIND indicates the kind of funvec, and determines its behavior when called.
+ The meaning of the remaining arguments depends on KIND.  Currently
+ implemented values of KIND, and their meaning, are:
+ 
+    A list  -- A byte-compiled function.  See `make-byte-code' for the usual
+               way to create byte-compiled functions.
+ 
+    `curry' -- A curried function.  Remaining arguments are a function to
+               call, and arguments to prepend to user arguments at the
+               time of the call; see the `curry' function.
+ 
+ usage: (funvec KIND &rest PARAMS)  */)
+      (nargs, args)
+      register int nargs;
+      Lisp_Object *args;
+ {
+   return make_funvec (args[0], 0, nargs - 1, args + 1);
+ }
+ 
+ 
  DEFUN ("make-byte-code", Fmake_byte_code, Smake_byte_code, 4, MANY, 0,
         doc: /* Create a byte-code object with specified arguments as elements.
  The arguments should be the arglist, bytecode-string, constant vector,
***************
*** 2722,2727 ****
--- 2777,2786 ----
    register int index;
    register struct Lisp_Vector *p;
  
+   /* Make sure the arg-list is really a list, as that's what's used to
+      distinguish a byte-compiled object from other funvecs.  */
+   CHECK_LIST (args[0]);
+ 
    XSETFASTINT (len, nargs);
    if (!NILP (Vpurify_flag))
      val = make_pure_vector ((EMACS_INT) nargs);
***************
*** 2743,2749 ****
  	args[index] = Fpurecopy (args[index]);
        p->contents[index] = args[index];
      }
!   XSETCOMPILED (val, p);
    return val;
  }
  
--- 2802,2808 ----
  	args[index] = Fpurecopy (args[index]);
        p->contents[index] = args[index];
      }
!   XSETFUNVEC (val, p);
    return val;
  }
  
***************
*** 4228,4234 ****
      return make_pure_string (SDATA (obj), SCHARS (obj),
  			     SBYTES (obj),
  			     STRING_MULTIBYTE (obj));
!   else if (COMPILEDP (obj) || VECTORP (obj))
      {
        register struct Lisp_Vector *vec;
        register int i;
--- 4287,4293 ----
      return make_pure_string (SDATA (obj), SCHARS (obj),
  			     SBYTES (obj),
  			     STRING_MULTIBYTE (obj));
!   else if (FUNVECP (obj) || VECTORP (obj))
      {
        register struct Lisp_Vector *vec;
        register int i;
***************
*** 4240,4247 ****
        vec = XVECTOR (make_pure_vector (size));
        for (i = 0; i < size; i++)
  	vec->contents[i] = Fpurecopy (XVECTOR (obj)->contents[i]);
!       if (COMPILEDP (obj))
! 	XSETCOMPILED (obj, vec);
        else
  	XSETVECTOR (obj, vec);
        return obj;
--- 4299,4306 ----
        vec = XVECTOR (make_pure_vector (size));
        for (i = 0; i < size; i++)
  	vec->contents[i] = Fpurecopy (XVECTOR (obj)->contents[i]);
!       if (FUNVECP (obj))
! 	XSETFUNVEC (obj, vec);
        else
  	XSETVECTOR (obj, vec);
        return obj;
***************
*** 4799,4805 ****
  	}
        else if (GC_SUBRP (obj))
  	break;
!       else if (GC_COMPILEDP (obj))
  	/* We could treat this just like a vector, but it is better to
  	   save the COMPILED_CONSTANTS element for last and avoid
  	   recursion there.  */
--- 4858,4864 ----
  	}
        else if (GC_SUBRP (obj))
  	break;
!       else if (GC_FUNVECP (obj) && FUNVEC_COMPILED_P (obj))
  	/* We could treat this just like a vector, but it is better to
  	   save the COMPILED_CONSTANTS element for last and avoid
  	   recursion there.  */
***************
*** 5758,5763 ****
--- 5817,5823 ----
    defsubr (&Scons);
    defsubr (&Slist);
    defsubr (&Svector);
+   defsubr (&Sfunvec);
    defsubr (&Smake_byte_code);
    defsubr (&Smake_list);
    defsubr (&Smake_vector);


*** orig/src/data.c
--- mod/src/data.c
***************
*** 92,98 ****
  static Lisp_Object Qsymbol, Qstring, Qcons, Qmarker, Qoverlay;
  static Lisp_Object Qfloat, Qwindow_configuration, Qwindow;
  Lisp_Object Qprocess;
! static Lisp_Object Qcompiled_function, Qbuffer, Qframe, Qvector;
  static Lisp_Object Qchar_table, Qbool_vector, Qhash_table;
  static Lisp_Object Qsubrp, Qmany, Qunevalled;
  
--- 92,98 ----
  static Lisp_Object Qsymbol, Qstring, Qcons, Qmarker, Qoverlay;
  static Lisp_Object Qfloat, Qwindow_configuration, Qwindow;
  Lisp_Object Qprocess;
! static Lisp_Object Qcompiled_function, Qfunction_vector, Qbuffer, Qframe, Qvector;
  static Lisp_Object Qchar_table, Qbool_vector, Qhash_table;
  static Lisp_Object Qsubrp, Qmany, Qunevalled;
  
***************
*** 231,238 ****
  	return Qwindow;
        if (GC_SUBRP (object))
  	return Qsubr;
!       if (GC_COMPILEDP (object))
! 	return Qcompiled_function;
        if (GC_BUFFERP (object))
  	return Qbuffer;
        if (GC_CHAR_TABLE_P (object))
--- 231,241 ----
  	return Qwindow;
        if (GC_SUBRP (object))
  	return Qsubr;
!       if (GC_FUNVECP (object))
! 	if (FUNVEC_COMPILED_P (object))
! 	  return Qcompiled_function;
! 	else
! 	  return Qfunction_vector;
        if (GC_BUFFERP (object))
  	return Qbuffer;
        if (GC_CHAR_TABLE_P (object))
***************
*** 444,449 ****
--- 447,460 ----
    return Qnil;
  }
  
+ DEFUN ("funvecp", Ffunvecp, Sfunvecp, 1, 1, 0,
+        doc: /* Return t if OBJECT is a `function vector' object.  */)
+      (object)
+      Lisp_Object object;
+ {
+   return FUNVECP (object) ? Qt : Qnil;
+ }
+ 
  DEFUN ("char-or-string-p", Fchar_or_string_p, Schar_or_string_p, 1, 1, 0,
         doc: /* Return t if OBJECT is a character (an integer) or a string.  */)
       (object)
***************
*** 2040,2054 ****
      {
        int size = 0;
        if (VECTORP (array))
! 	size = XVECTOR (array)->size;
!       else if (COMPILEDP (array))
! 	size = XVECTOR (array)->size & PSEUDOVECTOR_SIZE_MASK;
        else
  	wrong_type_argument (Qarrayp, array);
  
        if (idxval < 0 || idxval >= size)
  	args_out_of_range (array, idx);
!       return XVECTOR (array)->contents[idxval];
      }
  }
  
--- 2051,2065 ----
      {
        int size = 0;
        if (VECTORP (array))
! 	size = ASIZE (array);
!       else if (FUNVECP (array))
! 	size = FUNVEC_SIZE (array);
        else
  	wrong_type_argument (Qarrayp, array);
  
        if (idxval < 0 || idxval >= size)
  	args_out_of_range (array, idx);
!       return AREF (array, idxval);
      }
  }
  
***************
*** 3221,3226 ****
--- 3232,3238 ----
    Qwindow = intern ("window");
    /* Qsubr = intern ("subr"); */
    Qcompiled_function = intern ("compiled-function");
+   Qfunction_vector = intern ("function-vector");
    Qbuffer = intern ("buffer");
    Qframe = intern ("frame");
    Qvector = intern ("vector");
***************
*** 3240,3245 ****
--- 3252,3258 ----
    staticpro (&Qwindow);
    /* staticpro (&Qsubr); */
    staticpro (&Qcompiled_function);
+   staticpro (&Qfunction_vector);
    staticpro (&Qbuffer);
    staticpro (&Qframe);
    staticpro (&Qvector);
***************
*** 3276,3281 ****
--- 3289,3295 ----
    defsubr (&Smarkerp);
    defsubr (&Ssubrp);
    defsubr (&Sbyte_code_function_p);
+   defsubr (&Sfunvecp);
    defsubr (&Schar_or_string_p);
    defsubr (&Scar);
    defsubr (&Scdr);


*** orig/src/doc.c
--- mod/src/doc.c
***************
*** 404,409 ****
--- 404,414 ----
        else
  	return Qnil;
      }
+   else if (FUNVECP (fun))
+     {
+       /* Unless otherwise handled, funvecs have no documentation.  */
+       return Qnil;
+     }
    else if (STRINGP (fun) || VECTORP (fun))
      {
        return build_string ("Keyboard macro.");


*** orig/src/eval.c
--- mod/src/eval.c
***************
*** 93,98 ****
--- 93,99 ----
  Lisp_Object Qand_rest, Qand_optional;
  Lisp_Object Qdebug_on_error;
  Lisp_Object Qdeclare;
+ Lisp_Object Qcurry;
  
  /* This holds either the symbol `run-hooks' or nil.
     It is nil at an early stage of startup, and when Emacs
***************
*** 2116,2122 ****
  	  abort ();
  	}
      }
!   if (COMPILEDP (fun))
      val = apply_lambda (fun, original_args, 1);
    else
      {
--- 2117,2123 ----
  	  abort ();
  	}
      }
!   if (FUNVECP (fun))
      val = apply_lambda (fun, original_args, 1);
    else
      {
***************
*** 2770,2776 ****
  	  abort ();
  	}
      }
!   if (COMPILEDP (fun))
      val = funcall_lambda (fun, numargs, args + 1);
    else
      {
--- 2771,2778 ----
  	  abort ();
  	}
      }
! 
!   if (FUNVECP (fun))
      val = funcall_lambda (fun, numargs, args + 1);
    else
      {
***************
*** 2842,2847 ****
--- 2844,2900 ----
    return tem;
  }
  
+ 
+ /* Call a non-bytecode funvec object FUN, on the argments in ARGS (of
+    length NARGS).  */
+ 
+ static Lisp_Object
+ funcall_funvec (fun, nargs, args)
+      Lisp_Object fun;
+      int nargs;
+      Lisp_Object *args;
+ {
+   int size = FUNVEC_SIZE (fun);
+   Lisp_Object tag = (size > 0 ? AREF (fun, 0) : Qnil);
+ 
+   if (EQ (tag, Qcurry))
+     {
+       /* A curried function is a way to attach arguments to a another
+ 	 function. The first element of the vector is the identifier
+ 	 `curry', the second is the wrapped function, and remaining
+ 	 elements are the attached arguments.  */
+       int num_curried_args = size - 2;
+       /* Offset of the curried and user args in the final arglist.  Curried
+ 	 args are first in the new arg vector, after the function.  User
+ 	 args follow.  */
+       int curried_args_offs = 1;
+       int user_args_offs = curried_args_offs + num_curried_args;
+       /* The curried function and arguments.  */
+       Lisp_Object *curry_params = XVECTOR (fun)->contents + 1;
+       /* The arguments in the curry vector.  */
+       Lisp_Object *curried_args = curry_params + 1;
+       /* The number of arguments with which we'll call funcall, and the
+ 	 arguments themselves.  */
+       int num_funcall_args = 1 + num_curried_args + nargs;
+       Lisp_Object *funcall_args
+ 	= (Lisp_Object *) alloca (num_funcall_args * sizeof (Lisp_Object));
+ 
+       /* First comes the real function.  */
+       funcall_args[0] = curry_params[0];
+ 
+       /* Then the arguments in the appropriate order.  */
+       bcopy (curried_args, funcall_args + curried_args_offs,
+ 	     num_curried_args * sizeof (Lisp_Object));
+       bcopy (args, funcall_args + user_args_offs,
+ 	     nargs * sizeof (Lisp_Object));
+ 
+       return Ffuncall (num_funcall_args, funcall_args);
+     }
+   else
+     return Fsignal (Qinvalid_function, Fcons (fun, Qnil));
+ }
+ 
+ 
  /* Apply a Lisp function FUN to the NARGS evaluated arguments in ARG_VECTOR
     and return the result of evaluation.
     FUN must be either a lambda-expression or a compiled-code object.  */
***************
*** 2856,2861 ****
--- 2909,2919 ----
    int count = SPECPDL_INDEX ();
    int i, optional, rest;
  
+   if (FUNVECP (fun) && !FUNVEC_COMPILED_P (fun))
+     /* Byte-compiled functions are handled directly below, but we
+        call other funvec types via funcall_funvec.  */
+     return funcall_funvec (fun, nargs, arg_vector);
+ 
    if (CONSP (fun))
      {
        syms_left = XCDR (fun);
***************
*** 3123,3128 ****
--- 3181,3207 ----
    return value;
  }
  \f
+ 
+ DEFUN ("curry", Fcurry, Scurry, 1, MANY, 0,
+        doc: /* Return FUN curried with ARGS.
+ The result is a function-like object that will append any arguments it
+ is called with to ARGS, and call FUN with the resulting list of arguments.
+ 
+ For instance:
+   (funcall (curry '+ 3 4 5) 2) is the same as (funcall '+ 3 4 5 2)
+ and:
+   (mapcar (curry 'concat "The ") '("a" "b" "c"))
+   => ("The a" "The b" "The c")
+ 
+ usage: (curry FUN &rest ARGS)  */)
+      (nargs, args)
+      register int nargs;
+      Lisp_Object *args;
+ {
+   return make_funvec (Qcurry, 0, nargs, args);
+ }
+ \f
+ 
  DEFUN ("backtrace-debug", Fbacktrace_debug, Sbacktrace_debug, 2, 2, 0,
         doc: /* Set the debug-on-exit flag of eval frame LEVEL levels down to FLAG.
  The debugger is entered when that frame exits, if the flag is non-nil.  */)
***************
*** 3313,3318 ****
--- 3392,3400 ----
    Qand_optional = intern ("&optional");
    staticpro (&Qand_optional);
  
+   Qcurry = intern ("curry");
+   staticpro (&Qcurry);
+ 
    DEFVAR_LISP ("stack-trace-on-error", &Vstack_trace_on_error,
  	       doc: /* *Non-nil means errors display a backtrace buffer.
  More precisely, this happens for any error that is handled
***************
*** 3430,3435 ****
--- 3512,3518 ----
    defsubr (&Srun_hook_with_args_until_success);
    defsubr (&Srun_hook_with_args_until_failure);
    defsubr (&Sfetch_bytecode);
+   defsubr (&Scurry);
    defsubr (&Sbacktrace_debug);
    defsubr (&Sbacktrace);
    defsubr (&Sbacktrace_frame);


*** orig/src/fns.c
--- mod/src/fns.c
***************
*** 152,159 ****
      XSETFASTINT (val, MAX_CHAR);
    else if (BOOL_VECTOR_P (sequence))
      XSETFASTINT (val, XBOOL_VECTOR (sequence)->size);
!   else if (COMPILEDP (sequence))
!     XSETFASTINT (val, XVECTOR (sequence)->size & PSEUDOVECTOR_SIZE_MASK);
    else if (CONSP (sequence))
      {
        i = 0;
--- 152,159 ----
      XSETFASTINT (val, MAX_CHAR);
    else if (BOOL_VECTOR_P (sequence))
      XSETFASTINT (val, XBOOL_VECTOR (sequence)->size);
!   else if (FUNVECP (sequence))
!     XSETFASTINT (val, FUNVEC_SIZE (sequence));
    else if (CONSP (sequence))
      {
        i = 0;
***************
*** 579,585 ****
      {
        this = args[argnum];
        if (!(CONSP (this) || NILP (this) || VECTORP (this) || STRINGP (this)
! 	    || COMPILEDP (this) || BOOL_VECTOR_P (this)))
  	{
  	    args[argnum] = wrong_type_argument (Qsequencep, this);
  	}
--- 579,585 ----
      {
        this = args[argnum];
        if (!(CONSP (this) || NILP (this) || VECTORP (this) || STRINGP (this)
! 	    || FUNVECP (this) || BOOL_VECTOR_P (this)))
  	{
  	    args[argnum] = wrong_type_argument (Qsequencep, this);
  	}
***************
*** 605,611 ****
  	  Lisp_Object ch;
  	  int this_len_byte;
  
! 	  if (VECTORP (this))
  	    for (i = 0; i < len; i++)
  	      {
  		ch = XVECTOR (this)->contents[i];
--- 605,611 ----
  	  Lisp_Object ch;
  	  int this_len_byte;
  
! 	  if (VECTORP (this) || FUNVECP (this))
  	    for (i = 0; i < len; i++)
  	      {
  		ch = XVECTOR (this)->contents[i];
***************
*** 1408,1414 ****
      {
        if (CONSP (sequence) || NILP (sequence))
  	return Fcar (Fnthcdr (n, sequence));
!       else if (STRINGP (sequence) || VECTORP (sequence)
  	       || BOOL_VECTOR_P (sequence) || CHAR_TABLE_P (sequence))
  	return Faref (sequence, n);
        else
--- 1408,1414 ----
      {
        if (CONSP (sequence) || NILP (sequence))
  	return Fcar (Fnthcdr (n, sequence));
!       else if (STRINGP (sequence) || VECTORP (sequence) || FUNVECP (sequence)
  	       || BOOL_VECTOR_P (sequence) || CHAR_TABLE_P (sequence))
  	return Faref (sequence, n);
        else
***************
*** 2225,2235 ****
  	if (WINDOW_CONFIGURATIONP (o1))
  	  return compare_window_configurations (o1, o2, 0);
  
! 	/* Aside from them, only true vectors, char-tables, and compiled
! 	   functions are sensible to compare, so eliminate the others now.  */
  	if (size & PSEUDOVECTOR_FLAG)
  	  {
! 	    if (!(size & (PVEC_COMPILED | PVEC_CHAR_TABLE)))
  	      return 0;
  	    size &= PSEUDOVECTOR_SIZE_MASK;
  	  }
--- 2225,2235 ----
  	if (WINDOW_CONFIGURATIONP (o1))
  	  return compare_window_configurations (o1, o2, 0);
  
! 	/* Aside from them, only true vectors, char-tables, and function
! 	   vectors are sensible to compare, so eliminate the others now.  */
  	if (size & PSEUDOVECTOR_FLAG)
  	  {
! 	    if (!(size & (PVEC_FUNVEC | PVEC_CHAR_TABLE)))
  	      return 0;
  	    size &= PSEUDOVECTOR_SIZE_MASK;
  	  }
***************
*** 2912,2918 ****
    /* We need not explicitly protect `tail' because it is used only on lists, and
      1) lists are not relocated and 2) the list is marked via `seq' so will not be freed */
  
!   if (VECTORP (seq))
      {
        for (i = 0; i < leni; i++)
  	{
--- 2912,2918 ----
    /* We need not explicitly protect `tail' because it is used only on lists, and
      1) lists are not relocated and 2) the list is marked via `seq' so will not be freed */
  
!   if (VECTORP (seq) || FUNVECP (seq))
      {
        for (i = 0; i < leni; i++)
  	{


*** orig/src/image.c
--- mod/src/image.c
***************
*** 875,881 ****
  	case IMAGE_FUNCTION_VALUE:
  	  value = indirect_function (value);
  	  if (SUBRP (value)
! 	      || COMPILEDP (value)
  	      || (CONSP (value) && EQ (XCAR (value), Qlambda)))
  	    break;
  	  return 0;
--- 875,881 ----
  	case IMAGE_FUNCTION_VALUE:
  	  value = indirect_function (value);
  	  if (SUBRP (value)
! 	      || FUNVECP (value)
  	      || (CONSP (value) && EQ (XCAR (value), Qlambda)))
  	    break;
  	  return 0;


*** orig/src/keyboard.c
--- mod/src/keyboard.c
***************
*** 9658,9664 ****
        return Fexecute_kbd_macro (final, prefixarg, Qnil);
      }
  
!   if (CONSP (final) || SUBRP (final) || COMPILEDP (final))
      {
        backtrace.next = backtrace_list;
        backtrace_list = &backtrace;
--- 9658,9664 ----
        return Fexecute_kbd_macro (final, prefixarg, Qnil);
      }
  
!   if (CONSP (final) || SUBRP (final) || FUNVECP (final))
      {
        backtrace.next = backtrace_list;
        backtrace_list = &backtrace;


*** orig/src/lisp.h
--- mod/src/lisp.h
***************
*** 259,265 ****
    PVEC_NORMAL_VECTOR = 0,
    PVEC_PROCESS = 0x200,
    PVEC_FRAME = 0x400,
!   PVEC_COMPILED = 0x800,
    PVEC_WINDOW = 0x1000,
    PVEC_WINDOW_CONFIGURATION = 0x2000,
    PVEC_SUBR = 0x4000,
--- 259,265 ----
    PVEC_NORMAL_VECTOR = 0,
    PVEC_PROCESS = 0x200,
    PVEC_FRAME = 0x400,
!   PVEC_FUNVEC = 0x800,
    PVEC_WINDOW = 0x1000,
    PVEC_WINDOW_CONFIGURATION = 0x2000,
    PVEC_SUBR = 0x4000,
***************
*** 537,543 ****
  #define XSETPROCESS(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_PROCESS))
  #define XSETWINDOW(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_WINDOW))
  #define XSETSUBR(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_SUBR))
! #define XSETCOMPILED(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_COMPILED))
  #define XSETBUFFER(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_BUFFER))
  #define XSETCHAR_TABLE(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_CHAR_TABLE))
  #define XSETBOOL_VECTOR(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_BOOL_VECTOR))
--- 537,543 ----
  #define XSETPROCESS(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_PROCESS))
  #define XSETWINDOW(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_WINDOW))
  #define XSETSUBR(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_SUBR))
! #define XSETFUNVEC(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_FUNVEC))
  #define XSETBUFFER(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_BUFFER))
  #define XSETCHAR_TABLE(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_CHAR_TABLE))
  #define XSETBOOL_VECTOR(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_BOOL_VECTOR))
***************
*** 548,553 ****
--- 548,556 ----
  #define ASET(ARRAY, IDX, VAL)	(AREF ((ARRAY), (IDX)) = (VAL))
  #define ASIZE(ARRAY)		XVECTOR ((ARRAY))->size
  
+ /* Return the size of the psuedo-vector object FUNVEC.  */
+ #define FUNVEC_SIZE(funvec)	(ASIZE (funvec) & PSEUDOVECTOR_SIZE_MASK)
+ 
  /* Convenience macros for dealing with Lisp strings.  */
  
  #define SREF(string, index)	(XSTRING (string)->data[index] + 0)
***************
*** 1263,1269 ****
  typedef unsigned char UCHAR;
  #endif
  
! /* Meanings of slots in a Lisp_Compiled:  */
  
  #define COMPILED_ARGLIST 0
  #define COMPILED_BYTECODE 1
--- 1266,1272 ----
  typedef unsigned char UCHAR;
  #endif
  
! /* Meanings of slots in a byte-compiled function vector:  */
  
  #define COMPILED_ARGLIST 0
  #define COMPILED_BYTECODE 1
***************
*** 1272,1277 ****
--- 1275,1298 ----
  #define COMPILED_DOC_STRING 4
  #define COMPILED_INTERACTIVE 5
  
+ /* Return non-zero if TAG, the first element from a funvec object, refers
+    to a byte-code object.  Byte-code objects are distinguished from other
+    `funvec' objects by having a (possibly empty) list as their first
+    element -- other funvec types use a non-nil symbol there.  */
+ #define FUNVEC_COMPILED_TAG_P(tag)					      \
+   (NILP (tag) || CONSP (tag))
+ 
+ /* Return non-zero if FUNVEC, which should be a `funvec' object, is a
+    byte-compiled function. Byte-compiled function are funvecs with the
+    arglist as the first element (other funvec types will have a symbol
+    identifying the type as the first object).  */
+ #define FUNVEC_COMPILED_P(funvec)					      \
+   (FUNVEC_SIZE (funvec) > 0 && FUNVEC_COMPILED_TAG_P (AREF (funvec, 0)))
+ 
+ /* Return non-zero if OBJ is byte-compile function.  */
+ #define COMPILEDP(obj)							      \
+   (FUNVECP (obj) && FUNVEC_COMPILED_P (obj))
+ 
  /* Flag bits in a character.  These also get used in termhooks.h.
     Richard Stallman <rms@gnu.ai.mit.edu> thinks that MULE
     (MUlti-Lingual Emacs) might need 22 bits for the character value
***************
*** 1440,1447 ****
  #define GC_WINDOWP(x) GC_PSEUDOVECTORP (x, PVEC_WINDOW)
  #define SUBRP(x) PSEUDOVECTORP (x, PVEC_SUBR)
  #define GC_SUBRP(x) GC_PSEUDOVECTORP (x, PVEC_SUBR)
! #define COMPILEDP(x) PSEUDOVECTORP (x, PVEC_COMPILED)
! #define GC_COMPILEDP(x) GC_PSEUDOVECTORP (x, PVEC_COMPILED)
  #define BUFFERP(x) PSEUDOVECTORP (x, PVEC_BUFFER)
  #define GC_BUFFERP(x) GC_PSEUDOVECTORP (x, PVEC_BUFFER)
  #define CHAR_TABLE_P(x) PSEUDOVECTORP (x, PVEC_CHAR_TABLE)
--- 1461,1468 ----
  #define GC_WINDOWP(x) GC_PSEUDOVECTORP (x, PVEC_WINDOW)
  #define SUBRP(x) PSEUDOVECTORP (x, PVEC_SUBR)
  #define GC_SUBRP(x) GC_PSEUDOVECTORP (x, PVEC_SUBR)
! #define FUNVECP(x) PSEUDOVECTORP (x, PVEC_FUNVEC)
! #define GC_FUNVECP(x) GC_PSEUDOVECTORP (x, PVEC_FUNVEC)
  #define BUFFERP(x) PSEUDOVECTORP (x, PVEC_BUFFER)
  #define GC_BUFFERP(x) GC_PSEUDOVECTORP (x, PVEC_BUFFER)
  #define CHAR_TABLE_P(x) PSEUDOVECTORP (x, PVEC_CHAR_TABLE)
***************
*** 1628,1634 ****
  #define FUNCTIONP(OBJ)					\
       ((CONSP (OBJ) && EQ (XCAR (OBJ), Qlambda))		\
        || (SYMBOLP (OBJ) && !NILP (Ffboundp (OBJ)))	\
!       || COMPILEDP (OBJ)				\
        || SUBRP (OBJ))
  
  /* defsubr (Sname);
--- 1649,1655 ----
  #define FUNCTIONP(OBJ)					\
       ((CONSP (OBJ) && EQ (XCAR (OBJ), Qlambda))		\
        || (SYMBOLP (OBJ) && !NILP (Ffboundp (OBJ)))	\
!       || FUNVECP (OBJ)					\
        || SUBRP (OBJ))
  
  /* defsubr (Sname);
***************
*** 2451,2456 ****
--- 2472,2478 ----
  extern Lisp_Object allocate_misc P_ ((void));
  EXFUN (Fmake_vector, 2);
  EXFUN (Fvector, MANY);
+ EXFUN (Ffunvec, MANY);
  EXFUN (Fmake_symbol, 1);
  EXFUN (Fmake_marker, 0);
  EXFUN (Fmake_string, 2);
***************
*** 2468,2473 ****
--- 2490,2496 ----
  extern Lisp_Object pure_cons P_ ((Lisp_Object, Lisp_Object));
  extern Lisp_Object make_pure_vector P_ ((EMACS_INT));
  EXFUN (Fgarbage_collect, 0);
+ extern Lisp_Object make_funvec P_ ((Lisp_Object, int, int, Lisp_Object *));
  EXFUN (Fmake_byte_code, MANY);
  EXFUN (Fmake_bool_vector, 2);
  EXFUN (Fmake_char_table, 2);


*** orig/src/lread.c
--- mod/src/lread.c
***************
*** 2021,2034 ****
  						Qnil));
  	}
        if (c == '[')
! 	{
! 	  /* Accept compiled functions at read-time so that we don't have to
! 	     build them using function calls.  */
! 	  Lisp_Object tmp;
! 	  tmp = read_vector (readcharfun, 1);
! 	  return Fmake_byte_code (XVECTOR (tmp)->size,
! 				  XVECTOR (tmp)->contents);
! 	}
        if (c == '(')
  	{
  	  Lisp_Object tmp;
--- 2021,2028 ----
  						Qnil));
  	}
        if (c == '[')
! 	/* `function vector' objects, including byte-compiled functions.  */
! 	return read_vector (readcharfun, 1);
        if (c == '(')
  	{
  	  Lisp_Object tmp;
***************
*** 2796,2804 ****
  
  \f
  static Lisp_Object
! read_vector (readcharfun, bytecodeflag)
       Lisp_Object readcharfun;
!      int bytecodeflag;
  {
    register int i;
    register int size;
--- 2790,2798 ----
  
  \f
  static Lisp_Object
! read_vector (readcharfun, read_funvec)
       Lisp_Object readcharfun;
!      int read_funvec;
  {
    register int i;
    register int size;
***************
*** 2806,2811 ****
--- 2800,2810 ----
    register Lisp_Object tem, item, vector;
    register struct Lisp_Cons *otem;
    Lisp_Object len;
+   /* If we're reading a funvec object we start out assuming it's also a
+      byte-code object (a subset of funvecs), so we can do any special
+      processing needed.  If it's just an ordinary funvec object, we'll
+      realize that as soon as we've read the first element.  */
+   int read_bytecode = read_funvec;
  
    tem = read_list (1, readcharfun);
    len = Flength (tem);
***************
*** 2816,2826 ****
    for (i = 0; i < size; i++)
      {
        item = Fcar (tem);
        /* If `load-force-doc-strings' is t when reading a lazily-loaded
  	 bytecode object, the docstring containing the bytecode and
  	 constants values must be treated as unibyte and passed to
  	 Fread, to get the actual bytecode string and constants vector.  */
!       if (bytecodeflag && load_force_doc_strings)
  	{
  	  if (i == COMPILED_BYTECODE)
  	    {
--- 2815,2833 ----
    for (i = 0; i < size; i++)
      {
        item = Fcar (tem);
+ 
+       /* If READ_BYTECODE is set, check whether this is really a byte-code
+ 	 object, or just an ordinary `funvec' object -- non-byte-code
+ 	 funvec objects use the same reader syntax.  We can tell from the
+ 	 first element which one it is.  */
+       if (read_bytecode && i == 0 && ! FUNVEC_COMPILED_TAG_P (item))
+ 	read_bytecode = 0;	/* Nope. */
+ 
        /* If `load-force-doc-strings' is t when reading a lazily-loaded
  	 bytecode object, the docstring containing the bytecode and
  	 constants values must be treated as unibyte and passed to
  	 Fread, to get the actual bytecode string and constants vector.  */
!       if (read_bytecode && load_force_doc_strings)
  	{
  	  if (i == COMPILED_BYTECODE)
  	    {
***************
*** 2864,2869 ****
--- 2871,2884 ----
        tem = Fcdr (tem);
        free_cons (otem);
      }
+ 
+   if (read_bytecode && size >= 4)
+     /* Convert this vector to a bytecode object.  */
+     vector = Fmake_byte_code (size, XVECTOR (vector)->contents);
+   else if (read_funvec && size >= 1)
+     /* Convert this vector to an ordinary funvec object.  */
+     XSETFUNVEC (vector, XVECTOR (vector));
+ 
    return vector;
  }
  


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




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



-- 
Love is a snowmobile racing across the tundra.  Suddenly it flips over,
pinning you underneath.  At night the ice weasels come.  --Nietzsche

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

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

Re: User-reserved element in byte code vectors

[Miles Bader]

On Wed, May 19, 2004 at 11:19:15AM -0400, Stefan Monnier wrote:
> I'd be interested to see how you use those `curry' thingies, BTW.
> E.g. what does
> 
>      (let ((x 0))
>        (lambda () (setq x (+ x 1))))
> 
> get translated into?

Essentially:

   (let ((env (vector 0)))
     (curry env (lambda (env) (aset env 0 (+ (aref env 0) 1)))))

[of course, `env' is not visible to the user code]

-Miles
-- 
97% of everything is grunge

Re: User-reserved element in byte code vectors

[Richard Stallman]

    Essentially:

       (let ((env (vector 0)))
	 (curry env (lambda (env) (aset env 0 (+ (aref env 0) 1)))))

    [of course, `env' is not visible to the user code]

The word "essentially" means that this isn't really
the answer to the question.  What precisely are the Lisp
objects produced?

Why use `curry' for this at all, rather than implementing
a `closure' funcvec type?

Re: User-reserved element in byte code vectors

[Miles Bader]

Richard Stallman <rms@gnu.org> writes:
>     Essentially:
> 
>        (let ((env (vector 0)))
> 	 (curry env (lambda (env) (aset env 0 (+ (aref env 0) 1)))))
> 
>     [of course, `env' is not visible to the user code]
> 
> The word "essentially" means that this isn't really
> the answer to the question.  What precisely are the Lisp
> objects produced?

The above code should be exact, except that `env' never exists a normal
named variable -- in the compiler it's a variable with a funny (not a
symbol) name, and at runtime, it's just a stack location (like other
"local" variables).

> Why use `curry' for this at all, rather than implementing
> a `closure' funcvec type?

Well, I have nothing particularly against a special closure type; it's
just that in this case it's not necessary -- curry provides exactly the
functionality I need.

I suppose I could make a special `closure' funvec type that actually
shared all its code with that for `curry', if secondary effects are an
issue (e.g., what describe-function says, etc).

Currently my compiler doesn't even compile such things properly, so
things are kind of off my radar... :-/

-Miles
-- 
=====
(^o^;
(()))
*This is the cute octopus virus, please copy it into your sig so it can spread.

Re: User-reserved element in byte code vectors

[Richard Stallman]

    >        (let ((env (vector 0)))
    > 	 (curry env (lambda (env) (aset env 0 (+ (aref env 0) 1)))))

Wouldn't it be better to add an env slot to byte-compiled functions?
No matter how the code implements that, it ought to be somewhat faster.

Re: User-reserved element in byte code vectors

[Miles Bader]

On Sat, May 22, 2004 at 03:31:54AM -0400, Richard Stallman wrote:
>     >        (let ((env (vector 0)))
>     > 	 (curry env (lambda (env) (aset env 0 (+ (aref env 0) 1)))))
> 
> Wouldn't it be better to add an env slot to byte-compiled functions?
> No matter how the code implements that, it ought to be somewhat faster.

a new closure/environment is created ever time you invoke the above code, but
the actual code-object representing the lambda is a constant.  This is why
it's natural to use a representation where the closure actually points to the
code-object, rather than the other way around.

I don't there'd be much speed avantage to a call using the opposite method --
the overhead of using curry is basically an extra layer of Ffuncall before
getting to Fbyte_code.  [In the extremely unlikely case that it _was_ an
issue, you could simply have funcall_funvec call Fbyte_code directly when
appropriate.]

BTW, while this is an interesting subject, what about the basic funvec/curry
patch?

-Miles
-- 
(\(\
(^.^)
(")")
*This is the cute bunny virus, please copy this into your sig so it can spread.

Re: get-internal-run-time

[Lars Brinkhoff]

Richard Stallman wrote:
> [Lars Brinkhoff wrote:]
>     [I wish there were a] function that returns the amount of
>     processor time used [by Emacs], for implementing [the Common
>     Lisp function] get-internal-run-time.
> 
>     ANSI CL says:
> 	    The intent is that the difference between the values of
> 	    two calls to this function be the amount of time between
> 	    the two calls during which computational effort was
> 	    expended on behalf of the executing program.
>     I haven't found a suitable function for this in Emacs.
> 
> Would you like to contribute such a function?

The above was written in May.  I believe all prerequisite paperwork
has finally been done now.

The patch has been updated to the current version in CVS.  Also, at
the end there's a small space optimization for the sxhash function.


etc/NEWS (Lisp Changes):
** The new primitive `get-internal-run-time' returns the processor
run time used by Emacs since start-up.

./ChangeLog:
2004-10-28  Lars Brinkhoff  <lars@nocrew.org>

	* configure.in: Add check for getrusage.

src/ChangeLog:
2004-10-28  Lars Brinkhoff  <lars@nocrew.org>

	* config.in: Add HAVE_GETRUSAGE.
	* editfns.c (Fget_internal_run_time): New function.
	(syms_of_data): Defsubr it.
	* fns.c (sxhash): As far as possible, merge calculation of
	hash code for symbols and strings.

lispref/ChangeLog:
2004-10-28  Lars Brinkhoff  <lars@nocrew.org>

	* os.texi (Processor Run Time): New section documenting
	get-internal-run-time.

Index: configure.in
===================================================================
RCS file: /cvsroot/emacs/emacs/configure.in,v
retrieving revision 1.375
diff -c -r1.375 configure.in
*** configure.in	20 Oct 2004 16:16:07 -0000	1.375
--- configure.in	28 Oct 2004 16:09:55 -0000
***************
*** 2353,2359 ****
  AC_CHECK_HEADERS(maillock.h)
  
  AC_CHECK_FUNCS(gethostname getdomainname dup2 \
! rename closedir mkdir rmdir sysinfo \
  random lrand48 bcopy bcmp logb frexp fmod rint cbrt ftime res_init setsid \
  strerror fpathconf select mktime euidaccess getpagesize tzset setlocale \
  utimes setrlimit setpgid getcwd getwd shutdown getaddrinfo \
--- 2353,2359 ----
  AC_CHECK_HEADERS(maillock.h)
  
  AC_CHECK_FUNCS(gethostname getdomainname dup2 \
! rename closedir mkdir rmdir sysinfo getrusage \
  random lrand48 bcopy bcmp logb frexp fmod rint cbrt ftime res_init setsid \
  strerror fpathconf select mktime euidaccess getpagesize tzset setlocale \
  utimes setrlimit setpgid getcwd getwd shutdown getaddrinfo \
Index: lispref/os.texi
===================================================================
RCS file: /cvsroot/emacs/emacs/lispref/os.texi,v
retrieving revision 1.65
diff -c -r1.65 os.texi
*** lispref/os.texi	8 Aug 2004 00:00:07 -0000	1.65
--- lispref/os.texi	28 Oct 2004 16:10:04 -0000
***************
*** 23,28 ****
--- 23,29 ----
  * Time of Day::		Getting the current time.
  * Time Conversion::     Converting a time from numeric form to a string, or
                            to calendrical data (or vice versa).
+ * Processor Run Time::  Getting the run time used by Emacs.
  * Time Calculations::   Adding, subtracting, comparing times, etc.
  * Timers::		Setting a timer to call a function at a certain time.
  * Terminal Input::      Recording terminal input for debugging.
***************
*** 1285,1290 ****
--- 1286,1313 ----
  on others, years as early as 1901 do work.
  @end defun
  
+ @node Processor Run Time
+ @section Processor Run time
+ 
+ @defun get-internal-run-time
+ This function returns the processor run time used by Emacs as a list
+ of three integers: @code{(@var{high} @var{low} @var{microsec})}.  The
+ integers @var{high} and @var{low} combine to give the number of
+ seconds, which is
+ @ifnottex
+ @var{high} * 2**16 + @var{low}.
+ @end ifnottex
+ @tex
+ $high*2^{16}+low$.
+ @end tex
+ 
+ The third element, @var{microsec}, gives the microseconds (or 0 for
+ systems that return time with the resolution of only one second).
+ 
+ If the system doesn't provide a way to determine the processor run
+ time, get-internal-run-time returns the same time as current-time.
+ @end defun
+ 
  @node Time Calculations
  @section Time Calculations
  
Index: src/config.in
===================================================================
RCS file: /cvsroot/emacs/emacs/src/config.in,v
retrieving revision 1.200
diff -c -r1.200 config.in
*** src/config.in	20 Oct 2004 16:23:30 -0000	1.200
--- src/config.in	28 Oct 2004 16:10:04 -0000
***************
*** 196,201 ****
--- 196,204 ----
  /* Define to 1 if you have the `getpt' function. */
  #undef HAVE_GETPT
  
+ /* Define to 1 if you have the `getrusage' function. */
+ #undef HAVE_GETRUSAGE
+ 
  /* Define to 1 if you have the `getsockname' function. */
  #undef HAVE_GETSOCKNAME
  
Index: src/editfns.c
===================================================================
RCS file: /cvsroot/emacs/emacs/src/editfns.c,v
retrieving revision 1.382
diff -c -r1.382 editfns.c
*** src/editfns.c	27 Oct 2004 11:02:06 -0000	1.382
--- src/editfns.c	28 Oct 2004 16:10:06 -0000
***************
*** 39,44 ****
--- 39,48 ----
  #include <stdio.h>
  #endif
  
+ #if defined HAVE_SYS_RESOURCE_H
+ #include <sys/resource.h>
+ #endif
+ 
  #include <ctype.h>
  
  #include "lisp.h"
***************
*** 1375,1380 ****
--- 1379,1425 ----
  
    return Flist (3, result);
  }
+ 
+ DEFUN ("get-internal-run-time", Fget_internal_run_time, Sget_internal_run_time,
+        0, 0, 0,
+        doc: /* Return the current run time used by Emacs.
+ The time is returned as a list of three integers.  The first has the
+ most significant 16 bits of the seconds, while the second has the
+ least significant 16 bits.  The third integer gives the microsecond
+ count.
+ 
+ On systems that can't determine the run time, get-internal-run-time
+ does the same thing as current-time.  The microsecond count is zero on
+ systems that do not provide resolution finer than a second.  */)
+      ()
+ {
+ #ifdef HAVE_GETRUSAGE
+   struct rusage usage;
+   Lisp_Object result[3];
+   int secs, usecs;
+ 
+   if (getrusage (RUSAGE_SELF, &usage) < 0)
+     /* This shouldn't happen.  What action is appropriate?  */
+     Fsignal (Qerror, Qnil);
+ 
+   /* Sum up user time and system time.  */
+   secs = usage.ru_utime.tv_sec + usage.ru_stime.tv_sec;
+   usecs = usage.ru_utime.tv_usec + usage.ru_stime.tv_usec;
+   if (usecs >= 1000000)
+     {
+       usecs -= 1000000;
+       secs++;
+     }
+ 
+   XSETINT (result[0], (secs >> 16) & 0xffff);
+   XSETINT (result[1], (secs >> 0)  & 0xffff);
+   XSETINT (result[2], usecs);
+ 
+   return Flist (3, result);
+ #else
+   return Fcurrent_time ();
+ #endif
+ }
  \f
  
  int
***************
*** 4315,4320 ****
--- 4360,4366 ----
    defsubr (&Suser_full_name);
    defsubr (&Semacs_pid);
    defsubr (&Scurrent_time);
+   defsubr (&Sget_internal_run_time);
    defsubr (&Sformat_time_string);
    defsubr (&Sfloat_time);
    defsubr (&Sdecode_time);
Index: src/fns.c
===================================================================
RCS file: /cvsroot/emacs/emacs/src/fns.c,v
retrieving revision 1.374
diff -c -r1.374 fns.c
*** src/fns.c	26 Oct 2004 22:38:50 -0000	1.374
--- src/fns.c	28 Oct 2004 16:10:07 -0000
***************
*** 5007,5021 ****
        hash = XUINT (obj);
        break;
  
-     case Lisp_Symbol:
-       hash = sxhash_string (SDATA (SYMBOL_NAME (obj)),
- 			    SCHARS (SYMBOL_NAME (obj)));
-       break;
- 
      case Lisp_Misc:
        hash = XUINT (obj);
        break;
  
      case Lisp_String:
        hash = sxhash_string (SDATA (obj), SCHARS (obj));
        break;
--- 5007,5020 ----
        hash = XUINT (obj);
        break;
  
      case Lisp_Misc:
        hash = XUINT (obj);
        break;
  
+     case Lisp_Symbol:
+       obj = SYMBOL_NAME (obj);
+       /* Fall through.  */
+ 
      case Lisp_String:
        hash = sxhash_string (SDATA (obj), SCHARS (obj));
        break;