Mercurial > hg > xemacs-beta

comparison lisp/cl-extra.el @ 4997:8800b5350a13

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Move #'some, #'every to C, implementing them with mapcarX. src/ChangeLog addition: 2010-02-03 Aidan Kehoe <kehoea@parhasard.net> * fns.c (mapcarX): Accept a new argument, indicating whether the function is being called from #'some or #'every. Implement it. Discard any multiple values where that is appropriate. (Fmapconcat, FmapcarX, Fmapvector, Fmapcan, Fmapc, Fmap) (Fmap_into): Pass the new flag to mapcarX. (Fsome, Fevery): Move these functions here from cl-extra.el; implement them in terms of mapcarX. (maplist): Discard multiple values where appropriate. lisp/ChangeLog addition: 2010-02-03 Aidan Kehoe <kehoea@parhasard.net> * cl-extra.el (some, every): Move these functions to C. * cl-macs.el (notany, notevery): Add compiler macros for these functions, no longer proclaim them inline (which would involve specbinding that's not necessary with the compiler macros).
author Aidan Kehoe <kehoea@parhasard.net>
date Wed, 03 Feb 2010 20:26:47 +0000
parents c17c857e20bf
children 6aba0daedb7c
comparison
equal deleted inserted replaced
4996:c17c857e20bf 4997:8800b5350a13
223 ;; ;; bit-vectors and strings are only equalp if they're 223 ;; ;; bit-vectors and strings are only equalp if they're
224 ;; ;; zero-length: 224 ;; ;; zero-length:
225 ;; (and (equal "" y) (equal #* x))))) 225 ;; (and (equal "" y) (equal #* x)))))
226 ;; (t (equal x y))))))) 226 ;; (t (equal x y)))))))
227 227
228 ;; XEmacs; #'map, #'mapc, #'mapl, #'maplist, #'mapcon are now in C, together 228 ;; XEmacs; #'map, #'mapc, #'mapl, #'maplist, #'mapcon, #'some and #'every
229 ;; with #'map-into, which was never in this file. 229 ;; are now in C, together with #'map-into, which was never in this file.
230
231 (defun some (cl-pred cl-seq &rest cl-rest)
232 "Return true if PREDICATE is true of any element of SEQ or SEQs.
233 If so, return the true (non-nil) value returned by PREDICATE."
234 (if (or cl-rest (nlistp cl-seq))
235 (catch 'cl-some
236 (apply 'map nil
237 (function (lambda (&rest cl-x)
238 (let ((cl-res (apply cl-pred cl-x)))
239 (if cl-res (throw 'cl-some cl-res)))))
240 cl-seq cl-rest) nil)
241 (let ((cl-x nil))
242 (while (and cl-seq (not (setq cl-x (funcall cl-pred (pop cl-seq))))))
243 cl-x)))
244
245 (defun every (cl-pred cl-seq &rest cl-rest)
246 "Return true if PREDICATE is true of every element of SEQ or SEQs."
247 (if (or cl-rest (nlistp cl-seq))
248 (catch 'cl-every
249 (apply 'map nil
250 (function (lambda (&rest cl-x)
251 (or (apply cl-pred cl-x) (throw 'cl-every nil))))
252 cl-seq cl-rest) t)
253 (while (and cl-seq (funcall cl-pred (car cl-seq)))
254 (setq cl-seq (cdr cl-seq)))
255 (null cl-seq)))
256 230
257 (defun notany (cl-pred cl-seq &rest cl-rest) 231 (defun notany (cl-pred cl-seq &rest cl-rest)
258 "Return true if PREDICATE is false of every element of SEQ or SEQs." 232 "Return true if PREDICATE is false of every element of SEQ or SEQs."
259 (not (apply 'some cl-pred cl-seq cl-rest))) 233 (not (apply 'some cl-pred cl-seq cl-rest)))
260 234