(FILECREATED "11-Jun-86 16:13:57" {ERIS}<LISPCORE>LIBRARY>CMLSEQ.;23
 152484 

      changes to:  (FUNCTIONS CL:ELT %%SETELT SUBSEQ LIST-SUBSEQ*)
                   (STRUCTURES INDEX-BOUNDS-ERROR)
                   (VARS CMLSEQCOMS)

      previous date: " 9-Jun-86 20:03:44" {ERIS}<DANIELS>CML>CMLSEQ.;10)


(* Copyright (c) 1985, 1986 by Xerox Corporation. All rights reserved.)

(PRETTYCOMPRINT CMLSEQCOMS)

(RPAQQ CMLSEQCOMS
 ((STRUCTURES INDEX-BOUNDS-ERROR)
                   (FUNCTIONS SEQ-DISPATCH TYPE-SPECIFIER MAKE-SEQUENCE-LIKE)
                   (FUNCTIONS CONCATENATE-TO-MUMBLE)
                   (* "Not used.")
                   (FNS CL:COERCE LIST-TO-STRING* LIST-TO-BIT-VECTOR* LIST-TO-VECTOR* VECTOR-TO-LIST* 
                        VECTOR-TO-VECTOR* VECTOR-TO-STRING* VECTOR-TO-BIT-VECTOR* 
                        STRING-TO-SIMPLE-STRING* BIT-VECTOR-TO-SIMPLE-BIT-VECTOR*)
                   (* "Left over.")
                   (PROP DMACRO CL:EVERY)
                   (* "Should be an optimizer")
                   (FUNCTIONS MAKE-SEQUENCE-OF-TYPE)
                   (COMS (FUNCTIONS CL:ELT %%SETELT)
                         (SETFS CL:ELT)
                         (* "Should be removed from CMLSETF"))
                   (COMS (FUNCTIONS SUBSEQ LIST-SUBSEQ* VECTOR-SUBSEQ*)
                         (SETFS SUBSEQ)
                         (* "Should be removed from CMLSETF"))
                   (FUNCTIONS COPY-SEQ LIST-COPY-SEQ LIST-COPY-SEQ* VECTOR-COPY-SEQ VECTOR-COPY-SEQ*)
                   (FUNCTIONS CL:LENGTH)
                   (FUNCTIONS CL:REVERSE LIST-REVERSE-MACRO VECTOR-REVERSE VECTOR-REVERSE*)
                   (FUNCTIONS CL:NREVERSE LIST-NREVERSE-MACRO LIST-NREVERSE* VECTOR-NREVERSE 
                          VECTOR-NREVERSE*)
                   (FUNCTIONS MAKE-SEQUENCE)
                   (FUNCTIONS CONCATENATE CONCATENATE-TO-LIST CONCAT-TO-LIST* CONCAT-TO-SIMPLE*)
                   (FUNCTIONS ELT-SLICE MAP-FOR-EFFECT MAP-TO-LIST MAP-TO-SIMPLE CL:MAP)
                   (FUNCTIONS CL:SOME CL:EVERY CL:NOTANY CL:NOTEVERY)
                   (FUNCTIONS LIST-REDUCE-FROM-END LIST-REDUCE MUMBLE-REDUCE-FROM-END MUMBLE-REDUCE 
                          REDUCE)
                   (FUNCTIONS FILL LIST-FILL LIST-FILL* VECTOR-FILL VECTOR-FILL*)
                   (FUNCTIONS MUMBLE-REPLACE-FROM-MUMBLE LIST-REPLACE-FROM-LIST 
                          LIST-REPLACE-FROM-MUMBLE MUMBLE-REPLACE-FROM-LIST CL:REPLACE 
                          LIST-REPLACE-FROM-LIST* LIST-REPLACE-FROM-VECTOR* VECTOR-REPLACE-FROM-LIST* 
                          VECTOR-REPLACE-FROM-VECTOR*)
                   (COMS (FUNCTIONS MUMBLE-DELETE MUMBLE-DELETE-FROM-END LIST-DELETE 
                                LIST-DELETE-FROM-END)
                         (FUNCTIONS NORMAL-MUMBLE-DELETE NORMAL-MUMBLE-DELETE-FROM-END 
                                NORMAL-LIST-DELETE NORMAL-LIST-DELETE-FROM-END CL:DELETE)
                         (FUNCTIONS IF-MUMBLE-DELETE IF-MUMBLE-DELETE-FROM-END IF-LIST-DELETE 
                                IF-LIST-DELETE-FROM-END DELETE-IF)
                         (FUNCTIONS IF-NOT-MUMBLE-DELETE IF-NOT-MUMBLE-DELETE-FROM-END 
                                IF-NOT-LIST-DELETE IF-NOT-LIST-DELETE-FROM-END DELETE-IF-NOT))
                   (COMS (FUNCTIONS MUMBLE-REMOVE-MACRO MUMBLE-REMOVE MUMBLE-REMOVE-FROM-END 
                                LIST-REMOVE-MACRO LIST-REMOVE LIST-REMOVE-FROM-END)
                         (FUNCTIONS NORMAL-MUMBLE-REMOVE NORMAL-MUMBLE-REMOVE-FROM-END 
                                NORMAL-LIST-REMOVE NORMAL-LIST-REMOVE-FROM-END CL:REMOVE)
                         (FUNCTIONS IF-MUMBLE-REMOVE IF-MUMBLE-REMOVE-FROM-END IF-LIST-REMOVE 
                                IF-LIST-REMOVE-FROM-END REMOVE-IF)
                         (FUNCTIONS IF-NOT-MUMBLE-REMOVE IF-NOT-MUMBLE-REMOVE-FROM-END 
                                IF-NOT-LIST-REMOVE IF-NOT-LIST-REMOVE-FROM-END REMOVE-IF-NOT))
                   (FUNCTIONS LIST-REMOVE-DUPLICATES* VECTOR-REMOVE-DUPLICATES* REMOVE-DUPLICATES 
                          LIST-DELETE-DUPLICATES* VECTOR-DELETE-DUPLICATES* DELETE-DUPLICATES)
                   (FUNCTIONS SUBST-DISPATCH LIST-SUBSTITUTE* VECTOR-SUBSTITUTE* SUBSTITUTE 
                          SUBSTITUTE-IF SUBSTITUTE-IF-NOT)
                   (FUNCTIONS NLIST-SUBSTITUTE* NVECTOR-SUBSTITUTE* NSUBSTITUTE NLIST-SUBSTITUTE-IF* 
                          NVECTOR-SUBSTITUTE-IF* NSUBSTITUTE-IF NLIST-SUBSTITUTE-IF-NOT* 
                          NVECTOR-SUBSTITUTE-IF-NOT* NSUBSTITUTE-IF-NOT)
                   (FUNCTIONS VECTOR-FIND LIST-FIND VECTOR-FIND-IF LIST-FIND-IF VECTOR-FIND-IF-NOT 
                          LIST-FIND-IF-NOT LIST-FIND* VECTOR-FIND* CL:FIND FIND-IF FIND-IF-NOT)
                   (FUNCTIONS VECTOR-POSITION VECTOR-POSITION-IF LIST-POSITION LIST-POSITION-IF 
                          VECTOR-POSITION-IF-NOT LIST-POSITION-IF-NOT LIST-POSITION* VECTOR-POSITION* 
                          CL:POSITION POSITION-IF POSITION-IF-NOT)
                   (FUNCTIONS VECTOR-COUNT LIST-COUNT VECTOR-COUNT-IF LIST-COUNT-IF 
                          VECTOR-COUNT-IF-NOT LIST-COUNT-IF-NOT CL:COUNT COUNT-IF COUNT-IF-NOT)
                   (FUNCTIONS MATCH-VARS MATCHIFY-LIST IF-MISMATCH MUMBLE-MUMBLE-MISMATCH 
                          MUMBLE-LIST-MISMATCH LIST-MUMBLE-MISMATCH LIST-LIST-MISMATCH MISMATCH)
                   (FUNCTIONS COMPARE-ELEMENTS SEARCH-COMPARE-LIST-LIST SEARCH-COMPARE-LIST-VECTOR 
                          SEARCH-COMPARE-VECTOR-LIST SEARCH-COMPARE-VECTOR-VECTOR SEARCH-COMPARE 
                          LIST-SEARCH VECTOR-SEARCH SEARCH)
                   (DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
                          (ADDVARS (NLAMA)
                                 (NLAML)
                                 (LAMA BIT-VECTOR-TO-SIMPLE-BIT-VECTOR* STRING-TO-SIMPLE-STRING* 
                                       VECTOR-TO-BIT-VECTOR* VECTOR-TO-STRING* VECTOR-TO-VECTOR* 
                                       VECTOR-TO-LIST* LIST-TO-VECTOR* LIST-TO-BIT-VECTOR* 
                                       LIST-TO-STRING* CL:COERCE)))))
(DEFINE-CONDITION INDEX-BOUNDS-ERROR
 CELL-ERROR :REPORT (FORMAT T "Index out of bounds: ~D."
                                                               (INDEX-BOUNDS-ERROR-INDEX CONDITION))
                                           INDEX)

(DEFMACRO SEQ-DISPATCH
 (SEQUENCE LIST-FORM ARRAY-FORM) (BQUOTE (CL:IF (CL:LISTP (\, SEQUENCE))
                                                                      (\, LIST-FORM)
                                                                      (\, ARRAY-FORM))))

(DEFMACRO TYPE-SPECIFIER
 (TYPE) "Returns the broad class of which TYPE is a specific subclass."
   (BQUOTE (CL:IF (CL:ATOM (\, TYPE))
                  (\, TYPE)
                  (CAR (\, TYPE)))))

(DEFMACRO MAKE-SEQUENCE-LIKE
 (SEQUENCE LENGTH) 
                              "Returns a sequence of the same type as SEQUENCE and the given LENGTH."
   (BQUOTE (MAKE-SEQUENCE-OF-TYPE (TYPE-OF (\, SEQUENCE))
                  (\, LENGTH))))

(DEFMACRO CONCATENATE-TO-MUMBLE
 (OUTPUT-TYPE-SPEC SEQUENCES)
   (BQUOTE (CL:DO ((SEQS (\, SEQUENCES)
                         (CDR SEQS))
                   (TOTAL-LENGTH 0)
                   (LENGTHS NIL))
                  ((NULL SEQS)
                   (CL:DO ((SEQUENCES (\, SEQUENCES)
                                  (CDR SEQUENCES))
                           (LENGTHS LENGTHS (CDR LENGTHS))
                           (INDEX 0)
                           (RESULT (MAKE-SEQUENCE-OF-TYPE (\, OUTPUT-TYPE-SPEC)
                                          TOTAL-LENGTH)))
                          ((= INDEX TOTAL-LENGTH)
                           RESULT)
                          (LET ((SEQUENCE (CAR SEQUENCES)))
                               (SEQ-DISPATCH SEQUENCE (CL:DO ((SEQUENCE SEQUENCE (CDR SEQUENCE)))
                                                             ((CL:ATOM SEQUENCE))
                                                             (SETF (AREF RESULT INDEX)
                                                                   (CAR SEQUENCE))
                                                             (INCF INDEX))
                                      (CL:DO ((JNDEX 0 (1+ JNDEX)))
                                             ((= JNDEX (CAR LENGTHS)))
                                             (SETF (AREF RESULT INDEX)
                                                   (AREF SEQUENCE JNDEX))
                                             (INCF INDEX))))))
                  (LET ((LENGTH (CL:LENGTH (CAR SEQS))))
                       (SETQ LENGTHS (NCONC LENGTHS (LIST LENGTH)))
                       (INCF TOTAL-LENGTH LENGTH)))))




(* "Not used.")


(DEFINEQ

(CL:COERCE

  (CL:LAMBDA (OBJECT OUTPUT-TYPE-SPEC)
                       (* amd " 9-Jun-86 17:32")

         (COND
            ((TYPEP OBJECT OUTPUT-TYPE-SPEC)
             OBJECT)
            ((EQ OUTPUT-TYPE-SPEC (QUOTE CHARACTER))
             (CHARACTER OBJECT))
            ((NUMBERP OBJECT)
             (CASE OUTPUT-TYPE-SPEC ((SHORT-FLOAT SINGLE-FLOAT DOUBLE-FLOAT LONG-FLOAT)
                                     (FLOAT OBJECT))
                   (COMPLEX (CL:ERROR "Complex numbers not supported in current implementation."))
                   (T (CL:ERROR "~S can't be converted to type ~S." OBJECT OUTPUT-TYPE-SPEC))))
            (T (TYPECASE OBJECT (LIST (CASE (TYPE-SPECIFIER OUTPUT-TYPE-SPEC)
                                            ((SIMPLE-STRING STRING)
                                             (LIST-TO-STRING*
 OBJECT))
                                            ((SIMPLE-BIT-VECTOR BIT-VECTOR)
                                             (LIST-TO-BIT-VECTOR*
 OBJECT))
                                            ((SIMPLE-VECTOR VECTOR ARRAY SIMPLE-ARRAY)
                                             (LIST-TO-VECTOR*
 OBJECT OUTPUT-TYPE-SPEC))
                                            (T (CL:ERROR "Can't coerce ~S to type ~S." OBJECT 
                                                      OUTPUT-TYPE-SPEC))))
                      (SIMPLE-STRING (CASE (TYPE-SPECIFIER OUTPUT-TYPE-SPEC)
                                           (LIST (VECTOR-TO-LIST*
 OBJECT))
                                           ((SIMPLE-VECTOR VECTOR ARRAY SIMPLE-ARRAY)
                                            (VECTOR-TO-VECTOR*
 OBJECT OUTPUT-TYPE-SPEC))
                                           (T (CL:ERROR "Can't coerce ~S to type ~S." OBJECT 
                                                     OUTPUT-TYPE-SPEC))))
                      (SIMPLE-BIT-VECTOR (CASE (TYPE-SPECIFIER OUTPUT-TYPE-SPEC)
                                               (LIST (VECTOR-TO-LIST*
 OBJECT))
                                               ((SIMPLE-VECTOR VECTOR ARRAY SIMPLE-ARRAY)
                                                (VECTOR-TO-VECTOR*
 OBJECT OUTPUT-TYPE-SPEC))
                                               (T (CL:ERROR "Can't coerce ~S to type ~S." OBJECT 
                                                         OUTPUT-TYPE-SPEC))))
                      (SIMPLE-VECTOR (CASE (TYPE-SPECIFIER OUTPUT-TYPE-SPEC)
                                           (LIST (VECTOR-TO-LIST*
 OBJECT))
                                           ((SIMPLE-STRING STRING)
                                            (VECTOR-TO-STRING*
 OBJECT))
                                           ((SIMPLE-BIT-VECTOR BIT-VECTOR)
                                            (VECTOR-TO-BIT-VECTOR*
 OBJECT))
                                           ((VECTOR ARRAY SIMPLE-ARRAY)
                                            (VECTOR-TO-VECTOR*
 OBJECT OUTPUT-TYPE-SPEC))
                                           (T (CL:ERROR "Can't coerce ~S to type ~S." OBJECT 
                                                     OUTPUT-TYPE-SPEC))))
                      (STRING (CASE (TYPE-SPECIFIER OUTPUT-TYPE-SPEC)
                                    (LIST (VECTOR-TO-LIST*
 OBJECT))
                                    (SIMPLE-STRING (STRING-TO-SIMPLE-STRING*
 OBJECT))
                                    ((SIMPLE-VECTOR VECTOR SIMPLE-ARRAY ARRAY)
                                     (VECTOR-TO-VECTOR*
 OBJECT OUTPUT-TYPE-SPEC))
                                    (T (CL:ERROR "Can't coerce ~S to type ~S." OBJECT 
                                              OUTPUT-TYPE-SPEC))))
                      (BIT-VECTOR (CASE (TYPE-SPECIFIER OUTPUT-TYPE-SPEC)
                                        (LIST (VECTOR-TO-LIST*
 OBJECT))
                                        (SIMPLE-BIT-VECTOR (BIT-VECTOR-TO-SIMPLE-BIT-VECTOR*
 OBJECT))
                                        ((SIMPLE-VECTOR VECTOR ARRAY SIMPLE-ARRAY)
                                         (VECTOR-TO-VECTOR*
 OBJECT OUTPUT-TYPE-SPEC))
                                        (T (CL:ERROR "Can't coerce ~S to type ~S." OBJECT 
                                                  OUTPUT-TYPE-SPEC))))
                      (VECTOR (CASE (TYPE-SPECIFIER OUTPUT-TYPE-SPEC)
                                    (LIST (VECTOR-TO-LIST*
 OBJECT))
                                    ((SIMPLE-STRING STRING)
                                     (VECTOR-TO-STRING*
 OBJECT))
                                    ((SIMPLE-BIT-VECTOR BIT-VECTOR)
                                     (VECTOR-TO-BIT-VECTOR*
 OBJECT))
                                    ((SIMPLE-VECTOR VECTOR ARRAY SIMPLE-ARRAY)
                                     (VECTOR-TO-VECTOR*
 OBJECT OUTPUT-TYPE-SPEC))
                                    (T (CL:ERROR "Can't coerce ~S to type ~S." OBJECT 
                                              OUTPUT-TYPE-SPEC))))
                      (T (CL:ERROR "~S is an inappropriate type of object for coerce." OBJECT)))))))

(LIST-TO-STRING*

  (CL:LAMBDA (OBJECT)
                                        (* raf "17-Dec-85 22:41")

         (CL:DO* ((INDEX 0 (1+ INDEX))
                  (CL:LENGTH (LIST-LENGTH* OBJECT))
                  (RESULT (MAKE-STRING CL:LENGTH)))
                ((= INDEX CL:LENGTH)
                 RESULT)
                (SETF (SCHAR RESULT INDEX)
                      (pop
 OBJECT)))))

(LIST-TO-BIT-VECTOR*

  (CL:LAMBDA (OBJECT)
                                        (* raf "17-Dec-85 22:42")

         (CL:DO* ((INDEX 0 (1+ INDEX))
                  (CL:LENGTH (LIST-LENGTH* OBJECT))
                  (RESULT (MAKE-ARRAY CL:LENGTH :ELEMENT-TYPE (QUOTE (MOD 2)))))
                ((= INDEX CL:LENGTH)
                 RESULT)
                (DECLARE
 (TYPE FIXNUM CL:LENGTH))
                (SETF (SBIT RESULT INDEX)
                      (pop
 OBJECT)))))

(LIST-TO-VECTOR*

  (CL:LAMBDA (OBJECT TYPE)
                                   (* raf "17-Dec-85 22:42")

         (CL:DO* ((INDEX 0 (1+ INDEX))
                  (CL:LENGTH (LIST-LENGTH* OBJECT))
                  (RESULT (MAKE-SEQUENCE-OF-TYPE TYPE CL:LENGTH)))
                ((= INDEX CL:LENGTH)
                 RESULT)
                (SETF (AREF RESULT INDEX)
                      (pop
 OBJECT)))))

(VECTOR-TO-LIST*

  (CL:LAMBDA (OBJECT)
         (LET ((RESULT (LIST NIL))
               (CL:LENGTH (CL:LENGTH OBJECT)))
              (CL:DO ((INDEX 0 (1+ INDEX))
                      (SPLICE RESULT (CDR SPLICE)))
                     ((= INDEX CL:LENGTH)
                      (CDR RESULT))
                     (RPLACD SPLICE (LIST (AREF OBJECT INDEX)))))))

(VECTOR-TO-VECTOR*

  (CL:LAMBDA (OBJECT TYPE)
                                   (* raf "17-Dec-85 22:42")

         (CL:DO* ((INDEX 0 (1+ INDEX))
                  (CL:LENGTH (CL:LENGTH OBJECT))
                  (RESULT (MAKE-SEQUENCE-OF-TYPE TYPE CL:LENGTH)))
                ((= INDEX CL:LENGTH)
                 RESULT)
                (SETF (AREF RESULT INDEX)
                      (AREF OBJECT INDEX)))))

(VECTOR-TO-STRING*

  (CL:LAMBDA (OBJECT)
                                        (* raf "17-Dec-85 22:42")

         (CL:DO* ((INDEX 0 (1+ INDEX))
                  (CL:LENGTH (CL:LENGTH OBJECT))
                  (RESULT (MAKE-STRING CL:LENGTH)))
                ((= INDEX CL:LENGTH)
                 RESULT)
                (SETF (SCHAR RESULT INDEX)
                      (AREF OBJECT INDEX)))))

(VECTOR-TO-BIT-VECTOR*

  (CL:LAMBDA (OBJECT)
                                        (* raf "17-Dec-85 22:43")

         (CL:DO* ((INDEX 0 (1+ INDEX))
                  (CL:LENGTH (CL:LENGTH OBJECT))
                  (RESULT (MAKE-ARRAY CL:LENGTH :ELEMENT-TYPE (QUOTE (MOD 2)))))
                ((= INDEX CL:LENGTH)
                 RESULT)
                (DECLARE
 (TYPE FIXNUM CL:LENGTH))
                (SETF (SBIT RESULT INDEX)
                      (AREF OBJECT INDEX)))))

(STRING-TO-SIMPLE-STRING*

  (CL:LAMBDA (OBJECT)
                                        (* raf "18-Dec-85 01:52")

         (COND
            ((SIMPLE-STRING-P OBJECT)
             OBJECT)
            (T (CL:DO* ((LENGTH (CL:LENGTH OBJECT))
                        (SIMPLE-STRING (ALLOCSTRING LENGTH))
                        (I 0 (1+ I)))
                      ((= I LENGTH)
                       SIMPLE-STRING)
                      (SETF (AREF OBJECT I)
                            (AREF SIMPLE-STRING I)))))))

(BIT-VECTOR-TO-SIMPLE-BIT-VECTOR*

  (CL:LAMBDA (OBJECT)
                                        (* raf "18-Dec-85 01:53")

         (COND
            ((SIMPLE-BIT-VECTOR-P OBJECT)
             OBJECT)
            (T (CL:DO* ((LENGTH (CL:LENGTH OBJECT))
                        (SIMPLE-BIT-VECTOR (MAKE-ARRAY LENGTH :ELEMENT-TYPE (QUOTE BIT)))
                        (I 0 (1+ I)))
                      ((= I LENGTH)
                       SIMPLE-BIT-VECTOR)
                      (SETF (AREF OBJECT I)
                            (AREF SIMPLE-BIT-VECTOR I)))))))
)



