# HG changeset patch
# User Aidan Kehoe <kehoea@parhasard.net>
# Date 1313161350 -3600
# Node ID b908c7265a2b98c3dcb5bbc4edecd5c9a158fc02
# Parent  493c487cbc3f1fc4f14855181174eca2c717f119
Add the #'apply-partially API, as used by GNU.

lisp/ChangeLog addition:

2011-08-12  Aidan Kehoe  <kehoea@parhasard.net>

	* cl-macs.el:
	* cl-macs.el (apply-partially): New compiler macro.
	* subr.el:
	* subr.el (apply-partially): New.
	Sync this function's API and docstring from GNU. The
	implementation is mine and trivial; the compiler macro in
	cl-macs.el ensures that partially-applied functions in compiled
	code are also compiled.

tests/ChangeLog addition:

2011-08-12  Aidan Kehoe  <kehoea@parhasard.net>

	* automated/lisp-tests.el:
	Trivial tests of #'apply-partially, just added to subr.el.

diff -r 493c487cbc3f -r b908c7265a2b lisp/ChangeLog
--- a/lisp/ChangeLog	Wed Aug 10 16:50:37 2011 +0100
+++ b/lisp/ChangeLog	Fri Aug 12 16:02:30 2011 +0100
@@ -1,3 +1,14 @@
+2011-08-12  Aidan Kehoe  <kehoea@parhasard.net>
+
+	* cl-macs.el:
+	* cl-macs.el (apply-partially): New compiler macro.
+	* subr.el:
+	* subr.el (apply-partially): New.
+	Sync this function's API and docstring from GNU. The
+	implementation is mine and trivial; the compiler macro in
+	cl-macs.el ensures that partially-applied functions in compiled
+	code are also compiled.
+
 2011-08-10  Aidan Kehoe  <kehoea@parhasard.net>
 
 	* keymap.el:
diff -r 493c487cbc3f -r b908c7265a2b lisp/cl-macs.el
--- a/lisp/cl-macs.el	Wed Aug 10 16:50:37 2011 +0100
+++ b/lisp/cl-macs.el	Fri Aug 12 16:02:30 2011 +0100
@@ -3510,6 +3510,24 @@
 	    (list 'let (list (list temp val)) (subst temp val res)))))
     form))
 
+(define-compiler-macro apply-partially (&whole form &rest args)
+  "Generate a #'make-byte-code call for #'apply-partially, if appropriate."
+  (if (< (length args) 1)
+      form
+    (if (cl-const-exprs-p args)
+        `#'(lambda (&rest args) (apply ,@args args))
+      (let* ((placeholders (mapcar 'quote-maybe (mapcar 'gensym args)))
+             (compiled (byte-compile-sexp
+                        `#'(lambda (&rest args) (apply ,@placeholders args)))))
+        `(make-byte-code
+          ',(compiled-function-arglist compiled)
+          ,(compiled-function-instructions compiled)
+          (vector ,@(sublis (pairlis placeholders args)
+                            (mapcar 'quote-maybe
+                                    (compiled-function-constants compiled))
+                            :test 'equal))
+          ,(compiled-function-stack-depth compiled))))))
+
 (define-compiler-macro delete-dups (list)
   `(delete-duplicates (the list ,list) :test #'equal :from-end t))
 
diff -r 493c487cbc3f -r b908c7265a2b lisp/subr.el
--- a/lisp/subr.el	Wed Aug 10 16:50:37 2011 +0100
+++ b/lisp/subr.el	Fri Aug 12 16:02:30 2011 +0100
@@ -85,6 +85,19 @@
 quote lambda expressions appropriately."
   `(function (lambda ,@cdr)))
 
+;; Partial application of functions (related to currying).  XEmacs; closures
+;; aren't yet available to us as a language type, but they're not necessary
+;; for this function (nor indeed is CL's #'lexical-let).  See also the
+;; compiler macro in cl-macs.el, which generates a call to #'make-byte-code
+;; at runtime, ensuring that partially applied functions are byte-compiled.
+(defun apply-partially (function &rest args)
+  "Return a function that is a partial application of FUNCTION to ARGS.
+ARGS is a list of the first N arguments to pass to FUNCTION.
+The result is a new function which does the same as FUNCTION, except that
+the first N arguments are fixed at the values with which this function
+was called."
+  `(lambda (&rest args) (apply ',function ,@(mapcar 'quote-maybe args) args)))
+
 ;; FSF 21.2 has various basic macros here.  We don't because they're either
 ;; in cl*.el (which we dump and hence is always available) or built-in.
 
diff -r 493c487cbc3f -r b908c7265a2b tests/ChangeLog
--- a/tests/ChangeLog	Wed Aug 10 16:50:37 2011 +0100
+++ b/tests/ChangeLog	Fri Aug 12 16:02:30 2011 +0100
@@ -1,3 +1,8 @@
+2011-08-12  Aidan Kehoe  <kehoea@parhasard.net>
+
+	* automated/lisp-tests.el:
+	Trivial tests of #'apply-partially, just added to subr.el.
+
 2011-08-08  Stephen J. Turnbull  <stephen@xemacs.org>
 
 	* automated/syntax-tests.el:
diff -r 493c487cbc3f -r b908c7265a2b tests/automated/lisp-tests.el
--- a/tests/automated/lisp-tests.el	Wed Aug 10 16:50:37 2011 +0100
+++ b/tests/automated/lisp-tests.el	Fri Aug 12 16:02:30 2011 +0100
@@ -2926,4 +2926,13 @@
   (Assert (equal '([symbol expansion] [copy expansion] [third expansion])
 		 (test-symbol-macrolet))))
 
+;; Basic tests of #'apply-partially.
+(let* ((four 4)
+       (times-four (apply-partially '* four))
+       (plus-twelve (apply-partially '+ 6 (* 3 2))))
+  (Assert (eql (funcall times-four 6) 24))
+  (Assert (eql (funcall times-four 4 4) 64))
+  (Assert (eql (funcall plus-twelve (funcall times-four 4) 4 4) 36))
+  (Check-Error wrong-number-of-arguments (apply-partially)))
+
 ;;; end of lisp-tests.el