Mercurial > hg > xemacs-beta

diff lisp/cl-macs.el @ 5522:544e6336d37c

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Reimplement a few GNU functions in terms of CL functions, subr.el 2011-06-19 Aidan Kehoe <kehoea@parhasard.net> * cl-macs.el: * cl-macs.el (assoc-ignore-case, assoc-ignore-representation): * cl-macs.el (member-ignore-case): New compiler macros. * subr.el (assoc-ignore-case): * subr.el (assoc-ignore-representation): * subr.el (member-ignore-case): * subr.el (split-path): * subr.el (delete-dups): Reimplement a few GNU functions in terms of their CL counterparts, for the sake of circularity checking and some speed; add type checking (used in interpreted code and with low speed and safety checking) for the sake of revealing incompatibilities when developing. * subr.el (remove-hook): There's no need for flet here, an explicit lambda is enough.
author Aidan Kehoe <kehoea@parhasard.net>
date Sun, 19 Jun 2011 17:43:03 +0100
parents 9d519ab9fd68
children 810b77562486
line wrap: on
line diff
--- a/lisp/cl-macs.el	Sun Jun 19 16:53:03 2011 +0100
+++ b/lisp/cl-macs.el	Sun Jun 19 17:43:03 2011 +0100
@@ -3766,6 +3766,35 @@
 	(the string ,string) :test #'eq)
     form))
 
+(define-compiler-macro assoc-ignore-case (&whole form &rest args)
+  (if (eql 2 (length args))
+      `(assoc* (the string ,(pop args))
+               (the (and list (satisfies
+                               (lambda (list)
+                                 (not (find-if-not 'stringp list :key 'car)))))
+                    ,(pop args))
+               :test 'equalp)
+    form))
+
+(define-compiler-macro assoc-ignore-representation (&whole form &rest args)
+  (if (eql 2 (length args))
+      `(assoc* (the string ,(pop args))
+               (the (and list (satisfies
+                               (lambda (list)
+                                 (not (find-if-not 'stringp list :key 'car)))))
+                    ,(pop args))
+               :test 'equalp)
+    form))
+
+(define-compiler-macro member-ignore-case (&whole form &rest args)
+  (if (eql 2 (length args))
+      `(member* (the string ,(pop args))
+                (the (and list (satisfies
+                                (lambda (list) (every 'stringp list))))
+                     ,(pop args))
+                :test 'equalp)
+    form))
+
 (define-compiler-macro stable-union (&whole form &rest cl-keys)
   (if (> (length form) 2)
       (list* 'union (pop cl-keys) (pop cl-keys) :stable t cl-keys)