(* "Left over.")



(PUTPROPS CL:EVERY DMACRO
 
          (DEFMACRO (FUNCTION
 &REST LISTS) (LET
                                            ((GENSYM (GENSYM))
                                             (TAIL-VARS (for X in LISTS collect (GENSYM))))
                                            (BQUOTE
                                             (LET
                                              (((\, GENSYM)
                                                T))
                                              (CL:DO
                                               ((\,@ (for X in LISTS as TAIL-VAR in TAIL-VARS collect
                                                          (LIST TAIL-VAR X (BQUOTE
                                                                            (CDR (\, TAIL-VAR)))))))
                                               ((NOT (AND (\,@ TAIL-VARS)))
                                                (\, GENSYM))
                                               (OR
                                                (SETQ
                                                 (\, GENSYM)
                                                 (AND
                                                  (\, GENSYM)
                                                  (FUNCALL
                                                   (\, FUNCTION)
                                                   (\,@ (for X in TAIL-VARS collect
                                                             (BQUOTE (CAR (\, X))))))))
                                                (RETURN NIL)))))) )
)



(* "Should be an optimizer")


(DEFUN MAKE-SEQUENCE-OF-TYPE
 (TYPE LENGTH) 
                  (* raf "27-Jan-86 17:30")

   (CASE (TYPE-SPECIFIER TYPE)
         (LIST (MAKE-LIST LENGTH))
         ((BIT-VECTOR SIMPLE-BIT-VECTOR)
          (MAKE-ARRAY LENGTH :ELEMENT-TYPE (QUOTE (MOD 2))))
         ((STRING SIMPLE-STRING)
          (MAKE-STRING LENGTH))
         (SIMPLE-VECTOR (MAKE-ARRAY LENGTH))
         ((ARRAY SIMPLE-ARRAY VECTOR)
          (CL:IF (CL:LISTP TYPE)
                 (MAKE-ARRAY LENGTH :ELEMENT-TYPE (CADR TYPE))
                 (MAKE-ARRAY LENGTH)))
         ((BIT-VECTOR SIMPLE-BIT-VECTOR)
          (MAKE-ARRAY LENGTH :ELEMENT-TYPE (QUOTE (MOD 2))))
         (T (CL:ERROR "~S is a bad type specifier for sequence functions." TYPE))))

(DEFUN CL:ELT
 (SEQUENCE INDEX) 
                              (* amd " 5-Jun-86 17:48")

   (CL:WHEN (< INDEX 0)
          (CL:ERROR (QUOTE INDEX-BOUNDS-ERROR)
                 :NAME SEQUENCE :INDEX INDEX))
   (SEQ-DISPATCH SEQUENCE (CL:DO ((COUNT
 INDEX (1- COUNT)))
                                 ((= COUNT 0)
                                  (CL:IF (ENDP SEQUENCE)
                                         (CL:ERROR (QUOTE INDEX-BOUNDS-ERROR)
                                                :NAME SEQUENCE :INDEX INDEX)
                                         (CAR SEQUENCE)))
                                 (CL:IF (ENDP SEQUENCE)
                                        (CL:ERROR (QUOTE INDEX-BOUNDS-ERROR)
                                               :NAME SEQUENCE :INDEX INDEX)
                                        (CL:POP SEQUENCE)))
          (CL:IF (>= INDEX (CL:LENGTH (THE VECTOR SEQUENCE)))
                 (CL:ERROR (QUOTE INDEX-BOUNDS-ERROR)
                        :NAME SEQUENCE :INDEX INDEX)
                 (AREF SEQUENCE INDEX))))

(DEFUN %%SETELT
 (SEQUENCE INDEX NEWVAL) 
                     (* raf "27-Jan-86 17:30")

   (CL:WHEN (< INDEX 0)
          (CL:ERROR (QUOTE INDEX-BOUNDS-ERROR)
                 :NAME SEQUENCE :INDEX INDEX))
   (SEQ-DISPATCH SEQUENCE (CL:DO ((COUNT
 INDEX (1- COUNT))
                                  (SEQ SEQUENCE))
                                 ((= COUNT 0)
                                  (CL:IF (ENDP SEQ)
                                         (CL:ERROR (QUOTE INDEX-BOUNDS-ERROR)
                                                :NAME SEQUENCE :INDEX INDEX)
                                         (RPLACA SEQ NEWVAL))
                                  NEWVAL)
                                 (CL:IF (ENDP (CDR SEQ))
                                        (CL:ERROR (QUOTE INDEX-BOUNDS-ERROR)
                                               :NAME SEQUENCE :INDEX INDEX)
                                        (CL:POP SEQ)))
          (CL:IF (>= INDEX (CL:LENGTH (THE VECTOR SEQUENCE)))
                 (CL:ERROR (QUOTE INDEX-BOUNDS-ERROR)
                        :NAME SEQUENCE :INDEX INDEX)
                 (SETF (AREF SEQUENCE INDEX)
                       NEWVAL))))

(DEFSETF CL:ELT
 %%SETELT)




(* "Should be removed from CMLSETF")


(DEFUN SUBSEQ
 (SEQUENCE START &OPTIONAL END) 
                (* amd " 2-May-86 13:41")

   (SEQ-DISPATCH SEQUENCE (LIST-SUBSEQ* SEQUENCE START END)
          (VECTOR-SUBSEQ* SEQUENCE START END)))

(DEFUN LIST-SUBSEQ*
 (SEQUENCE START &OPTIONAL END)
   (DECLARE
 (TYPE LIST SEQUENCE))
                            (* amd " 2-May-86 13:40")

   (CL:UNLESS (AND END (>= START END))
          (LET* ((GROVELED (NTHCDR START SEQUENCE))
                 (RESULT (LIST (CAR GROVELED))))
                (CL:WHEN GROVELED (CL:DO ((LIST (CDR GROVELED)
                                                (CDR LIST))
                                          (SPLICE RESULT (CDR (RPLACD SPLICE (LIST (CAR LIST)))))
                                          (INDEX (1+ START)
                                                 (1+ INDEX)))
                                         ((OR (ENDP LIST)
                                              (AND END (>= INDEX END)))
                                          RESULT))))))

(DEFUN VECTOR-SUBSEQ*
 (SEQUENCE START &OPTIONAL (END (CL:LENGTH SEQUENCE))) 

                                                             (* amd " 2-May-86 13:40")

   (DECLARE
 (TYPE VECTOR SEQUENCE))
   (CL:DO ((OLD-INDEX START (1+ OLD-INDEX))
           (NEW-INDEX 0 (1+ NEW-INDEX))
           (COPY (MAKE-SEQUENCE-LIKE SEQUENCE (- END START))))
          ((>= OLD-INDEX END)
           COPY)
          (SETF (AREF COPY NEW-INDEX)
                (AREF SEQUENCE OLD-INDEX))))

(DEFSETF SUBSEQ
 (SEQUENCE START &OPTIONAL END) (NEW-SEQUENCE)
                                               (BQUOTE (PROGN (CL:REPLACE (\, SEQUENCE)
                                                                     (\, NEW-SEQUENCE)
                                                                     :START1
                                                                     (\, START)
                                                                     :END1
                                                                     (\, END))
                                                              (\, NEW-SEQUENCE))))




(* "Should be removed from CMLSETF")


(DEFUN COPY-SEQ
 (SEQUENCE) "Returns a copy of SEQUENCE which is EQUALP to SEQUENCE but not EQ."
   (SEQ-DISPATCH SEQUENCE (LIST-COPY-SEQ* SEQUENCE)
          (VECTOR-COPY-SEQ* SEQUENCE)))

(DEFMACRO LIST-COPY-SEQ
 (LIST) (BQUOTE (APPEND (\, LIST))))

(DEFUN LIST-COPY-SEQ*
 (SEQUENCE) (LIST-COPY-SEQ SEQUENCE))

(DEFMACRO VECTOR-COPY-SEQ
 (SEQUENCE TYPE) (BQUOTE (LET ((LENGTH (CL:LENGTH (THE VECTOR (\, SEQUENCE))
                                                                       )))
                                                       (CL:DO ((INDEX 0 (1+ INDEX))
                                                               (COPY (MAKE-SEQUENCE-OF-TYPE
                                                                      (\, TYPE)
                                                                      LENGTH)))
                                                              ((= INDEX LENGTH)
                                                               COPY)
                                                              (SETF (AREF COPY INDEX)
                                                                    (AREF (\, SEQUENCE)
                                                                          INDEX))))))

(DEFUN VECTOR-COPY-SEQ*
 (SEQUENCE) (VECTOR-COPY-SEQ SEQUENCE (TYPE-OF SEQUENCE)))

(DEFUN CL:LENGTH
 (SEQUENCE) 
                                 (* lmm "25-Feb-86 13:06")

   (SEQ-DISPATCH SEQUENCE (LENGTH SEQUENCE)
          (CL:IF (ARRAY-HAS-FILL-POINTER-P (THE VECTOR SEQUENCE))
                 (FILL-POINTER SEQUENCE)
                 (CAR (ARRAY-DIMENSIONS SEQUENCE)))))

(DEFUN CL:REVERSE
 (SEQUENCE) 
                          "Returns a new sequence containing the same elements but in reverse order."
   (SEQ-DISPATCH SEQUENCE (REVERSE SEQUENCE)
          (VECTOR-REVERSE* SEQUENCE)))

(DEFMACRO LIST-REVERSE-MACRO
 (SEQUENCE) (BQUOTE (CL:DO ((NEW-LIST NIL))
                                                       ((ENDP (\, SEQUENCE))
                                                        NEW-LIST)
                                                       (CL:PUSH (CL:POP (\, SEQUENCE))
                                                              NEW-LIST))))

(DEFMACRO VECTOR-REVERSE
 (SEQUENCE TYPE) (BQUOTE (LET ((LENGTH (CL:LENGTH (\, SEQUENCE))))
                                                      (CL:DO ((FORWARD-INDEX 0 (1+ FORWARD-INDEX))
                                                              (BACKWARD-INDEX (1- LENGTH)
                                                                     (1- BACKWARD-INDEX))
                                                              (NEW-SEQUENCE (MAKE-SEQUENCE-OF-TYPE
                                                                             (\, TYPE)
                                                                             LENGTH)))
                                                             ((= FORWARD-INDEX LENGTH)
                                                              NEW-SEQUENCE)
                                                             (SETF (AREF NEW-SEQUENCE FORWARD-INDEX)
                                                                   (AREF (\, SEQUENCE)
                                                                         BACKWARD-INDEX))))))

(DEFUN VECTOR-REVERSE*
 (SEQUENCE) 
                           (* raf "18-Dec-85 00:07")

   (VECTOR-REVERSE SEQUENCE (TYPE-OF SEQUENCE)))

(DEFUN CL:NREVERSE
 (SEQUENCE) 
              "Returns a sequence of the same elements in reverse order (the argument is destroyed)."
   
                                                          (* kbr: "31-Aug-85 17:57")

   (SEQ-DISPATCH SEQUENCE (DREVERSE SEQUENCE)
          (VECTOR-NREVERSE* SEQUENCE)))

(DEFMACRO LIST-NREVERSE-MACRO
 (LIST) (BQUOTE (CL:DO ((1ST (CDR (\, LIST))
                                                          (COND
                                                             ((ENDP 1ST)
                                                              1ST)
                                                             (T (CDR 1ST))))
                                                     (2ND (\, LIST)
                                                          1ST)
                                                     (3RD (QUOTE NIL)
                                                          2ND))
                                                    ((ENDP 2ND)
                                                     3RD)
                                                    (RPLACD 2ND 3RD))))

(DEFUN LIST-NREVERSE*
 (SEQUENCE) (LIST-NREVERSE-MACRO SEQUENCE))

(DEFMACRO VECTOR-NREVERSE
 (SEQUENCE) (BQUOTE (LET ((LENGTH (CL:LENGTH (THE VECTOR (\, SEQUENCE)))))
                                                  (CL:DO ((LEFT-INDEX 0 (1+ LEFT-INDEX))
                                                          (RIGHT-INDEX (1- LENGTH)
                                                                 (1- RIGHT-INDEX))
                                                          (HALF-LENGTH (IQUOTIENT LENGTH 2)))
                                                         ((= LEFT-INDEX HALF-LENGTH)
                                                          (\, SEQUENCE))
                                                         (ROTATEF (AREF (\, SEQUENCE)
                                                                        LEFT-INDEX)
                                                                (AREF (\, SEQUENCE)
                                                                      RIGHT-INDEX))))))

(DEFUN VECTOR-NREVERSE*
 (SEQUENCE) (VECTOR-NREVERSE SEQUENCE))

