Changeset 12516 for trunk/abcl/src/org/armedbear/lisp/mismatch.lisp
- Timestamp:
- 03/03/10 21:05:41 (11 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/abcl/src/org/armedbear/lisp/mismatch.lisp
r11391 r12516 32 32 33 33 (in-package "COMMON-LISP") 34 35 (require "EXTENSIBLE-SEQUENCES-BASE") 34 36 35 37 (export 'mismatch) … … 71 73 (error "both test and test are supplied")) 72 74 73 (defun mismatch (sequence1 sequence2 & key from-end test test-not74 75 (defun mismatch (sequence1 sequence2 &rest args &key from-end test test-not 76 (key #'identity) start1 start2 end1 end2) 75 77 (and test test-not (test-error)) 76 (with-start-end 77 start1 end1 sequence1 78 (with-start-end 79 start2 end2 sequence2 80 (if (not from-end) 81 (do ((i1 start1 (1+ i1)) 82 (i2 start2 (1+ i2))) 83 ((or (>= i1 end1) (>= i2 end2)) 84 (if (and (>= i1 end1) (>= i2 end2)) nil i1)) 85 (unless (call-test test test-not 86 (funcall key (elt sequence1 i1)) 87 (funcall key (elt sequence2 i2))) 88 (return i1))) 89 (do ((i1 (1- end1) (1- i1)) 90 (i2 (1- end2) (1- i2))) 91 ((or (< i1 start1) (< i2 start2)) 92 (if (and (< i1 start1) (< i2 start2)) nil (1+ i1))) 93 (unless (call-test test test-not 94 (funcall key (elt sequence1 i1)) 95 (funcall key (elt sequence2 i2))) 96 (return (1+ i1)))))))) 78 (if (and (or (listp sequence1) (arrayp sequence1)) 79 (or (listp sequence2) (arrayp sequence2))) 80 (with-start-end start1 end1 sequence1 81 (with-start-end start2 end2 sequence2 82 (if (not from-end) 83 (do ((i1 start1 (1+ i1)) 84 (i2 start2 (1+ i2))) 85 ((or (>= i1 end1) (>= i2 end2)) 86 (if (and (>= i1 end1) (>= i2 end2)) nil i1)) 87 (unless (call-test test test-not 88 (funcall key (elt sequence1 i1)) 89 (funcall key (elt sequence2 i2))) 90 (return i1))) 91 (do ((i1 (1- end1) (1- i1)) 92 (i2 (1- end2) (1- i2))) 93 ((or (< i1 start1) (< i2 start2)) 94 (if (and (< i1 start1) (< i2 start2)) nil (1+ i1))) 95 (unless (call-test test test-not 96 (funcall key (elt sequence1 i1)) 97 (funcall key (elt sequence2 i2))) 98 (return (1+ i1))))))) 99 (apply #'sequence:mismatch sequence1 sequence2 args)))
Note: See TracChangeset
for help on using the changeset viewer.