Mercurial > hg > xemacs-beta

comparison lisp/cl-seq.el @ 5261:69f687b3ba9d

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Move #'replace to C, add bounds-checking to it and to #'fill. 2010-09-06 Aidan Kehoe <kehoea@parhasard.net> Move #'replace to C; add bounds checking to it and to #'fill. * fns.c (Fsubseq, Ffill, mapcarX): Don't #'nreverse in #'subseq, use fill_string_range and check bounds in #'fill, use replace_string_range() in #'map-into avoiding quadratic time when modfiying the string. * fns.c (check_sequence_range, fill_string_range) (replace_string_range, replace_string_range_1, Freplace): New functions; check that arguments fit sequence dimensions, fill a string range with a given character, replace a string range from an Ibyte pointer.
author Aidan Kehoe <kehoea@parhasard.net>
date Mon, 06 Sep 2010 17:29:51 +0100
parents f3eca926258e
children d1b17a33450b 308d34e9f07d
comparison
equal deleted inserted replaced
5260:dceee3855f15 5261:69f687b3ba9d
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 144
145 (defun replace (cl-seq1 cl-seq2 &rest cl-keys) 145 ;; XEmacs; #'replace is in fns.c.
146 "Replace the elements of SEQ1 with the elements of SEQ2.
147 SEQ1 is destructively modified, then returned.
148 Keywords supported: :start1 :end1 :start2 :end2
149 :start1 and :end1 specify a subsequence of SEQ1, and :start2 and :end2 a
150 subsequence of SEQ2; see `search' for more information."
151 (cl-parsing-keywords ((:start1 0) :end1 (:start2 0) :end2) ()
152 (if (and (eq cl-seq1 cl-seq2) (<= cl-start2 cl-start1))
153 (or (= cl-start1 cl-start2)
154 (let* ((cl-len (length cl-seq1))
155 (cl-n (min (- (or cl-end1 cl-len) cl-start1)
156 (- (or cl-end2 cl-len) cl-start2))))
157 (while (>= (setq cl-n (1- cl-n)) 0)
158 (cl-set-elt cl-seq1 (+ cl-start1 cl-n)
159 (elt cl-seq2 (+ cl-start2 cl-n))))))
160 (if (listp cl-seq1)
161 (let ((cl-p1 (nthcdr cl-start1 cl-seq1))
162 (cl-n1 (if cl-end1 (- cl-end1 cl-start1) 4000000)))
163 (if (listp cl-seq2)
164 (let ((cl-p2 (nthcdr cl-start2 cl-seq2))
165 (cl-n (min cl-n1
166 (if cl-end2 (- cl-end2 cl-start2) 4000000))))
167 (while (and cl-p1 cl-p2 (>= (setq cl-n (1- cl-n)) 0))
168 (setcar cl-p1 (car cl-p2))
169 (setq cl-p1 (cdr cl-p1) cl-p2 (cdr cl-p2))))
170 (setq cl-end2 (min (or cl-end2 (length cl-seq2))
171 (+ cl-start2 cl-n1)))
172 (while (and cl-p1 (< cl-start2 cl-end2))
173 (setcar cl-p1 (aref cl-seq2 cl-start2))
174 (setq cl-p1 (cdr cl-p1) cl-start2 (1+ cl-start2)))))
175 (setq cl-end1 (min (or cl-end1 (length cl-seq1))
176 (+ cl-start1 (- (or cl-end2 (length cl-seq2))
177 cl-start2))))
178 (if (listp cl-seq2)
179 (let ((cl-p2 (nthcdr cl-start2 cl-seq2)))
180 (while (< cl-start1 cl-end1)
181 (aset cl-seq1 cl-start1 (car cl-p2))
182 (setq cl-p2 (cdr cl-p2) cl-start1 (1+ cl-start1))))
183 (while (< cl-start1 cl-end1)
184 (aset cl-seq1 cl-start1 (aref cl-seq2 cl-start2))
185 (setq cl-start2 (1+ cl-start2) cl-start1 (1+ cl-start1))))))
186 cl-seq1))
187 146
188 (defun remove* (cl-item cl-seq &rest cl-keys) 147 (defun remove* (cl-item cl-seq &rest cl-keys)
189 "Remove all occurrences of ITEM in SEQ. 148 "Remove all occurrences of ITEM in SEQ.
190 This is a non-destructive function; it makes a copy of SEQ if necessary 149 This is a non-destructive function; it makes a copy of SEQ if necessary
191 to avoid corrupting the original SEQ. 150 to avoid corrupting the original SEQ.