(DEFUN MAKE-SEQUENCE
 (TYPE LENGTH &KEY INITIAL-ELEMENT) 
     (* raf "27-Jan-86 17:30")

   (CASE (TYPE-SPECIFIER TYPE)
         (LIST (MAKE-LIST LENGTH :INITIAL-ELEMENT INITIAL-ELEMENT))
         ((SIMPLE-STRING STRING)
          (LET ((STRING (MAKE-STRING LENGTH)))
               (CL:WHEN INITIAL-ELEMENT (CL:DO ((INDEX 0 (1+ INDEX)))
                                               ((= INDEX LENGTH)
                                                STRING)
                                               (SETF (CHAR (THE SIMPLE-STRING STRING)
                                                           INDEX)
                                                     INITIAL-ELEMENT)))
               STRING))
         (SIMPLE-VECTOR (MAKE-ARRAY LENGTH :INITIAL-ELEMENT INITIAL-ELEMENT))
         ((ARRAY VECTOR SIMPLE-ARRAY)
          (CL:IF (CL:LISTP TYPE)
                 (MAKE-ARRAY LENGTH :ELEMENT-TYPE (CADR TYPE)
                        :INITIAL-ELEMENT INITIAL-ELEMENT)
                 (MAKE-ARRAY LENGTH :INITIAL-ELEMENT INITIAL-ELEMENT)))
         ((BIT-VECTOR SIMPLE-BIT-VECTOR)
          (MAKE-ARRAY LENGTH :ELEMENT-TYPE (QUOTE (MOD 2))
                 :INITIAL-ELEMENT INITIAL-ELEMENT))
         (T (CL:ERROR "~S is a bad type specifier for sequences." TYPE))))

(DEFUN CONCATENATE
 (RESULT-TYPE &REST SEQUENCES) 
            (* kbr: "31-Aug-85 19:50")

                                                             (* 

                                                    "This should be (subtypep result-type 'sequence)")

   (CASE (TYPE-SPECIFIER RESULT-TYPE)
         (LIST (CL:APPLY (FUNCTION CONCAT-TO-LIST*)
                      SEQUENCES))
         ((SIMPLE-VECTOR SIMPLE-STRING VECTOR STRING ARRAY SIMPLE-ARRAY BIT-VECTOR SIMPLE-BIT-VECTOR)
          (CL:APPLY (FUNCTION CONCAT-TO-SIMPLE*)
                 RESULT-TYPE SEQUENCES))
         (T (CL:ERROR "~S: invalid output type specification." RESULT-TYPE))))

(DEFMACRO CONCATENATE-TO-LIST
 (SEQUENCES)
   (BQUOTE (LET ((RESULT (LIST NIL)))
                (CL:DO ((SEQUENCES (\, SEQUENCES)
                               (CDR SEQUENCES))
                        (SPLICE RESULT))
                       ((NULL SEQUENCES)
                        (CDR RESULT))
                       (LET ((SEQUENCE (CAR SEQUENCES)))
                            (SEQ-DISPATCH SEQUENCE (CL:DO ((SEQUENCE SEQUENCE (CDR SEQUENCE)))
                                                          ((ENDP SEQUENCE))
                                                          (SETQ SPLICE
                                                           (CDR (RPLACD SPLICE (CONS (CAR SEQUENCE)
                                                                                     NIL)))))
                                   (CL:DO ((INDEX 0 (1+ INDEX))
                                           (LENGTH (CL:LENGTH SEQUENCE)))
                                          ((= INDEX LENGTH))
                                          (SETQ SPLICE (CDR (RPLACD SPLICE (CONS (AREF SEQUENCE INDEX
                                                                                       )
                                                                                 NIL)))))))))))

(DEFUN CONCAT-TO-LIST*
 (&REST SEQUENCES) (CONCATENATE-TO-LIST SEQUENCES))

(DEFUN CONCAT-TO-SIMPLE*
 (RESULT-TYPE &REST SEQUENCES) 
      (* kbr: " 1-Sep-85 19:21")

   (CL:DO ((SEQS SEQUENCES (CDR SEQS))
           (TOTAL-LENGTH 0)
           (LENGTHS NIL))
          ((NULL SEQS)
           (CL:DO ((SEQUENCES SEQUENCES (CDR SEQUENCES))
                   (LENGTHS LENGTHS (CDR LENGTHS))
                   (INDEX 0)
                   (RESULT (MAKE-SEQUENCE-OF-TYPE RESULT-TYPE TOTAL-LENGTH)))
                  ((= INDEX TOTAL-LENGTH)
                   RESULT)
                  (CL:SETQ LENGTHS (REVERSE LENGTHS))
                  (LET ((SEQUENCE (CAR SEQUENCES)))
                       (SEQ-DISPATCH SEQUENCE (CL:DO ((SEQUENCE SEQUENCE (CDR SEQUENCE)))
                                                     ((ENDP SEQUENCE))
                                                     (SETF (AREF RESULT INDEX)
                                                           (CAR SEQUENCE))
                                                     (INCF INDEX))
                              (CL:DO ((JNDEX 0 (1+ JNDEX)))
                                     ((= JNDEX (CAR LENGTHS)))
                                     (SETF (AREF RESULT INDEX)
                                           (AREF SEQUENCE JNDEX))
                                     (INCF INDEX))))))
          (LET ((LENGTH (CL:LENGTH (CAR SEQS))))
               (CL:PUSH LENGTH LENGTHS)
               (INCF TOTAL-LENGTH LENGTH))))

(DEFMACRO ELT-SLICE
 (SEQUENCES N) (BQUOTE (CL:MAPCAR (FUNCTION (CL:LAMBDA (SEQ)
                                                                      (CL:ELT SEQ (\, N))))
                                                 (\, SEQUENCES))))

(DEFMACRO MAP-FOR-EFFECT
 (FUNCTION SEQUENCES) (BQUOTE (CL:DO ((SEQS MORE-SEQUENCES (CDR SEQS))
                                                              (MIN-LENGTH (CL:LENGTH FIRST-SEQUENCE))
                                                              )
                                                             ((NULL SEQS)
                                                              (CL:DO ((INDEX 0 (1+ INDEX)))
                                                                     ((= INDEX MIN-LENGTH)
                                                                      NIL)
                                                                     (CL:APPLY (\, FUNCTION)
                                                                            (ELT-SLICE (\, SEQUENCES)
                                                                                   INDEX))))
                                                             (LET ((LENGTH (CL:LENGTH (CAR SEQS))))
                                                                  (CL:WHEN (< LENGTH MIN-LENGTH)
                                                                         (SETQ MIN-LENGTH LENGTH))))))

(DEFMACRO MAP-TO-LIST
 (FN SEQUENCES)                         (* 

                              "used to be 'function', but the prettyprinter does bad things to that.")

   (BQUOTE (CL:DO ((SEQS MORE-SEQUENCES (CDR SEQS))
                   (MIN-LENGTH (CL:LENGTH FIRST-SEQUENCE)))
                  ((NULL SEQS)
                   (LET ((RESULT (LIST NIL)))
                        (CL:DO ((INDEX 0 (1+ INDEX))
                                (SPLICE RESULT))
                               ((= INDEX MIN-LENGTH)
                                (CDR RESULT))
                               (SETQ SPLICE (CDR (RPLACD SPLICE (CONS (CL:APPLY (\, FN)
                                                                             (ELT-SLICE (\, SEQUENCES
                                                                                            )
                                                                                    INDEX))
                                                                      NIL)))))))
                  (LET ((LENGTH (CL:LENGTH (CAR SEQS))))
                       (CL:WHEN (< LENGTH MIN-LENGTH)
                              (CL:SETQ MIN-LENGTH LENGTH))))))

(DEFMACRO MAP-TO-SIMPLE
 (OUTPUT-TYPE-SPEC FUNCTION SEQUENCES)
   (BQUOTE (CL:DO ((SEQS MORE-SEQUENCES (CDR SEQS))
                   (MIN-LENGTH (CL:LENGTH FIRST-SEQUENCE)))
                  ((NULL SEQS)
                   (CL:DO ((INDEX 0 (1+ INDEX))
                           (RESULT (MAKE-SEQUENCE-OF-TYPE (\, OUTPUT-TYPE-SPEC)
                                          MIN-LENGTH)))
                          ((= INDEX MIN-LENGTH)
                           RESULT)
                          (SETF (AREF RESULT INDEX)
                                (CL:APPLY (\, FUNCTION)
                                       (ELT-SLICE (\, SEQUENCES)
                                              INDEX)))))
                  (LET ((LENGTH (CL:LENGTH (CAR SEQS))))
                       (CL:WHEN (< LENGTH MIN-LENGTH)
                              (SETQ MIN-LENGTH LENGTH))))))

(DEFUN CL:MAP
 (RESULT-TYPE FUNCTION FIRST-SEQUENCE &REST MORE-SEQUENCES) 

                                                             (* amd " 5-Jun-86 19:17")

   "FUNCTION must take as many arguments as there are sequences provided.  The result is a sequence such that element i is the result of applying FUNCTION to element i of each of the argument sequences."
   (LET ((SEQUENCES (CONS FIRST-SEQUENCE MORE-SEQUENCES)))
        (CASE (TYPE-SPECIFIER RESULT-TYPE)
              (NIL (MAP-FOR-EFFECT FUNCTION SEQUENCES))
              (LIST (MAP-TO-LIST FUNCTION SEQUENCES))
              ((SIMPLE-VECTOR SIMPLE-STRING VECTOR STRING ARRAY SIMPLE-ARRAY BIT-VECTOR 
                      SIMPLE-BIT-VECTOR)
               (MAP-TO-SIMPLE RESULT-TYPE FUNCTION SEQUENCES))
              (T (CL:ERROR "~S: invalid output type specifier." RESULT-TYPE)))))

(DEFUN CL:SOME
 (PREDICATE FIRST-SEQUENCE &REST MORE-SEQUENCES) "PREDICATE is applied to the elements with index 0 of the sequences, then possibly to those with index 1, and so on.  SOME returns the first non-() value encountered, or () if the end of a sequence is reached."
   (CL:DO ((SEQS MORE-SEQUENCES (CDR SEQS))
           (LENGTH (CL:LENGTH FIRST-SEQUENCE))
           (SEQUENCES (CONS FIRST-SEQUENCE MORE-SEQUENCES)))
          ((NULL SEQS)
           (CL:DO ((INDEX 0 (1+ INDEX)))
                  ((= INDEX LENGTH)
                   NIL)
                  (LET ((RESULT (CL:APPLY PREDICATE (ELT-SLICE SEQUENCES INDEX))))
                       (CL:WHEN RESULT (RETURN RESULT)))))
          (LET ((THIS (CL:LENGTH (CAR SEQS))))
               (CL:WHEN (< THIS LENGTH)
                      (SETQ LENGTH THIS)))))

(DEFUN CL:EVERY
 (PREDICATE FIRST-SEQUENCE &REST MORE-SEQUENCES) "PREDICATE is applied to the elements with index 0 of the sequences, then possibly to those with index 1, and so on.  EVERY returns () as soon as any invocation of PREDICATE returns (), or T if every invocation is non-()."
   (CL:DO ((SEQS MORE-SEQUENCES (CDR SEQS))
           (LENGTH (CL:LENGTH FIRST-SEQUENCE))
           (SEQUENCES (CONS FIRST-SEQUENCE MORE-SEQUENCES)))
          ((NULL SEQS)
           (CL:DO ((INDEX 0 (1+ INDEX)))
                  ((= INDEX LENGTH)
                   T)
                  (LET ((RESULT (CL:APPLY PREDICATE (ELT-SLICE SEQUENCES INDEX))))
                       (CL:UNLESS RESULT (RETURN NIL)))))
          (LET ((THIS (CL:LENGTH (CAR SEQS))))
               (CL:WHEN (< THIS LENGTH)
                      (SETQ LENGTH THIS)))))

(DEFUN CL:NOTANY
 (PREDICATE FIRST-SEQUENCE &REST MORE-SEQUENCES) "PREDICATE is applied to the elements with index 0 of the sequences, then possibly to those with index 1, and so on.  NOTANY returns () as soon as any invocation of PREDICATE returns a non-() value, or T if the end of a sequence is reached."
   (CL:DO ((SEQS MORE-SEQUENCES (CDR SEQS))
           (LENGTH (CL:LENGTH FIRST-SEQUENCE))
           (SEQUENCES (CONS FIRST-SEQUENCE MORE-SEQUENCES)))
          ((NULL SEQS)
           (CL:DO ((INDEX 0 (1+ INDEX)))
                  ((= INDEX LENGTH)
                   T)
                  (LET ((RESULT (CL:APPLY PREDICATE (ELT-SLICE SEQUENCES INDEX))))
                       (CL:WHEN RESULT (RETURN NIL)))))
          (LET ((THIS (CL:LENGTH (CAR SEQS))))
               (CL:WHEN (< THIS LENGTH)
                      (SETQ LENGTH THIS)))))

(DEFUN CL:NOTEVERY
 (PREDICATE FIRST-SEQUENCE &REST MORE-SEQUENCES) "PREDICATE is applied to the elements with index 0 of the sequences, then possibly to those with index 1, and so on.  NOTEVERY returns T as soon as any invocation of PREDICATE returns (), or () if every invocation is non-()."
   (CL:DO ((SEQS MORE-SEQUENCES (CDR SEQS))
           (LENGTH (CL:LENGTH FIRST-SEQUENCE))
           (SEQUENCES (CONS FIRST-SEQUENCE MORE-SEQUENCES)))
          ((NULL SEQS)
           (CL:DO ((INDEX 0 (1+ INDEX)))
                  ((= INDEX LENGTH)
                   NIL)
                  (LET ((RESULT (CL:APPLY PREDICATE (ELT-SLICE SEQUENCES INDEX))))
                       (CL:UNLESS RESULT (RETURN T)))))
          (LET ((THIS (CL:LENGTH (CAR SEQS))))
               (CL:WHEN (< THIS LENGTH)
                      (SETQ LENGTH THIS)))))

(DEFMACRO LIST-REDUCE-FROM-END
 (FUNCTION SEQUENCE START END INITIAL-VALUE INITIAL-PROVIDED)
   (BQUOTE (LET ((SEQUENCE (NTHCDR (- (CL:LENGTH (\, SEQUENCE))
                                      (\, END))
                                  (REVERSE (\, SEQUENCE)))))
                (CL:WHEN (\, INITIAL-PROVIDED)
                       (CL:PUSH (\, INITIAL-VALUE)
                              SEQUENCE))
                (CL:DO* ((COUNT
 (- (\, END)
                                   (\, START)
                                   (CL:IF (\, INITIAL-PROVIDED)
                                          0 1))
                                (1- COUNT))
                         (SEQUENCE SEQUENCE (CDR SEQUENCE))
                         (VALUE (CAR SEQUENCE)
                                (FUNCALL (\, FUNCTION)
                                       (CAR SEQUENCE)
                                       VALUE)))
                       ((= COUNT 0)
                        VALUE)))))

(DEFMACRO LIST-REDUCE
 (FUNCTION SEQUENCE START END INITIAL-VALUE INITIAL-PROVIDED)
   (BQUOTE (LET ((SEQUENCE (NTHCDR (\, START)
                                  (\, SEQUENCE))))
                (CL:WHEN (\, INITIAL-PROVIDED)
                       (CL:PUSH (\, INITIAL-VALUE)
                              SEQUENCE))
                (CL:DO* ((COUNT
 (- END START (CL:IF (\, INITIAL-PROVIDED)
                                                    0 1))
                                (1- COUNT))
                         (SEQUENCE SEQUENCE (CDR SEQUENCE))
                         (VALUE (CAR SEQUENCE)
                                (FUNCALL (\, FUNCTION)
                                       VALUE
                                       (CAR SEQUENCE))))
                       ((= COUNT 0)
                        VALUE)))))

(DEFMACRO MUMBLE-REDUCE-FROM-END
 (FUNCTION SEQUENCE START END INITIAL-VALUE REF)
   (BQUOTE (CL:DO ((INDEX (1- (\, END))
                          (1- INDEX))
                   (VALUE (\, INITIAL-VALUE))
                   (TERMINUS (1- (\, START))))
                  ((<= INDEX TERMINUS)
                   VALUE)
                  (SETQ VALUE (FUNCALL (\, FUNCTION)
                                     ((\, REF)
                                      (\, SEQUENCE)
                                      INDEX)
                                     VALUE)))))

(DEFMACRO MUMBLE-REDUCE
 (FUNCTION SEQUENCE START END INITIAL-VALUE REF)
   (BQUOTE (CL:DO ((INDEX (\, START)
                          (1+ INDEX))
                   (VALUE (\, INITIAL-VALUE)))
                  ((>= INDEX (\, END))
                   VALUE)
                  (SETQ VALUE (FUNCALL (\, FUNCTION)
                                     VALUE
                                     ((\, REF)
                                      (\, SEQUENCE)
                                      INDEX))))))

(DEFUN REDUCE
 (FUNCTION SEQUENCE &KEY FROM-END (START 0)
                     (END (CL:LENGTH SEQUENCE))
                     (INITIAL-VALUE NIL INITIAL-PROVIDED)) 
  (* raf "28-Apr-86 18:01")

   (COND
      ((<= END START)
       (CL:IF INITIAL-PROVIDED INITIAL-VALUE (FUNCALL FUNCTION)))
      ((CL:LISTP SEQUENCE)
       (CL:IF FROM-END (LIST-REDUCE-FROM-END FUNCTION SEQUENCE START END INITIAL-VALUE 
                              INITIAL-PROVIDED)
              (LIST-REDUCE FUNCTION SEQUENCE START END INITIAL-VALUE INITIAL-PROVIDED)))
      (T (COND
            (FROM-END (CL:UNLESS INITIAL-PROVIDED (CL:SETQ END (1- END)
                                                         INITIAL-VALUE
                                                         (AREF SEQUENCE END)))
                   (MUMBLE-REDUCE-FROM-END FUNCTION SEQUENCE START END INITIAL-VALUE AREF))
            (T (CL:UNLESS INITIAL-PROVIDED (CL:SETQ INITIAL-VALUE (AREF SEQUENCE START)
                                                  START
                                                  (1+ START)))
               (MUMBLE-REDUCE FUNCTION SEQUENCE START END INITIAL-VALUE AREF))))))

