changeset: 5550:b908c7265a2b
tag: tip
user: Aidan Kehoe <kehoea(a)parhasard.net>
date: Fri Aug 12 16:02:30 2011 +0100
files: lisp/ChangeLog lisp/cl-macs.el lisp/subr.el tests/ChangeLog
tests/automated/lisp-tests.el
description:
Add the #'apply-partially API, as used by GNU.
lisp/ChangeLog addition:
2011-08-12 Aidan Kehoe <kehoea(a)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(a)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(a)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(a)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(a)parhasard.net>
+
+ * automated/lisp-tests.el:
+ Trivial tests of #'apply-partially, just added to subr.el.
+
2011-08-08 Stephen J. Turnbull <stephen(a)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
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches