Mercurial > hg > xemacs-beta

comparison lisp/cl-seq.el @ 5182:2e528066e2fc

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Move #'sort*, #'fill, #'merge to C from cl-seq.el. lisp/ChangeLog addition: 2010-04-01 Aidan Kehoe <kehoea@parhasard.net> * cl-seq.el (fill, sort*, merge): Move these functions to fns.c. (stable-sort): Make this docstring reflect the argument names used in the #'sort* docstring. * cl-macs.el (stable-sort): Make #'stable-sort exactly equivalent to #'sort* in compiled code. * bytecomp.el (byte-compile-maybe-add-*): New macro, for functions like #'sort and #'mapcar that, to be strictly compatible, should only take two args, but in our implementation can take more, because they're aliases of #'sort* and #'mapcar*. (byte-compile-mapcar, byte-compile-sort, byte-compile-fillarray): Use this new macro. (map-into): Add a byte-compile method for #'map-into in passing. * apropos.el (apropos-print): Use #'sort* with a :key argument, now it's in C. * compat.el (extent-at): Ditto. * register.el (list-registers): Ditto. * package-ui.el (pui-list-packages): Ditto. * help.el (sorted-key-descriptions): Ditto. src/ChangeLog addition: 2010-03-31 Aidan Kehoe <kehoea@parhasard.net> * fns.c (STRING_DATA_TO_OBJECT_ARRAY) (BIT_VECTOR_TO_OBJECT_ARRAY, c_merge_predicate_key) (c_merge_predicate_nokey, list_merge, array_merge) (list_array_merge_into_list, list_list_merge_into_array) (list_array_merge_into_array, CHECK_KEY_ARGUMENT, Fmerge) (list_sort, array_sort, FsortX): Move #'sort*, #'fill, #'merge from cl-seq.el to C, extending the implementations of Fsort, Ffillarray, and merge() to do so. * keymap.c (keymap_submaps, map_keymap_sort_predicate) (describe_map_sort_predicate): Change the calling semantics of the C sort predicates to return a non-nil Lisp object if the first argument is less than the second, rather than C integers. * fontcolor-msw.c (sort_font_list_function): * fileio.c (build_annotations): * dired.c (Fdirectory_files): * abbrev.c (Finsert_abbrev_table_description): Call list_sort instead of Fsort, list_merge instead of merge() in these functions. man/ChangeLog addition: 2010-04-01 Aidan Kehoe <kehoea@parhasard.net> * lispref/lists.texi (Rearrangement): Update the documentation of #'sort here, now that it accepts any type of sequence and the KEY keyword argument. (Though this is probably now the wrong place for this function, given that.)
author Aidan Kehoe <kehoea@parhasard.net>
date Thu, 01 Apr 2010 20:22:50 +0100
parents 6afe991b8135
children 2d0937dc83cf
comparison
equal deleted inserted replaced
5181:a00bfbd64e0a 5182:2e528066e2fc
173 cl-accum))) 173 cl-accum)))
174 (while cl-seq 174 (while cl-seq
175 (setq cl-accum (funcall cl-func cl-accum 175 (setq cl-accum (funcall cl-func cl-accum
176 (cl-check-key (pop cl-seq)))))) 176 (cl-check-key (pop cl-seq))))))
177 cl-accum))) 177 cl-accum)))
178
179 (defun fill (seq item &rest cl-keys)
180 "Fill the elements of SEQ with ITEM.
181 Keywords supported: :start :end
182 :start and :end specify a subsequence of SEQ; see `remove*' for more
183 information."
184 (cl-parsing-keywords ((:start 0) :end) ()
185 (if (listp seq)
186 (let ((p (nthcdr cl-start seq))
187 (n (if cl-end (- cl-end cl-start) 8000000)))
188 (while (and p (>= (setq n (1- n)) 0))
189 (setcar p item)
190 (setq p (cdr p))))
191 (or cl-end (setq cl-end (length seq)))
192 (if (and (= cl-start 0) (= cl-end (length seq)))
193 (fillarray seq item)
194 (while (< cl-start cl-end)
195 (aset seq cl-start item)
196 (setq cl-start (1+ cl-start)))))
197 seq))
198 178
199 (defun replace (cl-seq1 cl-seq2 &rest cl-keys) 179 (defun replace (cl-seq1 cl-seq2 &rest cl-keys)
200 "Replace the elements of SEQ1 with the elements of SEQ2. 180 "Replace the elements of SEQ1 with the elements of SEQ2.
201 SEQ1 is destructively modified, then returned. 181 SEQ1 is destructively modified, then returned.
202 Keywords supported: :start1 :end1 :start2 :end2 182 Keywords supported: :start1 :end1 :start2 :end2
668 :start2 (1+ cl-pos) :end2 (+ cl-pos cl-len) 648 :start2 (1+ cl-pos) :end2 (+ cl-pos cl-len)
669 :from-end nil cl-keys)) 649 :from-end nil cl-keys))
670 (if cl-from-end (setq cl-end2 cl-pos) (setq cl-start2 (1+ cl-pos)))) 650 (if cl-from-end (setq cl-end2 cl-pos) (setq cl-start2 (1+ cl-pos))))
671 (and (< cl-start2 cl-end2) cl-pos))))) 651 (and (< cl-start2 cl-end2) cl-pos)))))
672 652
673 (defun sort* (cl-seq cl-pred &rest cl-keys)
674 "Sort the argument SEQUENCE according to PREDICATE.
675 This is a destructive function; it reuses the storage of SEQUENCE if possible.
676 Keywords supported: :key
677 :key specifies a one-argument function that transforms elements of SEQUENCE
678 into \"comparison keys\" before the test predicate is applied. See
679 `member*' for more information."
680 (if (nlistp cl-seq)
681 (replace cl-seq (apply 'sort* (append cl-seq nil) cl-pred cl-keys))
682 (cl-parsing-keywords (:key) ()
683 (if (memq cl-key '(nil identity))
684 (sort cl-seq cl-pred)
685 (sort cl-seq (function (lambda (cl-x cl-y)
686 (funcall cl-pred (funcall cl-key cl-x)
687 (funcall cl-key cl-y)))))))))
688
689 (defun stable-sort (cl-seq cl-pred &rest cl-keys) 653 (defun stable-sort (cl-seq cl-pred &rest cl-keys)
690 "Sort the argument SEQUENCE stably according to PREDICATE. 654 "Sort the argument SEQUENCE stably according to PREDICATE.
691 This is a destructive function; it reuses the storage of SEQUENCE if possible. 655 This is a destructive function; it reuses the storage of SEQUENCE if possible.
692 Keywords supported: :key 656 Keywords supported: :key
693 :key specifies a one-argument function that transforms elements of SEQUENCE 657 :key specifies a one-argument function that transforms elements of SEQUENCE
694 into \"comparison keys\" before the test predicate is applied. See 658 into \"comparison keys\" before the test predicate is applied. See
695 `member*' for more information." 659 `member*' for more information.
660
661 arguments: (SEQUENCE PREDICATE &key (KEY #'IDENTITY))"
696 (apply 'sort* cl-seq cl-pred cl-keys)) 662 (apply 'sort* cl-seq cl-pred cl-keys))
697
698 (defun merge (cl-type cl-seq1 cl-seq2 cl-pred &rest cl-keys)
699 "Destructively merge the two sequences to produce a new sequence.
700 TYPE is the sequence type to return, SEQ1 and SEQ2 are the two
701 argument sequences, and PRED is a `less-than' predicate on the elements.
702 Keywords supported: :key
703 :key specifies a one-argument function that transforms elements of SEQ1 and
704 SEQ2 into \"comparison keys\" before the test predicate is applied. See
705 `member*' for more information."
706 (or (listp cl-seq1) (setq cl-seq1 (append cl-seq1 nil)))
707 (or (listp cl-seq2) (setq cl-seq2 (append cl-seq2 nil)))
708 (cl-parsing-keywords (:key) ()
709 (let ((cl-res nil))
710 (while (and cl-seq1 cl-seq2)
711 (if (funcall cl-pred (cl-check-key (car cl-seq2))
712 (cl-check-key (car cl-seq1)))
713 (push (pop cl-seq2) cl-res)
714 (push (pop cl-seq1) cl-res)))
715 (coerce (nconc (nreverse cl-res) cl-seq1 cl-seq2) cl-type))))
716 663
717 ;;; See compiler macro in cl-macs.el 664 ;;; See compiler macro in cl-macs.el
718 (defun member* (cl-item cl-list &rest cl-keys) 665 (defun member* (cl-item cl-list &rest cl-keys)
719 "Find the first occurrence of ITEM in LIST. 666 "Find the first occurrence of ITEM in LIST.
720 Return the sublist of LIST whose car is ITEM. 667 Return the sublist of LIST whose car is ITEM.