(DEFUN FILL
 (SEQUENCE ITEM &KEY (START 0)
                   (END (CL:LENGTH SEQUENCE))) 
                                              "Replace the specified elements of SEQUENCE with ITEM."
   (SEQ-DISPATCH SEQUENCE (LIST-FILL* SEQUENCE ITEM START END)
          (VECTOR-FILL* SEQUENCE ITEM START END)))

(DEFMACRO LIST-FILL
 (SEQUENCE ITEM START END) (BQUOTE (CL:DO ((CURRENT (NTHCDR (\, START)
                                                                              (\, SEQUENCE))
                                                                     (CDR CURRENT))
                                                              (INDEX (\, START)
                                                                     (1+ INDEX)))
                                                             ((OR (ENDP CURRENT)
                                                                  (>= INDEX (\, END)))
                                                              SEQUENCE)
                                                             (RPLACA CURRENT (\, ITEM)))))

(DEFUN LIST-FILL*
 (SEQUENCE ITEM START END) 
                 (* raf "17-Dec-85 22:37")
 (LIST-FILL
                                                                                        SEQUENCE ITEM 
                                                                                        START END))

(DEFMACRO VECTOR-FILL
 (SEQUENCE ITEM START END) (BQUOTE (CL:DO ((INDEX (\, START)
                                                                       (1+ INDEX)))
                                                               ((>= INDEX (\, END))
                                                                (\, SEQUENCE))
                                                               (SETF (AREF (\, SEQUENCE)
                                                                           INDEX)
                                                                     (\, ITEM)))))

(DEFUN VECTOR-FILL*
 (SEQUENCE ITEM START END) 
               (* raf "17-Dec-85 22:37")
 (VECTOR-FILL
                                                                                        SEQUENCE ITEM 
                                                                                        START END))

(DEFMACRO MUMBLE-REPLACE-FROM-MUMBLE
 NIL (BQUOTE (CL:IF (AND (EQ TARGET-SEQUENCE SOURCE-SEQUENCE)
                                                             (> TARGET-START SOURCE-START))
                                                        (LET ((NELTS (MIN (- TARGET-END TARGET-START)
                                                                          (- SOURCE-END SOURCE-START)
                                                                          )))
                                                             (CL:DO ((TARGET-INDEX (+ TARGET-START 
                                                                                      NELTS -1)
                                                                            (1- TARGET-INDEX))
                                                                     (SOURCE-INDEX (+ SOURCE-START 
                                                                                      NELTS -1)
                                                                            (1- SOURCE-INDEX)))
                                                                    ((< TARGET-INDEX TARGET-START)
                                                                     TARGET-SEQUENCE)
                                                                    (SETF (AREF TARGET-SEQUENCE 
                                                                                TARGET-INDEX)
                                                                          (AREF SOURCE-SEQUENCE 
                                                                                SOURCE-INDEX))))
                                                        (CL:DO ((TARGET-INDEX TARGET-START
                                                                       (1+ TARGET-INDEX))
                                                                (SOURCE-INDEX SOURCE-START
                                                                       (1+ SOURCE-INDEX)))
                                                               ((OR (>= TARGET-INDEX TARGET-END)
                                                                    (>= SOURCE-INDEX SOURCE-END))
                                                                TARGET-SEQUENCE)
                                                               (SETF (AREF TARGET-SEQUENCE 
                                                                           TARGET-INDEX)
                                                                     (AREF SOURCE-SEQUENCE 
                                                                           SOURCE-INDEX))))))

(DEFMACRO LIST-REPLACE-FROM-LIST
 NIL (BQUOTE (COND
                                                ((AND (EQ TARGET-SEQUENCE SOURCE-SEQUENCE)
                                                      (> TARGET-START SOURCE-START))
                                                 (LET ((NEW-ELTS (SUBSEQ SOURCE-SEQUENCE SOURCE-START
                                                                        (+ SOURCE-START
                                                                           (MIN (- TARGET-END 
                                                                                   TARGET-START)
                                                                                (- SOURCE-END 
                                                                                   SOURCE-START))))))
                                                      (CL:DO ((N NEW-ELTS (CDR N))
                                                              (O (NTHCDR TARGET-START TARGET-SEQUENCE
                                                                        )
                                                                 (CDR O)))
                                                             ((ENDP N)
                                                              TARGET-SEQUENCE)
                                                             (RPLACA O (CAR N)))))
                                                (T (CL:DO ((TARGET-INDEX TARGET-START (1+ 
                                                                                         TARGET-INDEX
                                                                                          ))
                                                           (SOURCE-INDEX SOURCE-START (1+ 
                                                                                         SOURCE-INDEX
                                                                                          ))
                                                           (TARGET-SEQUENCE-REF (NTHCDR TARGET-START 
                                                                                      TARGET-SEQUENCE
                                                                                       )
                                                                  (CDR TARGET-SEQUENCE-REF))
                                                           (SOURCE-SEQUENCE-REF (NTHCDR SOURCE-START 
                                                                                      SOURCE-SEQUENCE
                                                                                       )
                                                                  (CDR SOURCE-SEQUENCE-REF)))
                                                          ((OR (>= TARGET-INDEX TARGET-END)
                                                               (>= SOURCE-INDEX SOURCE-END)
                                                               (NULL TARGET-SEQUENCE-REF)
                                                               (NULL SOURCE-SEQUENCE-REF))
                                                           TARGET-SEQUENCE)
                                                          (RPLACA TARGET-SEQUENCE-REF (CAR 
                                                                                  SOURCE-SEQUENCE-REF
                                                                                           )))))))

(DEFMACRO LIST-REPLACE-FROM-MUMBLE
 NIL (BQUOTE (CL:DO ((TARGET-INDEX TARGET-START (1+ TARGET-INDEX))
                                                       (SOURCE-INDEX SOURCE-START (1+ SOURCE-INDEX))
                                                       (TARGET-SEQUENCE-REF (NTHCDR TARGET-START 
                                                                                   TARGET-SEQUENCE)
                                                              (CDR TARGET-SEQUENCE-REF)))
                                                      ((OR (>= TARGET-INDEX TARGET-END)
                                                           (>= SOURCE-INDEX SOURCE-END)
                                                           (ENDP TARGET-SEQUENCE-REF))
                                                       TARGET-SEQUENCE)
                                                      (RPLACA TARGET-SEQUENCE-REF (AREF 
                                                                                      SOURCE-SEQUENCE 
                                                                                        SOURCE-INDEX)
                                                             ))))

(DEFMACRO MUMBLE-REPLACE-FROM-LIST
 NIL (BQUOTE (CL:DO ((TARGET-INDEX TARGET-START (1+ TARGET-INDEX))
                                                       (SOURCE-INDEX SOURCE-START (1+ SOURCE-INDEX))
                                                       (SOURCE-SEQUENCE (NTHCDR SOURCE-START 
                                                                               SOURCE-SEQUENCE)
                                                              (CDR SOURCE-SEQUENCE)))
                                                      ((OR (>= TARGET-INDEX TARGET-END)
                                                           (>= SOURCE-INDEX SOURCE-END)
                                                           (ENDP SOURCE-SEQUENCE))
                                                       TARGET-SEQUENCE)
                                                      (SETF (AREF TARGET-SEQUENCE TARGET-INDEX)
                                                            (CAR SOURCE-SEQUENCE)))))

(DEFUN CL:REPLACE
 (TARGET-SEQUENCE SOURCE-SEQUENCE &KEY ((:START1 TARGET-START)
                                                         0)
                         ((:END1 TARGET-END (CL:LENGTH TARGET-SEQUENCE)))
                         ((:START2 SOURCE-START)
                          0)
                         ((:END2 SOURCE-END (CL:LENGTH SOURCE-SEQUENCE)))) 

                                                             (* jrb: "23-Apr-86 11:00")

   (SEQ-DISPATCH TARGET-SEQUENCE (SEQ-DISPATCH SOURCE-SEQUENCE (LIST-REPLACE-FROM-LIST)
                                        (LIST-REPLACE-FROM-MUMBLE))
          (SEQ-DISPATCH SOURCE-SEQUENCE (MUMBLE-REPLACE-FROM-LIST)
                 (MUMBLE-REPLACE-FROM-MUMBLE))))

(DEFUN LIST-REPLACE-FROM-LIST*
 (TARGET-SEQUENCE SOURCE-SEQUENCE TARGET-START TARGET-END SOURCE-START 
                                      SOURCE-END) (COND
                                                     ((NULL TARGET-END)
                                                      (SETQ TARGET-END (CL:LENGTH TARGET-SEQUENCE))))
                                                  (COND
                                                     ((NULL SOURCE-END)
                                                      (SETQ SOURCE-END (CL:LENGTH SOURCE-SEQUENCE))))
                                                  (LIST-REPLACE-FROM-LIST))

(DEFUN LIST-REPLACE-FROM-VECTOR*
 (TARGET-SEQUENCE SOURCE-SEQUENCE TARGET-START TARGET-END 
                                        SOURCE-START SOURCE-END) (COND
                                                                    ((NULL TARGET-END)
                                                                     (SETQ TARGET-END (CL:LENGTH
                                                                                       
                                                                                      TARGET-SEQUENCE
                                                                                       ))))
                                                                 (COND
                                                                    ((NULL SOURCE-END)
                                                                     (SETQ SOURCE-END (CL:LENGTH
                                                                                       
                                                                                      SOURCE-SEQUENCE
                                                                                       ))))
                                                                 (LIST-REPLACE-FROM-MUMBLE))

(DEFUN VECTOR-REPLACE-FROM-LIST*
 (TARGET-SEQUENCE SOURCE-SEQUENCE TARGET-START TARGET-END 
                                        SOURCE-START SOURCE-END) (COND
                                                                    ((NULL TARGET-END)
                                                                     (SETQ TARGET-END (CL:LENGTH
                                                                                       
                                                                                      TARGET-SEQUENCE
                                                                                       ))))
                                                                 (COND
                                                                    ((NULL SOURCE-END)
                                                                     (SETQ SOURCE-END (CL:LENGTH
                                                                                       
                                                                                      SOURCE-SEQUENCE
                                                                                       ))))
                                                                 (MUMBLE-REPLACE-FROM-LIST))

(DEFUN VECTOR-REPLACE-FROM-VECTOR*
 (TARGET-SEQUENCE SOURCE-SEQUENCE TARGET-START TARGET-END 
                                          SOURCE-START SOURCE-END) (COND
                                                                      ((NULL TARGET-END)
                                                                       (SETQ TARGET-END (CL:LENGTH
                                                                                         
                                                                                      TARGET-SEQUENCE
                                                                                         ))))
                                                                   (COND
                                                                      ((NULL SOURCE-END)
                                                                       (SETQ SOURCE-END (CL:LENGTH
                                                                                         
                                                                                      SOURCE-SEQUENCE
                                                                                         ))))
                                                                   (MUMBLE-REPLACE-FROM-MUMBLE))

(DEFMACRO MUMBLE-DELETE
 (PRED) (BQUOTE (CL:DO ((INDEX START (1+ INDEX))
                                               (JNDEX START)
                                               (NUMBER-ZAPPED 0))
                                              ((OR (= INDEX END)
                                                   (= NUMBER-ZAPPED COUNT))
                                               (CL:DO ((INDEX INDEX (1+ INDEX))
                                                       (JNDEX JNDEX (1+ JNDEX)))
                                                      ((= INDEX LENGTH)
                                                       (SHRINK-VECTOR SEQUENCE JNDEX))
                                                      (SETF (AREF SEQUENCE JNDEX)
                                                            (AREF SEQUENCE INDEX))))
                                              (SETF (AREF SEQUENCE JNDEX)
                                                    (AREF SEQUENCE INDEX))
                                              (CL:IF (\, PRED)
                                                     (INCF NUMBER-ZAPPED)
                                                     (INCF JNDEX)))))

(DEFMACRO MUMBLE-DELETE-FROM-END
 (PRED) (BQUOTE (CL:DO ((INDEX (1- END)
                                                               (1- INDEX))
                                                        (NUMBER-ZAPPED 0)
                                                        (LOSERS NIL)
                                                        (TERMINUS (1- START)))
                                                       ((OR (= INDEX TERMINUS)
                                                            (= NUMBER-ZAPPED COUNT))
                                                        (CL:DO ((LOSERS LOSERS)
                                                                (INDEX START (1+ INDEX))
                                                                (JNDEX START))
                                                               ((OR (NULL LOSERS)
                                                                    (= INDEX END))
                                                                (CL:DO ((INDEX INDEX (1+ INDEX))
                                                                        (JNDEX JNDEX (1+ JNDEX)))
                                                                       ((= INDEX LENGTH)
                                                                        (SHRINK-VECTOR SEQUENCE JNDEX
                                                                               ))
                                                                       (SETF (AREF SEQUENCE JNDEX)
                                                                             (AREF SEQUENCE INDEX))))
                                                               (SETF (AREF SEQUENCE JNDEX)
                                                                     (AREF SEQUENCE INDEX))
                                                               (CL:IF (= INDEX (CAR LOSERS))
                                                                      (CL:POP LOSERS)
                                                                      (INCF JNDEX))))
                                                       (LET ((THIS-ELEMENT (AREF SEQUENCE INDEX)))
                                                            (COND
                                                               ((\, PRED)
                                                                (INCF NUMBER-ZAPPED)
                                                                (CL:PUSH INDEX LOSERS)))))))

(DEFMACRO LIST-DELETE
 (PRED) (BQUOTE (LET ((HANDLE (CONS NIL SEQUENCE)))
                                          (CL:DO ((CURRENT (NTHCDR START SEQUENCE)
                                                         (CDR CURRENT))
                                                  (PREVIOUS (NTHCDR START HANDLE))
                                                  (INDEX START (1+ INDEX))
                                                  (NUMBER-ZAPPED 0))
                                                 ((OR (= INDEX END)
                                                      (= NUMBER-ZAPPED COUNT))
                                                  (CDR HANDLE))
                                                 (COND
                                                    ((\, PRED)
                                                     (RPLACD PREVIOUS (CDR CURRENT))
                                                     (INCF NUMBER-ZAPPED))
                                                    (T (CL:POP PREVIOUS)))))))

(DEFMACRO LIST-DELETE-FROM-END
 (PRED) (BQUOTE (LET* ((REVERSE (REVERSE SEQUENCE))
                                                     (HANDLE (CONS NIL REVERSE)))
                                                    (CL:DO ((CURRENT (NTHCDR (- LENGTH END)
                                                                            REVERSE)
                                                                   (CDR CURRENT))
                                                            (PREVIOUS (NTHCDR (- LENGTH END)
                                                                             HANDLE))
                                                            (INDEX START (1+ INDEX))
                                                            (NUMBER-ZAPPED 0))
                                                           ((OR (= INDEX END)
                                                                (= NUMBER-ZAPPED COUNT))
                                                            (REVERSE (CDR HANDLE)))
                                                           (COND
                                                              ((\, PRED)
                                                               (RPLACD PREVIOUS (CDR CURRENT))
                                                               (INCF NUMBER-ZAPPED))
                                                              (T (CL:POP PREVIOUS)))))))

(DEFMACRO NORMAL-MUMBLE-DELETE
 NIL (BQUOTE (MUMBLE-DELETE (CL:IF TEST-NOT
                                                                 (NOT (FUNCALL TEST-NOT ITEM
                                                                             (FUNCALL KEY
                                                                                    (AREF SEQUENCE 
                                                                                          INDEX))))
                                                                 (FUNCALL TEST ITEM
                                                                        (FUNCALL KEY (AREF SEQUENCE 
                                                                                           INDEX)))))
                                          ))

(DEFMACRO NORMAL-MUMBLE-DELETE-FROM-END
 NIL (BQUOTE (MUMBLE-DELETE-FROM-END
                                                     (CL:IF TEST-NOT (NOT (FUNCALL TEST-NOT ITEM
                                                                                 (FUNCALL KEY 
                                                                                        THIS-ELEMENT)
                                                                                 ))
                                                            (FUNCALL TEST ITEM (FUNCALL KEY 
                                                                                      THIS-ELEMENT)))
                                                     )))

(DEFMACRO NORMAL-LIST-DELETE
 NIL (QUOTE (LIST-DELETE (CL:IF TEST-NOT
                                                            (NOT (FUNCALL TEST-NOT ITEM
                                                                        (FUNCALL KEY (CAR CURRENT))))
                                                            (FUNCALL TEST ITEM (FUNCALL KEY
                                                                                      (CAR CURRENT)))
                                                            ))))

(DEFMACRO NORMAL-LIST-DELETE-FROM-END
 NIL (QUOTE (LIST-DELETE-FROM-END
                                                  (CL:IF TEST-NOT (NOT (FUNCALL TEST-NOT ITEM
                                                                              (FUNCALL KEY
                                                                                     (CAR CURRENT))))
                                                         (FUNCALL TEST ITEM (FUNCALL KEY (CAR CURRENT
                                                                                              )))))))

