Mercurial > hg > xemacs-beta

comparison lisp/cl-macs.el @ 5550:b908c7265a2b

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
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.
author Aidan Kehoe <kehoea@parhasard.net>
date Fri, 12 Aug 2011 16:02:30 +0100
parents 2a6a8da4dd7c
children 62edcc6a11ec
comparison
equal deleted inserted replaced
5549:493c487cbc3f 5550:b908c7265a2b
3508 (cl-simple-expr-p val)) res 3508 (cl-simple-expr-p val)) res
3509 (let ((temp (gensym))) 3509 (let ((temp (gensym)))
3510 (list 'let (list (list temp val)) (subst temp val res))))) 3510 (list 'let (list (list temp val)) (subst temp val res)))))
3511 form)) 3511 form))
3512 3512
3513 (define-compiler-macro apply-partially (&whole form &rest args)
3514 "Generate a #'make-byte-code call for #'apply-partially, if appropriate."
3515 (if (< (length args) 1)
3516 form
3517 (if (cl-const-exprs-p args)
3518 `#'(lambda (&rest args) (apply ,@args args))
3519 (let* ((placeholders (mapcar 'quote-maybe (mapcar 'gensym args)))
3520 (compiled (byte-compile-sexp
3521 `#'(lambda (&rest args) (apply ,@placeholders args)))))
3522 `(make-byte-code
3523 ',(compiled-function-arglist compiled)
3524 ,(compiled-function-instructions compiled)
3525 (vector ,@(sublis (pairlis placeholders args)
3526 (mapcar 'quote-maybe
3527 (compiled-function-constants compiled))
3528 :test 'equal))
3529 ,(compiled-function-stack-depth compiled))))))
3530
3513 (define-compiler-macro delete-dups (list) 3531 (define-compiler-macro delete-dups (list)
3514 `(delete-duplicates (the list ,list) :test #'equal :from-end t)) 3532 `(delete-duplicates (the list ,list) :test #'equal :from-end t))
3515 3533
3516 ;; XEmacs; inline delete-duplicates if it's called with one of the 3534 ;; XEmacs; inline delete-duplicates if it's called with one of the
3517 ;; common compile-time constant tests and an optional :from-end 3535 ;; common compile-time constant tests and an optional :from-end