changeset: 5550:b908c7265a2b tag: tip user: Aidan Kehoe <kehoea(a)parhasard.net&gt; 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&gt; * 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&gt; * 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&gt; + + * 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&gt; * 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&gt; + + * automated/lisp-tests.el: + Trivial tests of #'apply-partially, just added to subr.el. + 2011-08-08 Stephen J. Turnbull <stephen(a)xemacs.org&gt; * 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