(DEFUN CL:DELETE
 (ITEM SEQUENCE &KEY FROM-END (TEST (FUNCTION EQL))
                       TEST-NOT
                       (START 0)
                       (END (CL:LENGTH SEQUENCE))
                       (COUNT MOST-POSITIVE-FIXNUM)
                       (KEY (FUNCTION IDENTITY))) 
    "Returns a sequence formed by destructively removing the specified Item from the given sequence."
   (LET ((LENGTH (CL:LENGTH SEQUENCE)))
        (SEQ-DISPATCH SEQUENCE (CL:IF FROM-END (NORMAL-LIST-DELETE-FROM-END)
                                      (NORMAL-LIST-DELETE))
               (CL:IF FROM-END (NORMAL-MUMBLE-DELETE-FROM-END)
                      (NORMAL-MUMBLE-DELETE)))))

(DEFMACRO IF-MUMBLE-DELETE
 NIL (BQUOTE (MUMBLE-DELETE (FUNCALL PREDICATE (FUNCALL KEY
                                                                                (AREF SEQUENCE INDEX)
                                                                                )))))

(DEFMACRO IF-MUMBLE-DELETE-FROM-END
 NIL (BQUOTE (MUMBLE-DELETE-FROM-END (FUNCALL PREDICATE
                                                                               (FUNCALL KEY 
                                                                                      THIS-ELEMENT)))
                                               ))

(DEFMACRO IF-LIST-DELETE
 NIL (QUOTE (LIST-DELETE (FUNCALL PREDICATE (FUNCALL KEY (CAR CURRENT))))))

(DEFMACRO IF-LIST-DELETE-FROM-END
 NIL (QUOTE (LIST-DELETE-FROM-END (FUNCALL PREDICATE
                                                                          (FUNCALL KEY (CAR CURRENT))
                                                                          ))))

(DEFUN DELETE-IF
 (PREDICATE SEQUENCE &KEY FROM-END (START 0)
                        (KEY (FUNCTION IDENTITY))
                        (END (CL:LENGTH SEQUENCE))
                        (COUNT MOST-POSITIVE-FIXNUM)) "Returns a sequence formed by destructively removing the elements satisfying the specified predicate from the given sequence."
   (LET ((LENGTH (CL:LENGTH SEQUENCE)))
        (SEQ-DISPATCH SEQUENCE (CL:IF FROM-END (IF-LIST-DELETE-FROM-END)
                                      (IF-LIST-DELETE))
               (CL:IF FROM-END (IF-MUMBLE-DELETE-FROM-END)
                      (IF-MUMBLE-DELETE)))))

(DEFMACRO IF-NOT-MUMBLE-DELETE
 NIL (BQUOTE (MUMBLE-DELETE (NOT (FUNCALL PREDICATE
                                                                      (FUNCALL KEY (AREF SEQUENCE 
                                                                                         INDEX)))))))

(DEFMACRO IF-NOT-MUMBLE-DELETE-FROM-END
 NIL (BQUOTE (MUMBLE-DELETE-FROM-END
                                                     (NOT (FUNCALL PREDICATE (FUNCALL KEY 
                                                                                    THIS-ELEMENT))))))

(DEFMACRO IF-NOT-LIST-DELETE
 NIL (QUOTE (LIST-DELETE (FUNCALL PREDICATE (FUNCALL KEY (CAR CURRENT))))
                                        ))

(DEFMACRO IF-NOT-LIST-DELETE-FROM-END
 NIL (QUOTE (LIST-DELETE-FROM-END (FUNCALL PREDICATE
                                                                              (FUNCALL KEY
                                                                                     (CAR CURRENT))))
                                                 ))

(DEFUN DELETE-IF-NOT
 (PREDICATE SEQUENCE &KEY FROM-END (START 0)
                            (END (CL:LENGTH SEQUENCE))
                            (KEY (FUNCTION IDENTITY))
                            (COUNT MOST-POSITIVE-FIXNUM)) "Returns a sequence formed by destructively removing the elements not satisfying the specified Predicate from the given Sequence."
   (LET ((LENGTH (CL:LENGTH SEQUENCE)))
        (SEQ-DISPATCH SEQUENCE (CL:IF FROM-END (IF-NOT-LIST-DELETE-FROM-END)
                                      (IF-NOT-LIST-DELETE))
               (CL:IF FROM-END (IF-NOT-MUMBLE-DELETE-FROM-END)
                      (IF-NOT-MUMBLE-DELETE)))))

(DEFMACRO MUMBLE-REMOVE-MACRO
 (BUMP LEFT BEGIN FINISH RIGHT PRED)
   (BQUOTE (CL:DO ((INDEX (\, BEGIN)
                          ((\, BUMP)
                           INDEX))
                   (RESULT (CL:DO ((INDEX (\, LEFT)
                                          ((\, BUMP)
                                           INDEX))
                                   (RESULT (MAKE-SEQUENCE-LIKE SEQUENCE LENGTH)))
                                  ((= INDEX (\, BEGIN))
                                   RESULT)
                                  (SETF (AREF RESULT INDEX)
                                        (AREF SEQUENCE INDEX))))
                   (NEW-INDEX (\, BEGIN))
                   (NUMBER-ZAPPED 0)
                   (THIS-ELEMENT))
                  ((OR (= INDEX (\, FINISH))
                       (= NUMBER-ZAPPED COUNT))
                   (CL:DO ((INDEX INDEX ((\, BUMP)
                                         INDEX))
                           (NEW-INDEX NEW-INDEX ((\, BUMP)
                                                 NEW-INDEX)))
                          ((= INDEX (\, RIGHT))
                           (SHRINK-VECTOR RESULT NEW-INDEX))
                          (SETF (AREF RESULT NEW-INDEX)
                                (AREF SEQUENCE INDEX))))
                  (LET ((THIS-ELEMENT (AREF SEQUENCE INDEX)))
                       (COND
                          ((\, PRED)
                           (SETF (AREF RESULT NEW-INDEX)
                                 THIS-ELEMENT)
                           (SETQ NEW-INDEX ((\, BUMP)
                                            NEW-INDEX)))
                          (T (INCF NUMBER-ZAPPED)))))))

(DEFMACRO MUMBLE-REMOVE
 (PRED) (BQUOTE (MUMBLE-REMOVE-MACRO 1+ 0 START END LENGTH (\, PRED))))

(DEFMACRO MUMBLE-REMOVE-FROM-END
 (PRED) (BQUOTE (LET ((SEQUENCE (COPY-SEQ SEQUENCE)))
                                                     (MUMBLE-DELETE-FROM-END (NOT (\, PRED))))))

(DEFMACRO LIST-REMOVE-MACRO
 (PRED REVERSE?)
   (BQUOTE (LET* ((\,@ (CL:WHEN REVERSE? (QUOTE ((SEQUENCE (REVERSE SEQUENCE))))))
                  (SPLICE (LIST NIL))
                  (RESULTS (CL:DO ((INDEX 0 (1+ INDEX))
                                   (BEFORE-START SPLICE))
                                  ((= INDEX START)
                                   BEFORE-START)
                                  (SETQ SPLICE (CDR (RPLACD SPLICE (CONS (CL:POP SEQUENCE)
                                                                         NIL)))))))
                 (CL:DO ((INDEX START (1+ INDEX))
                         (THIS-ELEMENT)
                         (NUMBER-ZAPPED 0))
                        ((OR (= INDEX END)
                             (= NUMBER-ZAPPED COUNT))
                         (CL:DO ((INDEX INDEX (1+ INDEX)))
                                ((NULL SEQUENCE)
                                 (\, (CL:IF REVERSE? (QUOTE (REVERSE (CDR RESULTS)))
                                            (QUOTE (CDR RESULTS)))))
                                (SETQ SPLICE (CDR (RPLACD SPLICE (CONS (CL:POP SEQUENCE)
                                                                       NIL))))))
                        (SETQ THIS-ELEMENT (CL:POP SEQUENCE))
                        (CL:IF (\, PRED)
                               (SETQ SPLICE (CDR (RPLACD SPLICE (CONS THIS-ELEMENT NIL))))
                               (INCF NUMBER-ZAPPED))))))

(DEFMACRO LIST-REMOVE
 (PRED) (BQUOTE (LIST-REMOVE-MACRO (\, PRED)
                                            NIL)))

(DEFMACRO LIST-REMOVE-FROM-END
 (PRED) (BQUOTE (LIST-REMOVE-MACRO (\, PRED)
                                                     T)))

(DEFMACRO NORMAL-MUMBLE-REMOVE
 NIL (BQUOTE (MUMBLE-REMOVE (CL:IF TEST-NOT (FUNCALL TEST-NOT ITEM
                                                                                 (FUNCALL KEY 
                                                                                        THIS-ELEMENT)
                                                                                 )
                                                                 (NOT (FUNCALL TEST ITEM
                                                                             (FUNCALL KEY 
                                                                                    THIS-ELEMENT)))))
                                          ))

(DEFMACRO NORMAL-MUMBLE-REMOVE-FROM-END
 NIL (BQUOTE (MUMBLE-REMOVE-FROM-END
                                                     (CL:IF TEST-NOT (FUNCALL TEST-NOT ITEM
                                                                            (FUNCALL KEY THIS-ELEMENT
                                                                                   ))
                                                            (NOT (FUNCALL TEST ITEM (FUNCALL KEY 
                                                                                         THIS-ELEMENT
                                                                                           )))))))

(DEFMACRO NORMAL-LIST-REMOVE
 NIL (BQUOTE (LIST-REMOVE (CL:IF TEST-NOT (FUNCALL TEST-NOT ITEM
                                                                             (FUNCALL KEY 
                                                                                    THIS-ELEMENT))
                                                             (NOT (FUNCALL TEST ITEM (FUNCALL KEY 
                                                                                         THIS-ELEMENT
                                                                                            )))))))

(DEFMACRO NORMAL-LIST-REMOVE-FROM-END
 NIL (BQUOTE (LIST-REMOVE-FROM-END
                                                   (CL:IF TEST-NOT (FUNCALL TEST-NOT ITEM
                                                                          (FUNCALL KEY THIS-ELEMENT))
                                                          (NOT (FUNCALL TEST ITEM (FUNCALL KEY 
                                                                                         THIS-ELEMENT
                                                                                         )))))))

(DEFUN CL:REMOVE
 (ITEM SEQUENCE &KEY FROM-END (TEST (FUNCTION EQL))
                       TEST-NOT
                       (START 0)
                       (END (CL:LENGTH SEQUENCE))
                       (COUNT MOST-POSITIVE-FIXNUM)
                       (KEY (FUNCTION IDENTITY))) 
           (* raf " 3-Dec-85 23:31")

   (LET ((LENGTH (CL:LENGTH SEQUENCE)))
        (SEQ-DISPATCH SEQUENCE (CL:IF FROM-END (NORMAL-LIST-REMOVE-FROM-END)
                                      (NORMAL-LIST-REMOVE))
               (CL:IF FROM-END (NORMAL-MUMBLE-REMOVE-FROM-END)
                      (NORMAL-MUMBLE-REMOVE)))))

(DEFMACRO IF-MUMBLE-REMOVE
 NIL (BQUOTE (MUMBLE-REMOVE (NOT (FUNCALL PREDICATE (FUNCALL KEY 
                                                                                     THIS-ELEMENT))))
                                      ))

(DEFMACRO IF-MUMBLE-REMOVE-FROM-END
 NIL (BQUOTE (MUMBLE-REMOVE-FROM-END (NOT (FUNCALL PREDICATE
                                                                                    (FUNCALL KEY 
                                                                                         THIS-ELEMENT
                                                                                           ))))))

(DEFMACRO IF-LIST-REMOVE
 NIL (BQUOTE (LIST-REMOVE (NOT (FUNCALL PREDICATE (FUNCALL KEY THIS-ELEMENT))
                                                       ))))

(DEFMACRO IF-LIST-REMOVE-FROM-END
 NIL (BQUOTE (LIST-REMOVE-FROM-END (NOT (FUNCALL PREDICATE
                                                                                (FUNCALL KEY 
                                                                                       THIS-ELEMENT))
                                                                         ))))

(DEFUN REMOVE-IF
 (PREDICATE SEQUENCE &KEY FROM-END (START 0)
                        (END (CL:LENGTH SEQUENCE))
                        (COUNT MOST-POSITIVE-FIXNUM)
                        (KEY (FUNCTION IDENTITY))) 
      "Returns a copy of sequence with elements such that predicate(element) is non-null are removed"
   (LET ((LENGTH (CL:LENGTH SEQUENCE)))
        (SEQ-DISPATCH SEQUENCE (CL:IF FROM-END (IF-LIST-REMOVE-FROM-END)
                                      (IF-LIST-REMOVE))
               (CL:IF FROM-END (IF-MUMBLE-REMOVE-FROM-END)
                      (IF-MUMBLE-REMOVE)))))

(DEFMACRO IF-NOT-MUMBLE-REMOVE
 NIL (BQUOTE (MUMBLE-REMOVE (FUNCALL PREDICATE (FUNCALL KEY 
                                                                                    THIS-ELEMENT)))))

(DEFMACRO IF-NOT-MUMBLE-REMOVE-FROM-END
 NIL (BQUOTE (MUMBLE-REMOVE-FROM-END (FUNCALL PREDICATE
                                                                                   (FUNCALL KEY 
                                                                                         THIS-ELEMENT
                                                                                          )))))

(DEFMACRO IF-NOT-LIST-REMOVE
 NIL (BQUOTE (LIST-REMOVE (FUNCALL PREDICATE (FUNCALL KEY THIS-ELEMENT)))
                                        ))

(DEFMACRO IF-NOT-LIST-REMOVE-FROM-END
 NIL (BQUOTE (LIST-REMOVE-FROM-END (FUNCALL PREDICATE
                                                                               (FUNCALL KEY 
                                                                                      THIS-ELEMENT)))
                                                 ))

(DEFUN REMOVE-IF-NOT
 (PREDICATE SEQUENCE &KEY FROM-END (START 0)
                            (END (CL:LENGTH SEQUENCE))
                            (COUNT MOST-POSITIVE-FIXNUM)
                            (KEY (FUNCTION IDENTITY))) 
          "Returns a copy of sequence with elements such that predicate(element) is null are removed"
   (LET ((LENGTH (CL:LENGTH SEQUENCE)))
        (SEQ-DISPATCH SEQUENCE (CL:IF FROM-END (IF-NOT-LIST-REMOVE-FROM-END)
                                      (IF-NOT-LIST-REMOVE))
               (CL:IF FROM-END (IF-NOT-MUMBLE-REMOVE-FROM-END)
                      (IF-NOT-MUMBLE-REMOVE)))))

(DEFUN LIST-REMOVE-DUPLICATES*
 (LIST TEST TEST-NOT START END KEY FROM-END)
   (LET* ((RESULT (LIST NIL))
          (SPLICE RESULT)
          (CURRENT LIST))
         (CL:DO ((INDEX 0 (1+ INDEX)))
                ((= INDEX START))
                (SETQ SPLICE (CDR (RPLACD SPLICE (LIST (CAR CURRENT)))))
                (CL:POP CURRENT))                            (* "RESULT now holds the head of the list up to, but not including start. SPLICE points to the next cell to be RPLACD'ed. CURRENT is the tail to be processed.")

         (CL:DO ((SUBLIST (CDR SPLICE))
                 (INDEX START (1+ INDEX)))
                ((OR (AND END (>= INDEX END))
                     (ENDP CURRENT)))
                (CL:UNLESS (CL:IF FROM-END (CL:MEMBER (FUNCALL KEY (CAR CURRENT))
                                                  (NTHCDR START (CDR RESULT))
                                                  :TEST TEST :TEST-NOT TEST-NOT :KEY KEY)
                                  (CL:DO ((IT (FUNCALL KEY (CAR CURRENT)))
                                          (L (CDR CURRENT)
                                             (CDR L))
                                          (I (1+ INDEX)
                                             (1+ I)))
                                         ((OR (ENDP L)
                                              (>= I END))
                                          NIL)
                                         (CL:WHEN (CL:IF TEST-NOT (NOT (FUNCALL TEST-NOT IT
                                                                              (FUNCALL KEY
                                                                                     (CAR L))))
                                                         (FUNCALL TEST IT (FUNCALL KEY (CAR L))))
                                                (RETURN T))))
                       (SETQ SPLICE (CDR (RPLACD SPLICE (LIST (CAR CURRENT))))))
                (CL:POP CURRENT))
         (RPLACD SPLICE CURRENT)
         (CDR RESULT)))

(DEFUN VECTOR-REMOVE-DUPLICATES*
 (VECTOR TEST TEST-NOT START END KEY FROM-END &OPTIONAL
                                        (LENGTH (CL:LENGTH VECTOR)))
   (DECLARE
 (TYPE VECTOR VECTOR))
                            (* raf "17-Dec-85 22:38")

   (LET ((RESULT (MAKE-SEQUENCE-LIKE VECTOR LENGTH))
         (INDEX 0)
         (JNDEX START))
        (CL:DO NIL ((= INDEX START))
               (SETF (AREF RESULT INDEX)
                     (AREF VECTOR INDEX))
               (INCF INDEX))
        (CL:DO NIL ((= INDEX END))
               (LET ((ELT (AREF VECTOR INDEX)))
                    (COND
                       ((NOT (CL:IF FROM-END
                                    (CL:POSITION (FUNCALL KEY ELT)
                                           RESULT :START START :END JNDEX :TEST TEST :TEST-NOT 
                                           TEST-NOT :KEY KEY)
                                    (CL:POSITION (FUNCALL KEY ELT)
                                           VECTOR :START (1+ INDEX)
                                           :END END :TEST TEST :TEST-NOT TEST-NOT :KEY KEY)))
                        (SETF (AREF RESULT JNDEX)
                              ELT)
                        (INCF JNDEX))))
               (INCF INDEX))
        (CL:DO NIL ((= INDEX LENGTH))
               (SETF (AREF RESULT JNDEX)
                     (AREF VECTOR INDEX))
               (INCF INDEX)
               (INCF JNDEX))
        (SHRINK-VECTOR RESULT JNDEX)))

