Ignore:
Timestamp:
03/03/10 21:05:41 (11 years ago)
Author:
astalla
Message:

Support for user-extensible sequences, adapted from SBCL.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/abcl/src/org/armedbear/lisp/mismatch.lisp

    r11391 r12516  
    3232
    3333(in-package "COMMON-LISP")
     34
     35(require "EXTENSIBLE-SEQUENCES-BASE")
    3436
    3537(export 'mismatch)
     
    7173  (error "both test and test are supplied"))
    7274
    73 (defun mismatch (sequence1 sequence2 &key from-end test test-not
    74                           (key #'identity) start1 start2 end1 end2)
     75(defun mismatch (sequence1 sequence2 &rest args &key from-end test test-not
     76    (key #'identity) start1 start2 end1 end2)
    7577  (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.