Mercurial > hg > xemacs-beta

comparison lisp/cl-seq.el @ 5227:fbd1485af104

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Move #'reduce to fns.c from cl-seq.el. src/ChangeLog addition: 2010-06-06 Aidan Kehoe <kehoea@parhasard.net> * fns.c (Freduce): Move this here from cl-seq.el, avoiding the need to cons. This has been tested using Paul Dietz' test suite, and everything applicable passes, with the exception that the ALLOW-OTHER-KEYS-NIL Common Lisp issue (functions with &key must *always* accept :allow-other-keys nil) hasn't been implemented. lisp/ChangeLog addition: 2010-06-06 Aidan Kehoe <kehoea@parhasard.net> * cl-seq.el (reduce): Move this to fns.c.
author Aidan Kehoe <kehoea@parhasard.net>
date Sun, 06 Jun 2010 13:24:31 +0100
parents 2d0937dc83cf
children f3eca926258e
comparison
equal deleted inserted replaced
5226:7789ae555c45 5227:fbd1485af104
139 (put 'cl-check-match 'edebug-form-spec 'edebug-forms) 139 (put 'cl-check-match 'edebug-form-spec 'edebug-forms)
140 140
141 (defvar cl-test) (defvar cl-test-not) 141 (defvar cl-test) (defvar cl-test-not)
142 (defvar cl-if) (defvar cl-if-not) 142 (defvar cl-if) (defvar cl-if-not)
143 (defvar cl-key) 143 (defvar cl-key)
144
145
146 (defun reduce (cl-func cl-seq &rest cl-keys)
147 "Combine the elements of sequence using FUNCTION, a binary operation.
148 For example, `(reduce #'+ SEQUENCE)' returns the sum of all elements in
149 SEQUENCE, and `(reduce #'union SEQUENCE)' returns the union of all elements
150 in SEQUENCE.
151 Keywords supported: :start :end :from-end :initial-value :key
152 See `remove*' for the meaning of :start, :end, :from-end and :key.
153 :initial-value specifies an element (typically an identity element, such as 0)
154 that is conceptually prepended to the sequence (or appended, when :from-end
155 is given).
156 If the sequence has one element, that element is returned directly.
157 If the sequence has no elements, :initial-value is returned if given;
158 otherwise, FUNCTION is called with no arguments, and its result returned."
159 (cl-parsing-keywords (:from-end (:start 0) :end :initial-value :key) ()
160 (or (listp cl-seq) (setq cl-seq (append cl-seq nil)))
161 (setq cl-seq (subseq cl-seq cl-start cl-end))
162 (if cl-from-end (setq cl-seq (nreverse cl-seq)))
163 (let ((cl-accum (cond ((memq :initial-value cl-keys) cl-initial-value)
164 (cl-seq (cl-check-key (pop cl-seq)))
165 (t (funcall cl-func)))))
166 (if cl-from-end
167 (while cl-seq
168 (setq cl-accum (funcall cl-func (cl-check-key (pop cl-seq))
169 cl-accum)))
170 (while cl-seq
171 (setq cl-accum (funcall cl-func cl-accum
172 (cl-check-key (pop cl-seq))))))
173 cl-accum)))
174 144
175 (defun replace (cl-seq1 cl-seq2 &rest cl-keys) 145 (defun replace (cl-seq1 cl-seq2 &rest cl-keys)
176 "Replace the elements of SEQ1 with the elements of SEQ2. 146 "Replace the elements of SEQ1 with the elements of SEQ2.
177 SEQ1 is destructively modified, then returned. 147 SEQ1 is destructively modified, then returned.
178 Keywords supported: :start1 :end1 :start2 :end2 148 Keywords supported: :start1 :end1 :start2 :end2