(DEFUN REMOVE-DUPLICATES
 (SEQUENCE &KEY (TEST (FUNCTION EQL))
                                TEST-NOT
                                (START 0)
                                FROM-END
                                (END (CL:LENGTH SEQUENCE))
                                (KEY (FUNCTION IDENTITY))) "The elements of Sequence are examined, and if any two match, one is discarded.  The resulting sequence is returned."
   (SEQ-DISPATCH SEQUENCE (CL:WHEN SEQUENCE (LIST-REMOVE-DUPLICATES* SEQUENCE TEST TEST-NOT START END 
                                                   KEY FROM-END))
          (VECTOR-REMOVE-DUPLICATES* SEQUENCE TEST TEST-NOT START END KEY FROM-END)))

(DEFUN LIST-DELETE-DUPLICATES*
 (LIST TEST TEST-NOT KEY FROM-END START END)
   (LET ((HANDLE (CONS NIL LIST)))
        (CL:DO ((CURRENT (NTHCDR START LIST)
                       (CDR CURRENT))
                (PREVIOUS (NTHCDR START HANDLE))
                (INDEX START (1+ INDEX)))
               ((OR (= INDEX END)
                    (NULL CURRENT))
                (CDR HANDLE))
               (CL:IF (CL:DO ((X (CL:IF FROM-END (NTHCDR (1+ START)
                                                        HANDLE)
                                        (CDR CURRENT))
                                 (CDR X))
                              (I (1+ INDEX)
                                 (1+ I)))
                             ((OR (NULL X)
                                  (AND (NOT FROM-END)
                                       (= I END))
                                  (EQ X CURRENT))
                              NIL)
                             (CL:WHEN (CL:IF TEST-NOT (NOT (FUNCALL TEST-NOT (FUNCALL KEY
                                                                                    (CAR CURRENT))
                                                                  (FUNCALL KEY (CAR X))))
                                             (FUNCALL TEST (FUNCALL KEY (CAR CURRENT))
                                                    (FUNCALL KEY (CAR X))))
                                    (RETURN T)))
                      (RPLACD PREVIOUS (CDR CURRENT))
                      (CL:POP PREVIOUS)))))

(DEFUN VECTOR-DELETE-DUPLICATES*
 (VECTOR TEST TEST-NOT KEY FROM-END START END &OPTIONAL
                                        (LENGTH (CL:LENGTH VECTOR)))
   (DECLARE
 (TYPE VECTOR VECTOR))
                            (* raf "17-Dec-85 22:39")

   (CL:DO ((INDEX START (1+ INDEX))
           (JNDEX START))
          ((= INDEX END)
           (CL:DO ((INDEX INDEX (1+ INDEX))
                   (JNDEX JNDEX (1+ JNDEX)))
                  ((= INDEX LENGTH)
                   (SHRINK-VECTOR VECTOR JNDEX)
                   VECTOR)
                  (SETF (AREF VECTOR JNDEX)
                        (AREF VECTOR INDEX))))
          (SETF (AREF VECTOR JNDEX)
                (AREF VECTOR INDEX))
          (CL:UNLESS (CL:POSITION (FUNCALL KEY (AREF VECTOR INDEX))
                            VECTOR :KEY KEY :TEST TEST :TEST-NOT TEST-NOT :START (CL:IF FROM-END 
                                                                                        START
                                                                                        (1+ INDEX))
                            :END
                            (CL:IF FROM-END JNDEX END))
                 (INCF JNDEX))))

(DEFUN DELETE-DUPLICATES
 (SEQUENCE &KEY (TEST (FUNCTION EQL))
                                TEST-NOT
                                (START 0)
                                FROM-END
                                (END (CL:LENGTH SEQUENCE))
                                (KEY (FUNCTION IDENTITY))) "The elements of Sequence are examined, and if any two match, one is discarded. The resulting sequence, which may be formed by destroying the given sequence, is returned."
   (SEQ-DISPATCH SEQUENCE (COND
                             (SEQUENCE (LIST-DELETE-DUPLICATES* SEQUENCE TEST TEST-NOT KEY FROM-END 
                                              START END))
                             (T NIL))
          (VECTOR-DELETE-DUPLICATES* SEQUENCE TEST TEST-NOT KEY FROM-END START END)))

(DEFMACRO SUBST-DISPATCH
 (PRED) (BQUOTE (SEQ-DISPATCH SEQUENCE
                                               (CL:IF FROM-END (REVERSE (LIST-SUBSTITUTE*
                                                                         (\, PRED)
                                                                         NEW
                                                                         (REVERSE SEQUENCE)
                                                                         (- LENGTH END)
                                                                         (- LENGTH START)
                                                                         COUNT KEY TEST TEST-NOT OLD)
                                                                      )
                                                      (LIST-SUBSTITUTE* (\, PRED)
                                                             NEW SEQUENCE START END COUNT KEY TEST 
                                                             TEST-NOT OLD))
                                               (CL:IF FROM-END (VECTOR-SUBSTITUTE* (\, PRED)
                                                                      NEW SEQUENCE -1 (1- LENGTH)
                                                                      -1 LENGTH (1- END)
                                                                      (1- START)
                                                                      COUNT KEY TEST TEST-NOT OLD)
                                                      (VECTOR-SUBSTITUTE* (\, PRED)
                                                             NEW SEQUENCE 1 0 LENGTH LENGTH START END 
                                                             COUNT KEY TEST TEST-NOT OLD)))))

(DEFUN LIST-SUBSTITUTE*
 (PRED NEW LIST START END COUNT KEY TEST TEST-NOT OLD) 

                                                             (* kbr: "31-Aug-85 20:01")

   (LET* ((RESULT (LIST NIL))
          (SPLICE RESULT)
          (LIST LIST))                                       (* " Get a local list for a stepper." 

                                                             *)

         (CL:DO ((INDEX 0 (1+ INDEX)))
                ((= INDEX START))
                (SETQ SPLICE (CDR (RPLACD SPLICE (LIST (CAR LIST)))))
                (CL:POP LIST))                               (* 

              "SPLICE points to the place to append to, LIST is now the appropriate tail to work on.")

         (CL:DO ((INDEX START (1+ INDEX)))
                ((OR (AND END (= INDEX END))
                     (ENDP LIST)
                     (= COUNT 0)))
                (LET ((ELT (CL:POP LIST)))
                     (SETQ SPLICE
                      (CDR (RPLACD SPLICE
                                  (LIST (COND
                                           ((ECASE PRED (NORMAL (CL:IF TEST-NOT
                                                                       (NOT (FUNCALL TEST-NOT OLD
                                                                                   (FUNCALL KEY ELT))
                                                                            )
                                                                       (FUNCALL TEST OLD
                                                                              (FUNCALL KEY ELT))))
                                                   (IF
 (FUNCALL TEST (FUNCALL KEY ELT)))
                                                   (IF-NOT (NOT (FUNCALL TEST (FUNCALL KEY ELT)))))
                                            (DECF COUNT)
                                            NEW)
                                           (T ELT))))))))
         (RPLACD SPLICE LIST)
         (CDR RESULT)))

(DEFUN VECTOR-SUBSTITUTE*
 (PRED NEW SEQUENCE INCREMENTER LEFT RIGHT LENGTH START END COUNT KEY TEST 
                                TEST-NOT OLD) 
               (* kbr: "31-Aug-85 20:01")

   (LET ((RESULT (MAKE-SEQUENCE-LIKE SEQUENCE LENGTH))
         (INDEX LEFT))
        (CL:DO NIL ((= INDEX START))
               (SETF (AREF RESULT INDEX)
                     (AREF SEQUENCE INDEX))
               (INCF INDEX INCREMENTER))
        (CL:DO ((ELT))
               ((OR (= INDEX END)
                    (= COUNT 0)))
               (SETQ ELT (AREF SEQUENCE INDEX))
               (SETF (AREF RESULT INDEX)
                     (COND
                        ((CASE PRED (NORMAL (CL:IF TEST-NOT (NOT (FUNCALL TEST-NOT OLD
                                                                        (FUNCALL KEY ELT)))
                                                   (FUNCALL TEST OLD (FUNCALL KEY ELT))))
                               (IF
 (FUNCALL TEST (FUNCALL KEY ELT)))
                               (IF-NOT (NOT (FUNCALL TEST (FUNCALL KEY ELT)))))
                         (DECF COUNT)
                         NEW)
                        (T ELT)))
               (INCF INDEX INCREMENTER))
        (CL:DO NIL ((= INDEX RIGHT))
               (SETF (AREF RESULT INDEX)
                     (AREF SEQUENCE INDEX))
               (INCF INDEX INCREMENTER))
        RESULT))

(DEFUN SUBSTITUTE
 (NEW OLD SEQUENCE &KEY FROM-END (TEST (FUNCTION EQL))
                       TEST-NOT
                       (START 0)
                       (COUNT MOST-POSITIVE-FIXNUM)
                       (END (CL:LENGTH SEQUENCE))
                       (KEY (FUNCTION IDENTITY))) "Returns a sequence of the same kind as Sequence with the same elements except that all elements that match Old are replaced with New."
   (LET ((LENGTH (CL:LENGTH SEQUENCE)))
        (SUBST-DISPATCH (QUOTE NORMAL))))

(DEFUN SUBSTITUTE-IF
 (NEW TEST SEQUENCE &KEY FROM-END (START 0)
                          (END (CL:LENGTH SEQUENCE))
                          (COUNT MOST-POSITIVE-FIXNUM)
                          (KEY (FUNCTION IDENTITY))) "Returns a sequence of the same kind as Sequence with the same elements except that all elements satisfying the Test are replaced with New."
   (LET ((LENGTH (CL:LENGTH SEQUENCE))
         TEST-NOT OLD)
        (SUBST-DISPATCH (QUOTE IF))))

(DEFUN SUBSTITUTE-IF-NOT
 (NEW TEST SEQUENCE &KEY FROM-END (START 0)
                              (END (CL:LENGTH SEQUENCE))
                              (COUNT MOST-POSITIVE-FIXNUM)
                              (KEY (FUNCTION IDENTITY))) "Returns a sequence of the same kind as Sequence with the same elements except that all elements not satisfying the Test are replaced with New."
   (LET ((LENGTH (CL:LENGTH SEQUENCE))
         TEST-NOT OLD)
        (SUBST-DISPATCH (QUOTE IF-NOT))))

(DEFUN NLIST-SUBSTITUTE*
 (NEW OLD SEQUENCE TEST TEST-NOT START END COUNT KEY)
   (CL:DO ((LIST (NTHCDR START SEQUENCE)
                 (CDR LIST))
           (INDEX START (1+ INDEX)))
          ((OR (AND END (= INDEX END))
               (ENDP LIST)
               (= COUNT 0))
           SEQUENCE)
          (COND
             ((CL:IF TEST-NOT (NOT (FUNCALL TEST-NOT OLD (FUNCALL KEY (CAR LIST))))
                     (FUNCALL TEST OLD (FUNCALL KEY (CAR LIST))))
              (RPLACA LIST NEW)
              (DECF COUNT)))))

(DEFUN NVECTOR-SUBSTITUTE*
 (NEW OLD SEQUENCE INCREMENTER TEST TEST-NOT START END COUNT KEY)
   (CL:DO ((INDEX START (+ INDEX INCREMENTER)))
          ((OR (= INDEX END)
               (= COUNT 0))
           SEQUENCE)
          (COND
             ((CL:IF TEST-NOT (NOT (FUNCALL TEST-NOT OLD (FUNCALL KEY (AREF SEQUENCE INDEX))))
                     (FUNCALL TEST OLD (FUNCALL KEY (AREF SEQUENCE INDEX))))
              (SETF (AREF SEQUENCE INDEX)
                    NEW)
              (DECF COUNT)))))

(DEFUN NSUBSTITUTE
 (NEW OLD SEQUENCE &KEY FROM-END (TEST (FUNCTION EQL))
                        TEST-NOT
                        (END (CL:WHEN (VECTORP SEQUENCE)
                                    (CL:LENGTH (THE VECTOR SEQUENCE))))
                        (COUNT MOST-POSITIVE-FIXNUM)
                        (KEY (FUNCTION IDENTITY))
                        (START 0)) 
                          (* raf "27-Jan-86 17:31")

   (LET ((INCREMENTER 1))
        (CL:WHEN FROM-END (PSETQ START (1- END)
                                 END
                                 (1- START)
                                 INCREMENTER -1))
        (SEQ-DISPATCH SEQUENCE (CL:IF FROM-END (DREVERSE (NLIST-SUBSTITUTE* NEW OLD (DREVERSE 
                                                                                           SEQUENCE)
                                                                TEST TEST-NOT START END COUNT KEY))
                                      (NLIST-SUBSTITUTE* NEW OLD SEQUENCE TEST TEST-NOT START END 
                                             COUNT KEY))
               (NVECTOR-SUBSTITUTE* NEW OLD SEQUENCE INCREMENTER TEST TEST-NOT START END COUNT KEY))))

(DEFUN NLIST-SUBSTITUTE-IF*
 (NEW TEST SEQUENCE START END COUNT KEY)
   (CL:DO ((LIST (NTHCDR START SEQUENCE)
                 (CDR LIST))
           (INDEX START (1+ INDEX)))
          ((OR (AND END (= INDEX END))
               (ENDP LIST)
               (= COUNT 0))
           SEQUENCE)
          (COND
             ((FUNCALL TEST (FUNCALL KEY (CAR LIST)))
              (RPLACA LIST NEW)
              (DECF COUNT)))))

(DEFUN NVECTOR-SUBSTITUTE-IF*
 (NEW TEST SEQUENCE INCREMENTER START END COUNT KEY)
   (CL:DO ((INDEX START (+ INDEX INCREMENTER)))
          ((OR (= INDEX END)
               (= COUNT 0))
           SEQUENCE)
          (COND
             ((FUNCALL TEST (FUNCALL KEY (AREF SEQUENCE INDEX)))
              (SETF (AREF SEQUENCE INDEX)
                    NEW)
              (DECF COUNT)))))

(DEFUN NSUBSTITUTE-IF
 (NEW TEST SEQUENCE &KEY FROM-END (START 0)
                           (END (CL:WHEN (VECTORP SEQUENCE)
                                       (CL:LENGTH (THE VECTOR SEQUENCE))))
                           (COUNT MOST-POSITIVE-FIXNUM)
                           (KEY (FUNCTION IDENTITY))) 
       (* raf "27-Jan-86 17:31")

   (LET ((INCREMENTER 1))
        (CL:WHEN FROM-END (PSETQ START (1- END)
                                 END
                                 (1- START)
                                 INCREMENTER -1))
        (SEQ-DISPATCH SEQUENCE (CL:IF FROM-END (DREVERSE (NLIST-SUBSTITUTE-IF* NEW TEST (DREVERSE
                                                                                         SEQUENCE)
                                                                START END COUNT KEY))
                                      (NLIST-SUBSTITUTE-IF* NEW TEST SEQUENCE START END COUNT KEY))
               (NVECTOR-SUBSTITUTE-IF* NEW TEST SEQUENCE INCREMENTER START END COUNT KEY))))

(DEFUN NLIST-SUBSTITUTE-IF-NOT*
 (NEW TEST SEQUENCE START END COUNT KEY)
   (CL:DO ((LIST (NTHCDR START SEQUENCE)
                 (CDR LIST))
           (INDEX START (1+ INDEX)))
          ((OR (AND END (= INDEX END))
               (ENDP LIST)
               (= COUNT 0))
           SEQUENCE)
          (COND
             ((NOT (FUNCALL TEST (FUNCALL KEY (CAR LIST))))
              (RPLACA LIST NEW)
              (DECF COUNT)))))

(DEFUN NVECTOR-SUBSTITUTE-IF-NOT*
 (NEW TEST SEQUENCE INCREMENTER START END COUNT KEY)
   (CL:DO ((INDEX START (+ INDEX INCREMENTER)))
          ((OR (= INDEX END)
               (= COUNT 0))
           SEQUENCE)
          (COND
             ((NOT (FUNCALL TEST (FUNCALL KEY (AREF SEQUENCE INDEX))))
              (SETF (AREF SEQUENCE INDEX)
                    NEW)
              (DECF COUNT)))))

(DEFUN NSUBSTITUTE-IF-NOT
 (NEW TEST SEQUENCE &KEY FROM-END (START 0)
                               (END (CL:WHEN (VECTORP SEQUENCE)
                                           (CL:LENGTH (THE VECTOR SEQUENCE))))
                               (COUNT MOST-POSITIVE-FIXNUM)
                               (KEY (FUNCTION IDENTITY))) 
   (* raf "27-Jan-86 17:31")

   (LET ((INCREMENTER 1))
        (CL:WHEN FROM-END (PSETQ START (1- END)
                                 END
                                 (1- START)
                                 INCREMENTER -1))
        (SEQ-DISPATCH SEQUENCE (CL:IF FROM-END (DREVERSE (NLIST-SUBSTITUTE-IF-NOT* NEW TEST
                                                                (DREVERSE SEQUENCE)
                                                                START END COUNT KEY))
                                      (NLIST-SUBSTITUTE-IF-NOT* NEW TEST SEQUENCE START END COUNT KEY
                                             ))
               (NVECTOR-SUBSTITUTE-IF-NOT* NEW TEST SEQUENCE INCREMENTER START END COUNT KEY))))

