78 |
|
|
79 |
(eval-when (compile eval) |
(eval-when (compile eval) |
80 |
(proclaim '(function the-start (t) fixnum)) |
(proclaim '(function the-start (t) fixnum)) |
81 |
(proclaim '(function the-end (t t) fixnum)) |
(proclaim '(function the-end (t fixnum) fixnum)) |
82 |
(defmacro f+ (x y) `(the fixnum (+ (the fixnum ,x) (the fixnum ,y)))) |
(defmacro f+ (x y) `(the fixnum (+ (the fixnum ,x) (the fixnum ,y)))) |
83 |
(defmacro f- (x y) `(the fixnum (- (the fixnum ,x) (the fixnum ,y)))) |
(defmacro f- (x y) `(the fixnum (- (the fixnum ,x) (the fixnum ,y)))) |
84 |
|
|
85 |
(defmacro with-start-end ( start end seq &body body) |
(defmacro with-start-end ( start end seq &body body) |
86 |
`(let ((,start (if ,start (the-start ,start) 0))) |
`(let ((,start (if ,start (the-start ,start) 0))) |
87 |
(declare (fixnum ,start)) |
(declare (fixnum ,start)) |
88 |
(let ((,end (the-end ,end ,seq))) |
(check-type ,seq sequence) |
89 |
|
(let ((,end (the-end ,end (length ,seq)))) |
90 |
(declare (fixnum ,end)) |
(declare (fixnum ,end)) |
91 |
(or (<= ,start ,end) (bad-seq-limit ,start ,end)) |
(or (<= ,start ,end) (bad-seq-limit ,start ,end)) |
92 |
,@ body))) |
,@ body))) |
94 |
|
|
95 |
(defun the-end (x y) |
(defun the-end (x y) |
96 |
(cond ((fixnump x) |
(cond ((fixnump x) |
97 |
(or (<= (the fixnum x) (the fixnum (length y))) |
(or (<= (the fixnum x) y) |
98 |
(bad-seq-limit x)) |
(bad-seq-limit x)) |
99 |
x) |
x) |
100 |
((null x) |
((null x) y) |
|
(length y)) |
|
101 |
(t (bad-seq-limit x)))) |
(t (bad-seq-limit x)))) |
102 |
|
|
103 |
(defun the-start (x) |
(defun the-start (x) |
116 |
end |
end |
117 |
(initial-value nil ivsp) |
(initial-value nil ivsp) |
118 |
(key #'identity)) |
(key #'identity)) |
119 |
|
(declare (optimize (safety 1))) |
120 |
(with-start-end start end sequence |
(with-start-end start end sequence |
121 |
(cond ((not from-end) |
(cond ((not from-end) |
122 |
(when (null ivsp) |
(when (null ivsp) |
144 |
|
|
145 |
(defun fill (sequence item |
(defun fill (sequence item |
146 |
&key start end ) |
&key start end ) |
147 |
|
(declare (optimize (safety 1))) |
148 |
(with-start-end start end sequence |
(with-start-end start end sequence |
149 |
(do ((i start (f+ 1 i))) |
(do ((i start (f+ 1 i))) |
150 |
((>= i end) sequence) |
((>= i end) sequence) |
155 |
(defun replace (sequence1 sequence2 |
(defun replace (sequence1 sequence2 |
156 |
&key start1 end1 |
&key start1 end1 |
157 |
start2 end2 ) |
start2 end2 ) |
158 |
|
(declare (optimize (safety 1))) |
159 |
(with-start-end start1 end1 sequence1 |
(with-start-end start1 end1 sequence1 |
160 |
(with-start-end start2 end2 sequence2 |
(with-start-end start2 end2 sequence2 |
161 |
(if (and (eq sequence1 sequence2) |
(if (and (eq sequence1 sequence2) |
224 |
&key from-end test test-not |
&key from-end test test-not |
225 |
start end |
start end |
226 |
,@(if countp '(count)) |
,@(if countp '(count)) |
227 |
(key #'identity) |
(key #'identity)) |
228 |
,@(if everywherep |
(declare (optimize (safety 1))) |
229 |
(list '&aux '(l (length sequence))) |
(if (eq key nil) (setq key #'identity)) |
|
nil)) |
|
|
,@(if everywherep '((declare (fixnum l)))) |
|
|
(if (eq key nil) (setq key #'identity)) |
|
230 |
(with-start-end start end sequence |
(with-start-end start end sequence |
231 |
|
(let (,@(when everywherep `((l (length sequence))))) |
232 |
|
,@(when everywherep '((declare (fixnum l)))) |
233 |
(let ,@(if countp |
(let ,@(if countp |
234 |
'(((count |
'(((count |
235 |
(cond ((null count) most-positive-fixnum) |
(cond ((null count) most-positive-fixnum) |
248 |
iterate-i-everywhere-from-end |
iterate-i-everywhere-from-end |
249 |
endp-i-everywhere |
endp-i-everywhere |
250 |
endp-i-everywhere-from-end) |
endp-i-everywhere-from-end) |
251 |
(eval-body))))))) |
(eval-body)))))))) |
252 |
`(defun ,(intern (si:string-concatenate (string f) "-IF") |
`(defun ,(intern (si:string-concatenate (string f) "-IF") |
253 |
(symbol-package f)) |
(symbol-package f)) |
254 |
(,@args predicate sequence |
(,@args predicate sequence |
256 |
start end |
start end |
257 |
,@(if countp '(count)) |
,@(if countp '(count)) |
258 |
(key #'identity)) |
(key #'identity)) |
259 |
(if (eq key nil) (setq key #'identity)) |
(declare (optimize (safety 1))) |
260 |
|
(if (eq key nil) (setq key #'identity)) |
261 |
(,f ,@args predicate sequence |
(,f ,@args predicate sequence |
262 |
:from-end from-end |
:from-end from-end |
263 |
:test #'funcall |
:test #'funcall |
270 |
&key from-end start end |
&key from-end start end |
271 |
,@(if countp '(count)) |
,@(if countp '(count)) |
272 |
(key #'identity)) |
(key #'identity)) |
273 |
(if (eq key nil) (setq key #'identity)) |
(declare (optimize (safety 1))) |
274 |
|
(if (eq key nil) (setq key #'identity)) |
275 |
(,f ,@args predicate sequence |
(,f ,@args predicate sequence |
276 |
:from-end from-end |
:from-end from-end |
277 |
:test-not #'funcall |
:test-not #'funcall |
420 |
test test-not |
test test-not |
421 |
start end |
start end |
422 |
(key #'identity)) |
(key #'identity)) |
423 |
|
(declare (optimize (safety 1))) |
424 |
(and test test-not (test-error)) |
(and test test-not (test-error)) |
425 |
(when (and (listp sequence) (not from-end) (null start) |
(when (and (listp sequence) (not from-end) (null start) |
426 |
(null end)) |
(null end)) |
444 |
test test-not |
test test-not |
445 |
start |
start |
446 |
end |
end |
447 |
(key #'identity) |
(key #'identity)) |
448 |
&aux (l (length sequence))) |
(declare (optimize (safety 1))) |
|
(declare (fixnum l)) |
|
449 |
(and test test-not (test-error)) |
(and test test-not (test-error)) |
450 |
(when (and (listp sequence) (not from-end) (null start) |
(when (and (listp sequence) (not from-end) (null start) |
451 |
(null end)) |
(null end)) |
459 |
(rplaca l (cadr l)) |
(rplaca l (cadr l)) |
460 |
(rplacd l (cddr l))) |
(rplacd l (cddr l))) |
461 |
(t (setq l (cdr l)))))) |
(t (setq l (cdr l)))))) |
462 |
(with-start-end start end sequence |
(with-start-end |
463 |
|
start end sequence |
464 |
|
(let ((l (length sequence))) |
465 |
(if (not from-end) |
(if (not from-end) |
466 |
(do ((n 0) |
(do ((n 0) |
467 |
(i start (f+ 1 i))) |
(i start (f+ 1 i))) |
524 |
:start start |
:start start |
525 |
:end i |
:end i |
526 |
:key key) |
:key key) |
527 |
(setf n (f+ 1 n))))))) |
(setf n (f+ 1 n)))))))) |
528 |
|
|
529 |
|
|
530 |
(defun mismatch (sequence1 sequence2 |
(defun mismatch (sequence1 sequence2 |
532 |
(key #'identity) |
(key #'identity) |
533 |
start1 start2 |
start1 start2 |
534 |
end1 end2) |
end1 end2) |
535 |
|
(declare (optimize (safety 1))) |
536 |
(and test test-not (test-error)) |
(and test test-not (test-error)) |
537 |
(with-start-end start1 end1 sequence1 |
(with-start-end start1 end1 sequence1 |
538 |
(with-start-end start2 end2 sequence2 |
(with-start-end start2 end2 sequence2 |
562 |
(key #'identity) |
(key #'identity) |
563 |
start1 start2 |
start1 start2 |
564 |
end1 end2) |
end1 end2) |
565 |
|
(declare (optimize (safety 1))) |
566 |
(and test test-not (test-error)) |
(and test test-not (test-error)) |
567 |
(with-start-end start1 end1 sequence1 |
(with-start-end start1 end1 sequence1 |
568 |
(with-start-end start2 end2 sequence2 |
(with-start-end start2 end2 sequence2 |
592 |
|
|
593 |
|
|
594 |
(defun sort (sequence predicate &key (key #'identity)) |
(defun sort (sequence predicate &key (key #'identity)) |
595 |
|
(declare (optimize (safety 1))) |
596 |
|
(check-type sequence sequence) |
597 |
(if (listp sequence) |
(if (listp sequence) |
598 |
(list-merge-sort sequence predicate key) |
(list-merge-sort sequence predicate key) |
599 |
(quick-sort sequence 0 (the fixnum (length sequence)) predicate key))) |
(quick-sort sequence 0 (the fixnum (length sequence)) predicate key))) |
699 |
(quick-sort seq (f+ 1 j) end pred key)))) |
(quick-sort seq (f+ 1 j) end pred key)))) |
700 |
|
|
701 |
(defun stable-sort (sequence predicate &key (key #'identity)) |
(defun stable-sort (sequence predicate &key (key #'identity)) |
702 |
|
(declare (optimize (safety 1))) |
703 |
|
(check-type sequence sequence) |
704 |
(if (listp sequence) |
(if (listp sequence) |
705 |
(list-merge-sort sequence predicate key) |
(list-merge-sort sequence predicate key) |
706 |
(if (or (stringp sequence) (bit-vector-p sequence)) |
(if (or (stringp sequence) (bit-vector-p sequence)) |
714 |
(defun merge (result-type sequence1 sequence2 predicate |
(defun merge (result-type sequence1 sequence2 predicate |
715 |
&key (key #'identity) |
&key (key #'identity) |
716 |
&aux (l1 (length sequence1)) (l2 (length sequence2))) |
&aux (l1 (length sequence1)) (l2 (length sequence2))) |
717 |
|
(declare (optimize (safety 1))) |
718 |
(declare (fixnum l1 l2)) |
(declare (fixnum l1 l2)) |
719 |
(when (equal key 'nil) (setq key #'identity)) |
(when (equal key 'nil) (setq key #'identity)) |
720 |
(do ((newseq (make-sequence result-type (the fixnum (f+ l1 l2)))) |
(do ((newseq (make-sequence result-type (the fixnum (f+ l1 l2)))) |
746 |
|
|
747 |
(defun map-into (result-sequence function &rest sequences) |
(defun map-into (result-sequence function &rest sequences) |
748 |
; "map-into: (result-sequence function &rest sequences)" |
; "map-into: (result-sequence function &rest sequences)" |
749 |
|
(declare (optimize (safety 1))) |
750 |
|
(check-type result-sequence sequence) |
751 |
(let ((nel (apply #'min (if (subtypep (type-of result-sequence) 'vector) |
(let ((nel (apply #'min (if (subtypep (type-of result-sequence) 'vector) |
752 |
(array-dimension result-sequence 0) |
(array-dimension result-sequence 0) |
753 |
(length result-sequence)) |
(length result-sequence)) |
763 |
|
|
764 |
|
|
765 |
(defmacro with-hash-table-iterator ((name hash-table) &body body) |
(defmacro with-hash-table-iterator ((name hash-table) &body body) |
766 |
|
(declare (optimize (safety 1))) |
767 |
(let ((table (gensym )) |
(let ((table (gensym )) |
768 |
(ind (gensym "ind"))) |
(ind (gensym "ind"))) |
769 |
`(let ((,table ,hash-table) |
`(let ((,table ,hash-table) |