(DEFMACRO VECTOR-FIND
 (ITEM SEQUENCE) (BQUOTE (LET ((INCREMENTER (CL:IF FROM-END -1 1))
                                                    (START (CL:IF FROM-END (1- END)
                                                                  START))
                                                    (END (CL:IF FROM-END (1- START)
                                                                END)))
                                                   (CL:DO ((INDEX START (+ INDEX INCREMENTER))
                                                           (CURRENT))
                                                          ((= INDEX END)
                                                           NIL)
                                                          (SETQ CURRENT (AREF (\, SEQUENCE)
                                                                              INDEX))
                                                          (CL:IF TEST-NOT
                                                                 (CL:UNLESS (FUNCALL TEST-NOT
                                                                                   (\, ITEM)
                                                                                   (FUNCALL KEY 
                                                                                          CURRENT))
                                                                        (RETURN CURRENT))
                                                                 (CL:WHEN (FUNCALL TEST (\, ITEM)
                                                                                 (FUNCALL KEY CURRENT
                                                                                        ))
                                                                        (RETURN CURRENT)))))))

(DEFMACRO LIST-FIND
 (ITEM SEQUENCE) (BQUOTE (CL:IF FROM-END
                                                   (CL:DO ((SEQUENCE
                                                            (NTHCDR (- (LENGTH (\, SEQUENCE))
                                                                       END)
                                                                   (REVERSE (\, SEQUENCE))))
                                                           (INDEX (1- END)
                                                                  (1- INDEX))
                                                           (CURRENT))
                                                          ((OR (= INDEX (1- START))
                                                               (ENDP SEQUENCE))
                                                           NIL)
                                                          (SETQ CURRENT (CL:POP SEQUENCE))
                                                          (CL:IF TEST-NOT
                                                                 (CL:UNLESS (FUNCALL TEST-NOT
                                                                                   (\, ITEM)
                                                                                   (FUNCALL KEY 
                                                                                          CURRENT))
                                                                        (RETURN CURRENT))
                                                                 (CL:WHEN (FUNCALL TEST (\, ITEM)
                                                                                 (FUNCALL KEY CURRENT
                                                                                        ))
                                                                        (RETURN CURRENT))))
                                                   (CL:DO ((SEQUENCE (NTHCDR START (\, SEQUENCE)))
                                                           (INDEX START (1+ INDEX))
                                                           (CURRENT))
                                                          ((OR (= INDEX END)
                                                               (ENDP SEQUENCE))
                                                           NIL)
                                                          (SETQ CURRENT (CL:POP SEQUENCE))
                                                          (CL:IF TEST-NOT
                                                                 (CL:UNLESS (FUNCALL TEST-NOT
                                                                                   (\, ITEM)
                                                                                   (FUNCALL KEY 
                                                                                          CURRENT))
                                                                        (RETURN CURRENT))
                                                                 (CL:WHEN (FUNCALL TEST (\, ITEM)
                                                                                 (FUNCALL KEY CURRENT
                                                                                        ))
                                                                        (RETURN CURRENT)))))))

(DEFMACRO VECTOR-FIND-IF
 (TEST SEQUENCE) (BQUOTE (LET ((INCREMENTER (CL:IF FROM-END -1 1))
                                                       (START (CL:IF FROM-END (1- END)
                                                                     START))
                                                       (END (CL:IF FROM-END (1- START)
                                                                   END)))
                                                      (CL:DO ((INDEX START (+ INDEX INCREMENTER))
                                                              (CURRENT))
                                                             ((= INDEX END)
                                                              NIL)
                                                             (SETQ CURRENT (AREF (\, SEQUENCE)
                                                                                 INDEX))
                                                             (CL:WHEN (FUNCALL (\, TEST)
                                                                             (FUNCALL KEY CURRENT))
                                                                    (RETURN CURRENT))))))

(DEFMACRO LIST-FIND-IF
 (TEST SEQUENCE) (BQUOTE (CL:IF FROM-END
                                                      (CL:DO ((SEQUENCE (NTHCDR (- LENGTH END)
                                                                               (REVERSE (\, SEQUENCE)
                                                                                      )))
                                                              (INDEX (1- END)
                                                                     (1- INDEX))
                                                              (CURRENT))
                                                             ((OR (= INDEX (1- START))
                                                                  (ENDP SEQUENCE))
                                                              NIL)
                                                             (SETQ CURRENT (CL:POP SEQUENCE))
                                                             (CL:WHEN (FUNCALL (\, TEST)
                                                                             (FUNCALL KEY CURRENT))
                                                                    (RETURN CURRENT)))
                                                      (CL:DO ((SEQUENCE (NTHCDR START (\, SEQUENCE)))
                                                              (INDEX START (1+ INDEX))
                                                              (CURRENT))
                                                             ((OR (= INDEX END)
                                                                  (ENDP SEQUENCE))
                                                              NIL)
                                                             (SETQ CURRENT (CL:POP SEQUENCE))
                                                             (CL:WHEN (FUNCALL (\, TEST)
                                                                             (FUNCALL KEY CURRENT))
                                                                    (RETURN CURRENT))))))

(DEFMACRO VECTOR-FIND-IF-NOT
 (TEST SEQUENCE) (BQUOTE (LET ((INCREMENTER (CL:IF FROM-END -1 1))
                                                           (START (CL:IF FROM-END (1- END)
                                                                         START))
                                                           (END (CL:IF FROM-END (1- START)
                                                                       END)))
                                                          (CL:DO ((INDEX START (+ INDEX INCREMENTER))
                                                                  (CURRENT))
                                                                 ((= INDEX END)
                                                                  NIL)
                                                                 (SETQ CURRENT (AREF (\, SEQUENCE)
                                                                                     INDEX))
                                                                 (CL:UNLESS (FUNCALL (\, TEST)
                                                                                   (FUNCALL KEY 
                                                                                          CURRENT))
                                                                        (RETURN CURRENT))))))

(DEFMACRO LIST-FIND-IF-NOT
 (TEST SEQUENCE) (BQUOTE (CL:IF FROM-END
                                                          (CL:DO ((SEQUENCE
                                                                   (NTHCDR (- LENGTH END)
                                                                          (REVERSE (\, SEQUENCE))))
                                                                  (INDEX (1- END)
                                                                         (1- INDEX))
                                                                  (CURRENT))
                                                                 ((OR (= INDEX (1- START))
                                                                      (ENDP SEQUENCE))
                                                                  NIL)
                                                                 (SETQ CURRENT (CL:POP SEQUENCE))
                                                                 (CL:UNLESS (FUNCALL (\, TEST)
                                                                                   (FUNCALL KEY 
                                                                                          CURRENT))
                                                                        (RETURN CURRENT)))
                                                          (CL:DO ((SEQUENCE (NTHCDR START
                                                                                   (\, SEQUENCE)))
                                                                  (INDEX START (1+ INDEX))
                                                                  (CURRENT))
                                                                 ((OR (= INDEX END)
                                                                      (ENDP SEQUENCE))
                                                                  NIL)
                                                                 (SETQ CURRENT (CL:POP SEQUENCE))
                                                                 (CL:UNLESS (FUNCALL (\, TEST)
                                                                                   (FUNCALL KEY 
                                                                                          CURRENT))
                                                                        (RETURN CURRENT))))))

(DEFUN LIST-FIND*
 (ITEM SEQUENCE FROM-END TEST TEST-NOT START END KEY) (LIST-FIND ITEM SEQUENCE))

(DEFUN VECTOR-FIND*
 (ITEM SEQUENCE FROM-END TEST TEST-NOT START END KEY) (VECTOR-FIND ITEM SEQUENCE))

(DEFUN CL:FIND
 (ITEM SEQUENCE &KEY FROM-END (TEST (FUNCTION EQL))
                     TEST-NOT
                     (START 0)
                     (END (CL:LENGTH SEQUENCE))
                     (KEY (FUNCTION IDENTITY))) 
     "Returns the first element in SEQUENCE satisfying the test (default is EQL) with the given ITEM"
   (SEQ-DISPATCH SEQUENCE (LIST-FIND* ITEM SEQUENCE FROM-END TEST TEST-NOT START END KEY)
          (VECTOR-FIND* ITEM SEQUENCE FROM-END TEST TEST-NOT START END KEY)))

(DEFUN FIND-IF
 (TEST SEQUENCE &KEY FROM-END (START 0)
                     (END (CL:LENGTH SEQUENCE))
                     (KEY (FUNCTION IDENTITY))) 
                            "Returns the zero-origin index of the first element satisfying the test."
   (LET ((LENGTH (CL:LENGTH SEQUENCE)))
        (SEQ-DISPATCH SEQUENCE (LIST-FIND-IF TEST SEQUENCE)
               (VECTOR-FIND-IF TEST SEQUENCE))))

(DEFUN FIND-IF-NOT
 (TEST SEQUENCE &KEY FROM-END (START 0)
                         (END (CL:LENGTH SEQUENCE))
                         (KEY (FUNCTION IDENTITY))) 
                        "Returns the zero-origin index of the first element not satisfying the test."
   (LET ((LENGTH (CL:LENGTH SEQUENCE)))
        (SEQ-DISPATCH SEQUENCE (LIST-FIND-IF-NOT TEST SEQUENCE)
               (VECTOR-FIND-IF-NOT TEST SEQUENCE))))

(DEFMACRO VECTOR-POSITION
 (ITEM SEQUENCE)
   (BQUOTE (LET ((INCREMENTER (CL:IF FROM-END -1 1))
                 (START (CL:IF FROM-END (1- END)
                               START))
                 (END (CL:IF FROM-END (1- START)
                             END)))
                (CL:DO ((INDEX START (+ INDEX INCREMENTER)))
                       ((= INDEX END)
                        NIL)
                       (CL:IF TEST-NOT (CL:UNLESS (FUNCALL TEST-NOT (\, ITEM)
                                                         (FUNCALL KEY (AREF (\, SEQUENCE)
                                                                            INDEX)))
                                              (RETURN INDEX))
                              (CL:WHEN (FUNCALL TEST (\, ITEM)
                                              (FUNCALL KEY (AREF (\, SEQUENCE)
                                                                 INDEX)))
                                     (RETURN INDEX)))))))

(DEFMACRO VECTOR-POSITION-IF
 (TEST SEQUENCE)
   (BQUOTE (LET ((INCREMENTER (CL:IF FROM-END -1 1))
                 (START (CL:IF FROM-END (1- END)
                               START))
                 (END (CL:IF FROM-END (1- START)
                             END)))
                (CL:DO ((INDEX START (+ INDEX INCREMENTER)))
                       ((= INDEX END)
                        NIL)
                       (CL:WHEN (FUNCALL (\, TEST)
                                       (FUNCALL KEY (AREF (\, SEQUENCE)
                                                          INDEX)))
                              (RETURN INDEX))))))

(DEFMACRO LIST-POSITION
 (ITEM SEQUENCE) (BQUOTE
                                         (CL:IF FROM-END
                                                (CL:DO ((SEQUENCE (NTHCDR (- (LENGTH SEQUENCE)
                                                                             END)
                                                                         (REVERSE (\, SEQUENCE))))
                                                        (INDEX (1- END)
                                                               (1- INDEX)))
                                                       ((OR (= INDEX (1- START))
                                                            (ENDP SEQUENCE))
                                                        NIL)
                                                       (CL:IF TEST-NOT
                                                              (CL:UNLESS (FUNCALL TEST-NOT
                                                                                (\, ITEM)
                                                                                (FUNCALL KEY
                                                                                       (CL:POP 
                                                                                             SEQUENCE
                                                                                              )))
                                                                     (RETURN INDEX))
                                                              (CL:WHEN (FUNCALL TEST (\, ITEM)
                                                                              (FUNCALL KEY
                                                                                     (CL:POP SEQUENCE
                                                                                            )))
                                                                     (RETURN INDEX))))
                                                (CL:DO ((SEQUENCE (NTHCDR START (\, SEQUENCE)))
                                                        (INDEX START (1+ INDEX)))
                                                       ((OR (= INDEX END)
                                                            (ENDP SEQUENCE))
                                                        NIL)
                                                       (CL:IF TEST-NOT
                                                              (CL:UNLESS (FUNCALL TEST-NOT
                                                                                (\, ITEM)
                                                                                (FUNCALL KEY
                                                                                       (CL:POP 
                                                                                             SEQUENCE
                                                                                              )))
                                                                     (RETURN INDEX))
                                                              (CL:WHEN (FUNCALL TEST (\, ITEM)
                                                                              (FUNCALL KEY
                                                                                     (CL:POP SEQUENCE
                                                                                            )))
                                                                     (RETURN INDEX)))))))

(DEFMACRO LIST-POSITION-IF
 (TEST SEQUENCE) (BQUOTE (CL:IF FROM-END
                                                          (CL:DO ((SEQUENCE
                                                                   (NTHCDR (- LENGTH END)
                                                                          (REVERSE (\, SEQUENCE))))
                                                                  (INDEX (1- END)
                                                                         (1- INDEX)))
                                                                 ((OR (= INDEX (1- START))
                                                                      (ENDP SEQUENCE))
                                                                  NIL)
                                                                 (CL:WHEN (FUNCALL
                                                                           (\, TEST)
                                                                           (FUNCALL KEY (CL:POP
                                                                                         SEQUENCE)))
                                                                        (RETURN INDEX)))
                                                          (CL:DO ((SEQUENCE (NTHCDR START
                                                                                   (\, SEQUENCE)))
                                                                  (INDEX START (1+ INDEX)))
                                                                 ((OR (= INDEX END)
                                                                      (ENDP SEQUENCE))
                                                                  NIL)
                                                                 (CL:WHEN (FUNCALL
                                                                           (\, TEST)
                                                                           (FUNCALL KEY (CL:POP
                                                                                         SEQUENCE)))
                                                                        (RETURN INDEX))))))

(DEFMACRO VECTOR-POSITION-IF-NOT
 (TEST SEQUENCE)
   (BQUOTE (LET ((INCREMENTER (CL:IF FROM-END -1 1))
                 (START (CL:IF FROM-END (1- END)
                               START))
                 (END (CL:IF FROM-END (1- START)
                             END)))
                (CL:DO ((INDEX START (+ INDEX INCREMENTER)))
                       ((= INDEX END)
                        NIL)
                       (CL:UNLESS (FUNCALL (\, TEST)
                                         (FUNCALL KEY (AREF (\, SEQUENCE)
                                                            INDEX)))
                              (RETURN INDEX))))))

(DEFMACRO LIST-POSITION-IF-NOT
 (TEST SEQUENCE)
   (BQUOTE (CL:IF FROM-END (CL:DO ((SEQUENCE (NTHCDR (- LENGTH END)
                                                    (REVERSE (\, SEQUENCE))))
                                   (INDEX (1- END)
                                          (1- INDEX)))
                                  ((OR (= INDEX (1- START))
                                       (ENDP SEQUENCE))
                                   NIL)
                                  (CL:UNLESS (FUNCALL (\, TEST)
                                                    (FUNCALL KEY (CL:POP SEQUENCE)))
                                         (RETURN INDEX)))
                  (CL:DO ((SEQUENCE (NTHCDR START (\, SEQUENCE)))
                          (INDEX START (1+ INDEX)))
                         ((OR (= INDEX END)
                              (ENDP SEQUENCE))
                          NIL)
                         (CL:UNLESS (FUNCALL (\, TEST)
                                           (FUNCALL KEY (CL:POP SEQUENCE)))
                                (RETURN INDEX))))))

(DEFUN LIST-POSITION*
 (ITEM SEQUENCE FROM-END TEST TEST-NOT START END KEY) (LIST-POSITION ITEM 
                                                                                  SEQUENCE))

(DEFUN VECTOR-POSITION*
 (ITEM SEQUENCE FROM-END TEST TEST-NOT START END KEY) (VECTOR-POSITION ITEM 
                                                                                    SEQUENCE))

(DEFUN CL:POSITION
 (ITEM SEQUENCE &KEY FROM-END (TEST (FUNCTION EQL))
                         TEST-NOT
                         (START 0)
                         (END (CL:LENGTH SEQUENCE))
                         (KEY (FUNCTION IDENTITY))) "Returns the zero-origin index of the first element in SEQUENCE satisfying the test (default is EQL) with the given ITEM"
   (SEQ-DISPATCH SEQUENCE (LIST-POSITION* ITEM SEQUENCE FROM-END TEST TEST-NOT START END KEY)
          (VECTOR-POSITION* ITEM SEQUENCE FROM-END TEST TEST-NOT START END KEY)))

(DEFUN POSITION-IF
 (TEST SEQUENCE &KEY FROM-END (START 0)
                         (KEY (FUNCTION IDENTITY))
                         (END (CL:LENGTH SEQUENCE))) 
                             "Returns the zero-origin index of the first element satisfying test(el)"
   (LET ((LENGTH (CL:LENGTH SEQUENCE)))
        (SEQ-DISPATCH SEQUENCE (LIST-POSITION-IF TEST SEQUENCE)
               (VECTOR-POSITION-IF TEST SEQUENCE))))

(DEFUN POSITION-IF-NOT
 (TEST SEQUENCE &KEY FROM-END (START 0)
                             (KEY (FUNCTION IDENTITY))
                             (END (CL:LENGTH SEQUENCE))) 
                         "Returns the zero-origin index of the first element not satisfying test(el)"
   (LET ((LENGTH (CL:LENGTH SEQUENCE)))
        (SEQ-DISPATCH SEQUENCE (LIST-POSITION-IF-NOT TEST SEQUENCE)
               (VECTOR-POSITION-IF-NOT TEST SEQUENCE))))

(DEFMACRO VECTOR-COUNT
 (ITEM SEQUENCE) (BQUOTE (CL:DO ((INDEX START (1+ INDEX))
                                                       (COUNT
 0))
                                                      ((= INDEX END)
                                                       COUNT)
                                                      (CL:IF TEST-NOT
                                                             (CL:UNLESS
                                                              (FUNCALL TEST-NOT (\, ITEM)
                                                                     (FUNCALL KEY (AREF (\, SEQUENCE)
                                                                                        INDEX)))
                                                              (INCF COUNT))
                                                             (CL:WHEN
                                                              (FUNCALL TEST (\, ITEM)
                                                                     (FUNCALL KEY (AREF (\, SEQUENCE)
                                                                                        INDEX)))
                                                              (INCF COUNT))))))

(DEFMACRO LIST-COUNT
 (ITEM SEQUENCE) (BQUOTE (CL:DO ((SEQUENCE (NTHCDR START (\, SEQUENCE)))
                                                     (INDEX START (1+ INDEX))
                                                     (COUNT
 0))
                                                    ((OR (= INDEX END)
                                                         (ENDP SEQUENCE))
                                                     COUNT)
                                                    (CL:IF TEST-NOT (CL:UNLESS
                                                                     (FUNCALL TEST-NOT (\, ITEM)
                                                                            (FUNCALL KEY (CL:POP
                                                                                          SEQUENCE)))
                                                                     (INCF COUNT))
                                                           (CL:WHEN (FUNCALL TEST (\, ITEM)
                                                                           (FUNCALL KEY (CL:POP
                                                                                         SEQUENCE)))
                                                                  (INCF COUNT))))))

(DEFMACRO VECTOR-COUNT-IF
 (PREDICATE SEQUENCE) (BQUOTE
                                                (CL:DO ((INDEX START (1+ INDEX))
                                                        (COUNT
 0))
                                                       ((= INDEX END)
                                                        COUNT)
                                                       (CL:WHEN (FUNCALL (\, PREDICATE)
                                                                       (FUNCALL KEY
                                                                              (AREF (\, SEQUENCE)
                                                                                    INDEX)))
                                                              (INCF COUNT)))))

(DEFMACRO LIST-COUNT-IF
 (PREDICATE SEQUENCE) (BQUOTE (CL:DO ((SEQUENCE (NTHCDR START (\, SEQUENCE)))
                                                             (INDEX START (1+ INDEX))
                                                             (COUNT
 0))
                                                            ((OR (= INDEX END)
                                                                 (ENDP SEQUENCE))
                                                             COUNT)
                                                            (CL:WHEN (FUNCALL (\, PREDICATE)
                                                                            (FUNCALL KEY (CL:POP
                                                                                          SEQUENCE)))
                                                                   (INCF COUNT)))))

(DEFMACRO VECTOR-COUNT-IF-NOT
 (PREDICATE SEQUENCE)
   (BQUOTE (CL:DO ((INDEX START (1+ INDEX))
                   (COUNT
 0))
                  ((= INDEX END)
                   COUNT)
                  (CL:UNLESS (FUNCALL (\, PREDICATE)
                                    (FUNCALL KEY (AREF (\, SEQUENCE)
                                                       INDEX)))
                         (INCF COUNT)))))

(DEFMACRO LIST-COUNT-IF-NOT
 (PREDICATE SEQUENCE) (BQUOTE (CL:DO ((SEQUENCE (NTHCDR START (\, SEQUENCE
                                                                                             )))
                                                                 (INDEX START (1+ INDEX))
                                                                 (COUNT
 0))
                                                                ((OR (= INDEX END)
                                                                     (ENDP SEQUENCE))
                                                                 COUNT)
                                                                (CL:UNLESS (FUNCALL
                                                                            (\, PREDICATE)
                                                                            (FUNCALL KEY (CL:POP
                                                                                          SEQUENCE)))
                                                                       (INCF COUNT)))))

(DEFUN CL:COUNT
 (ITEM SEQUENCE &KEY FROM-END (TEST (FUNCTION EQL))
                      TEST-NOT
                      (START 0)
                      (END (CL:LENGTH SEQUENCE))
                      (KEY (FUNCTION IDENTITY))) 
            (* raf "17-Dec-85 22:39")

   (SEQ-DISPATCH SEQUENCE (LIST-COUNT ITEM SEQUENCE)
          (VECTOR-COUNT ITEM SEQUENCE)))

(DEFUN COUNT-IF
 (TEST SEQUENCE &KEY FROM-END (START 0)
                      (END (CL:LENGTH SEQUENCE))
                      (KEY (FUNCTION IDENTITY))) 
            (* raf "17-Dec-85 22:40")

   (SEQ-DISPATCH SEQUENCE (LIST-COUNT-IF TEST SEQUENCE)
          (VECTOR-COUNT-IF TEST SEQUENCE)))

(DEFUN COUNT-IF-NOT
 (TEST SEQUENCE &KEY FROM-END (START 0)
                          (END (CL:LENGTH SEQUENCE))
                          (KEY (FUNCTION IDENTITY))) 
        (* raf "17-Dec-85 22:40")

   (SEQ-DISPATCH SEQUENCE (LIST-COUNT-IF-NOT TEST SEQUENCE)
          (VECTOR-COUNT-IF-NOT TEST SEQUENCE)))

(DEFMACRO MATCH-VARS
 (&REST BODY) (BQUOTE (LET ((INC (CL:IF FROM-END -1 1))
                                                (START1 (CL:IF FROM-END (1- END1)
                                                               START1))
                                                (START2 (CL:IF FROM-END (1- END2)
                                                               START2))
                                                (END1 (CL:IF FROM-END (1- START1)
                                                             END1))
                                                (END2 (CL:IF FROM-END (1- START2)
                                                             END2)))
                                               (\,@ BODY))))

(DEFMACRO MATCHIFY-LIST
 (SEQUENCE START LENGTH END) (BQUOTE (SETQ (\, SEQUENCE)
                                                             (CL:IF FROM-END
                                                                    (NTHCDR (- (\, LENGTH)
                                                                               (\, START)
                                                                               1)
                                                                           (REVERSE (\, SEQUENCE)))
                                                                    (NTHCDR (\, START)
                                                                           (\, SEQUENCE))))))

(DEFMACRO IF-MISMATCH
 (ELT1 ELT2) (BQUOTE (COND
                                             ((= INDEX1 END1)
                                              (RETURN (COND
                                                         ((= INDEX2 END2)
                                                          NIL)
                                                         (FROM-END (1+ INDEX1))
                                                         (T INDEX1))))
                                             ((= INDEX2 END2)
                                              (RETURN (CL:IF FROM-END (1+ INDEX1)
                                                             INDEX1)))
                                             (TEST-NOT (CL:WHEN (FUNCALL TEST-NOT (FUNCALL
                                                                                   KEY
                                                                                   (\, ELT1))
                                                                       (FUNCALL KEY (\, ELT2)))
                                                              (RETURN (CL:IF FROM-END (1+ INDEX1)
                                                                             INDEX1))))
                                             (T (CL:UNLESS (FUNCALL TEST (FUNCALL KEY (\, ELT1))
                                                                  (FUNCALL KEY (\, ELT2)))
                                                       (RETURN (CL:IF FROM-END (1+ INDEX1)
                                                                      INDEX1)))))))

(DEFMACRO MUMBLE-MUMBLE-MISMATCH
 NIL (BQUOTE (CL:DO ((INDEX1 START1 (+ INDEX1 INC))
                                                     (INDEX2 START2 (+ INDEX2 INC)))
                                                    NIL
                                                    (IF-MISMATCH (AREF SEQUENCE1 INDEX1)
                                                           (AREF SEQUENCE2 INDEX2)))))

(DEFMACRO MUMBLE-LIST-MISMATCH
 NIL (BQUOTE (CL:DO ((INDEX1 START1 (+ INDEX1 INC))
                                                   (INDEX2 START2 (+ INDEX2 INC)))
                                                  NIL
                                                  (IF-MISMATCH (AREF SEQUENCE1 INDEX1)
                                                         (CL:POP SEQUENCE2)))))

(DEFMACRO LIST-MUMBLE-MISMATCH
 NIL (BQUOTE (CL:DO ((INDEX1 START1 (+ INDEX1 INC))
                                                   (INDEX2 START2 (+ INDEX2 INC)))
                                                  NIL
                                                  (IF-MISMATCH (CL:POP SEQUENCE1)
                                                         (AREF SEQUENCE2 INDEX2)))))

(DEFMACRO LIST-LIST-MISMATCH
 NIL (BQUOTE (CL:DO ((INDEX1 START1 (+ INDEX1 INC))
                                                 (INDEX2 START2 (+ INDEX2 INC)))
                                                NIL
                                                (IF-MISMATCH (CL:POP SEQUENCE1)
                                                       (CL:POP SEQUENCE2)))))

(DEFUN MISMATCH
 (SEQUENCE1 SEQUENCE2 &KEY FROM-END (TEST (FUNCTION EQL))
                       TEST-NOT
                       (START1 0)
                       (END1 (CL:LENGTH SEQUENCE1))
                       (START2 0)
                       (END2 (CL:LENGTH SEQUENCE2))
                       (KEY (FUNCTION IDENTITY))) 
           (* raf " 3-Dec-85 15:32")

   (LET ((LENGTH1 (CL:LENGTH SEQUENCE1))
         (LENGTH2 (CL:LENGTH SEQUENCE2)))
        (MATCH-VARS (SEQ-DISPATCH SEQUENCE1 (PROGN (MATCHIFY-LIST SEQUENCE1 START1 LENGTH1 END1)
                                                   (SEQ-DISPATCH SEQUENCE2
                                                          (PROGN (MATCHIFY-LIST SEQUENCE2 START2 
                                                                        LENGTH2 END2)
                                                                 (LIST-LIST-MISMATCH))
                                                          (LIST-MUMBLE-MISMATCH)))
                           (SEQ-DISPATCH SEQUENCE2 (PROGN (MATCHIFY-LIST SEQUENCE2 START2 LENGTH2 
                                                                 END2)
                                                          (MUMBLE-LIST-MISMATCH))
                                  (MUMBLE-MUMBLE-MISMATCH))))))

(DEFMACRO COMPARE-ELEMENTS
 (ELT1 ELT2) (BQUOTE (CL:IF TEST-NOT (NOT (FUNCALL TEST-NOT
                                                                           (FUNCALL KEY (\, ELT1))
                                                                           (FUNCALL KEY (\, ELT2))))
                                                      (FUNCALL TEST (FUNCALL KEY (\, ELT1))
                                                             (FUNCALL KEY (\, ELT2))))))

(DEFMACRO SEARCH-COMPARE-LIST-LIST
 (MAIN SUB) (BQUOTE (CL:DO ((MAIN (\, MAIN)
                                                                    (CDR MAIN))
                                                              (JNDEX START1 (1+ JNDEX))
                                                              (SUB (NTHCDR START1 (\, SUB))
                                                                   (CDR SUB)))
                                                             ((OR (ENDP MAIN)
                                                                  (ENDP SUB)
                                                                  (= END1 JNDEX))
                                                              T)
                                                             (COMPARE-ELEMENTS (CAR MAIN)
                                                                    (CAR SUB)))))

(DEFMACRO SEARCH-COMPARE-LIST-VECTOR
 (MAIN SUB) (BQUOTE (CL:DO ((MAIN (\, MAIN)
                                                                      (CDR MAIN))
                                                                (INDEX START1 (1+ INDEX)))
                                                               ((OR (ENDP MAIN)
                                                                    (= INDEX END1))
                                                                T)
                                                               (COMPARE-ELEMENTS (CAR MAIN)
                                                                      (AREF (\, SUB)
                                                                            INDEX)))))

(DEFMACRO SEARCH-COMPARE-VECTOR-LIST
 (MAIN SUB INDEX) (BQUOTE (CL:DO ((SUB (NTHCDR START1
                                                                                  (\, SUB))
                                                                           (CDR SUB))
                                                                      (JNDEX START1 (1+ JNDEX))
                                                                      (INDEX (\, INDEX)
                                                                             (1+ INDEX)))
                                                                     ((OR (= END1 JNDEX)
                                                                          (ENDP SUB))
                                                                      T)
                                                                     (COMPARE-ELEMENTS
                                                                      (AREF (\, MAIN)
                                                                            INDEX)
                                                                      (CAR SUB)))))

(DEFMACRO SEARCH-COMPARE-VECTOR-VECTOR
 (MAIN SUB INDEX) (BQUOTE (CL:DO ((INDEX (\, INDEX)
                                                                               (1+ INDEX))
                                                                        (SUB-INDEX START1
                                                                               (1+ SUB-INDEX)))
                                                                       ((= SUB-INDEX END1)
                                                                        T)
                                                                       (COMPARE-ELEMENTS
                                                                        (AREF (\, MAIN)
                                                                              INDEX)
                                                                        (AREF (\, SUB)
                                                                              SUB-INDEX)))))

(DEFMACRO SEARCH-COMPARE
 (MAIN-TYPE MAIN SUB INDEX) (CL:IF (EQ MAIN-TYPE (QUOTE LIST))
                                                           (BQUOTE (SEQ-DISPATCH (\, SUB)
                                                                          (SEARCH-COMPARE-LIST-LIST
                                                                           (\, MAIN)
                                                                           (\, SUB))
                                                                          (SEARCH-COMPARE-LIST-VECTOR
                                                                           (\, MAIN)
                                                                           (\, SUB))))
                                                           (BQUOTE (SEQ-DISPATCH (\, SUB)
                                                                          (SEARCH-COMPARE-VECTOR-LIST
                                                                           (\, MAIN)
                                                                           (\, SUB)
                                                                           (\, INDEX))
                                                                          (
                                                                         SEARCH-COMPARE-VECTOR-VECTOR
                                                                           (\, MAIN)
                                                                           (\, SUB)
                                                                           (\, INDEX))))))

(DEFMACRO LIST-SEARCH
 (MAIN SUB) (BQUOTE (CL:DO ((MAIN (NTHCDR START2 (\, MAIN))
                                                       (CDR MAIN))
                                                 (INDEX2 START2 (1+ INDEX2))
                                                 (TERMINUS (- END2 (- END1 START1)))
                                                 (LAST-MATCH NIL))
                                                ((> INDEX2 TERMINUS)
                                                 LAST-MATCH)
                                                (CL:WHEN (SEARCH-COMPARE LIST MAIN (\, SUB)
                                                                INDEX2)
                                                       (CL:IF FROM-END (SETQ LAST-MATCH INDEX2)
                                                              (RETURN INDEX2))))))

(DEFMACRO VECTOR-SEARCH
 (MAIN SUB) (BQUOTE (CL:DO ((INDEX2 START2 (1+ INDEX2))
                                                   (TERMINUS (- END2 (- END1 START1)))
                                                   (LAST-MATCH NIL))
                                                  ((> INDEX2 TERMINUS)
                                                   LAST-MATCH)
                                                  (CL:WHEN (SEARCH-COMPARE VECTOR (\, MAIN)
                                                                  (\, SUB)
                                                                  INDEX2)
                                                         (CL:IF FROM-END (SETQ LAST-MATCH INDEX2)
                                                                (RETURN INDEX2))))))

(DEFUN SEARCH
 (SEQUENCE1 SEQUENCE2 &KEY FROM-END (TEST (FUNCTION EQL))
                     TEST-NOT
                     (START1 0)
                     (END1 (CL:LENGTH SEQUENCE1))
                     (START2 0)
                     (END2 (CL:LENGTH SEQUENCE2))
                     (KEY (FUNCTION IDENTITY))) "A search is conducted using EQL for the first subsequence of sequence2 which element-wise matches sequence1.  If there is such a subsequence in sequence2, the index of the its leftmost element is returned otherwise () is returned."
   (SEQ-DISPATCH SEQUENCE2 (LIST-SEARCH SEQUENCE2 SEQUENCE1)
          (VECTOR-SEARCH SEQUENCE2 SEQUENCE1)))

(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS 

(ADDTOVAR NLAMA
 )

(ADDTOVAR NLAML
 )

(ADDTOVAR LAMA
 BIT-VECTOR-TO-SIMPLE-BIT-VECTOR* STRING-TO-SIMPLE-STRING* VECTOR-TO-BIT-VECTOR* 
                     VECTOR-TO-STRING* VECTOR-TO-VECTOR* VECTOR-TO-LIST* LIST-TO-VECTOR* 
                     LIST-TO-BIT-VECTOR* LIST-TO-STRING* CL:COERCE)
)
(PUTPROPS CMLSEQ COPYRIGHT ("Xerox Corporation" 1985 1986))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (8897 18189 (CL:COERCE 8907 . 14065) (LIST-TO-STRING* 14067 . 14473) (
LIST-TO-BIT-VECTOR* 14475 . 14967) (LIST-TO-VECTOR* 14969 . 15389) (VECTOR-TO-LIST* 15391 . 15756) (
VECTOR-TO-VECTOR* 15758 . 16180) (VECTOR-TO-STRING* 16182 . 16590) (VECTOR-TO-BIT-VECTOR* 16592 . 
17086) (STRING-TO-SIMPLE-STRING* 17088 . 17612) (BIT-VECTOR-TO-SIMPLE-BIT-VECTOR* 17614 . 18187)))))
STOP