(FILECREATED "16-Jul-86 01:24:59" {ERIS}<LISPCORE>EVAL>CMLSEQMODIFY.;1
 64131  

      changes to:  (FUNCTIONS VECTOR-SUBSTITUTE*)

      previous date: " 2-Jul-86 18:08:00" {ERIS}<LISPCORE>LIBRARY>CMLSEQMODIFY.;1)


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

(PRETTYCOMPRINT CMLSEQMODIFYCOMS)

(RPAQQ CMLSEQMODIFYCOMS
 ((DECLARE: EVAL@COMPILE DONTCOPY (FILES CMLSEQCOMMON))
                         (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)
                         (PROP FILETYPE CMLSEQMODIFY)))
(DECLARE: EVAL@COMPILE DONTCOPY 
(FILESLOAD CMLSEQCOMMON)
)
(DEFUN FILL
 (SEQUENCE ITEM &KEY (START 0)
                   END &AUX (LENGTH (CL:LENGTH SEQUENCE))) 
                                              "Replace the specified elements of SEQUENCE with ITEM."
   (CL:UNLESS END (SETQ END LENGTH))
   (CHECK-SUBSEQ SEQUENCE START END LENGTH)
   (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))
                         ((:START2 SOURCE-START)
                          0)
                         ((:END2 SOURCE-END))
                         &AUX
                         (TARGET-LENGTH (CL:LENGTH TARGET-SEQUENCE))
                         (SOURCE-LENGTH (CL:LENGTH SOURCE-SEQUENCE))) 

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

   (CL:UNLESS TARGET-END (SETQ TARGET-END TARGET-LENGTH))
   (CL:UNLESS SOURCE-END (SETQ SOURCE-END SOURCE-LENGTH))
   (CHECK-SUBSEQ TARGET-SEQUENCE TARGET-START TARGET-END TARGET-LENGTH)
   (CHECK-SUBSEQ SOURCE-SEQUENCE SOURCE-START SOURCE-END SOURCE-LENGTH)
   (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
                       (COUNT MOST-POSITIVE-FIXNUM)
                       (KEY (FUNCTION IDENTITY))
                       &AUX
                       (LENGTH (CL:LENGTH SEQUENCE))) 
    "Returns a sequence formed by destructively removing the specified Item from the given sequence."
   (CL:UNLESS END (SETQ END LENGTH))
   (CHECK-SUBSEQ SEQUENCE START END LENGTH)
   (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
                        (COUNT MOST-POSITIVE-FIXNUM)
                        &AUX
                        (LENGTH (CL:LENGTH SEQUENCE))) "Returns a sequence formed by destructively removing the elements satisfying the specified predicate from the given sequence."
   (CL:UNLESS END (SETQ END LENGTH))
   (CHECK-SUBSEQ SEQUENCE START END LENGTH)
   (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
                            (KEY (FUNCTION IDENTITY))
                            (COUNT MOST-POSITIVE-FIXNUM)
                            &AUX
                            (LENGTH (CL:LENGTH SEQUENCE))) "Returns a sequence formed by destructively removing the elements not satisfying the specified Predicate from the given Sequence."
   (CL:UNLESS END (SETQ END LENGTH))
   (CHECK-SUBSEQ SEQUENCE START END LENGTH)
   (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
                       (COUNT MOST-POSITIVE-FIXNUM)
                       (KEY (FUNCTION IDENTITY))
                       &AUX
                       (LENGTH (CL:LENGTH SEQUENCE))) 
       (* raf " 3-Dec-85 23:31")

   (CL:UNLESS END (SETQ END LENGTH))
   (CHECK-SUBSEQ SEQUENCE START END LENGTH)
   (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
                        (COUNT MOST-POSITIVE-FIXNUM)
                        (KEY (FUNCTION IDENTITY))
                        &AUX
                        (LENGTH (CL:LENGTH SEQUENCE))) 
      "Returns a copy of sequence with elements such that predicate(element) is non-null are removed"
   (CL:UNLESS END (SETQ END LENGTH))
   (CHECK-SUBSEQ SEQUENCE START END LENGTH)
   (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
                            (COUNT MOST-POSITIVE-FIXNUM)
                            (KEY (FUNCTION IDENTITY))
                            &AUX
                            (LENGTH (CL:LENGTH SEQUENCE))) 
          "Returns a copy of sequence with elements such that predicate(element) is null are removed"
   (CL:UNLESS END (SETQ END LENGTH))
   (CHECK-SUBSEQ SEQUENCE START END LENGTH)
   (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 (KEY (FUNCTION IDENTITY))
                                &AUX
                                (LENGTH (CL:LENGTH SEQUENCE))) "The elements of Sequence are examined, and if any two match, one is discarded.  The resulting sequence is returned."
   (CL:UNLESS END (SETQ END LENGTH))
   (CHECK-SUBSEQ SEQUENCE START END LENGTH)
   (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 (KEY (FUNCTION IDENTITY))
                                &AUX
                                (LENGTH (CL:LENGTH SEQUENCE))) "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."
   (CL:UNLESS END (SETQ END LENGTH))
   (CHECK-SUBSEQ SEQUENCE START END LENGTH)
   (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
                       (KEY (FUNCTION IDENTITY))
                       &AUX
                       (LENGTH (CL:LENGTH SEQUENCE))) "Returns a sequence of the same kind as Sequence with the same elements except that all elements that match Old are replaced with New."
   (CL:UNLESS END (SETQ END LENGTH))
   (CHECK-SUBSEQ SEQUENCE START END LENGTH)
   (SUBST-DISPATCH (QUOTE NORMAL)))

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

(DEFUN SUBSTITUTE-IF-NOT
 (NEW TEST SEQUENCE &KEY FROM-END (START 0)
                              END
                              (COUNT MOST-POSITIVE-FIXNUM)
                              (KEY (FUNCTION IDENTITY))
                              &AUX
                              (LENGTH (CL:LENGTH SEQUENCE))) "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."
   (CL:UNLESS END (SETQ END LENGTH))
   (CHECK-SUBSEQ SEQUENCE START END LENGTH)
   (LET (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 (COUNT MOST-POSITIVE-FIXNUM)
                        (KEY (FUNCTION IDENTITY))
                        (START 0)
                        &KEY
                        (LENGTH (CL:LENGTH SEQUENCE))) 
      (* raf "27-Jan-86 17:31")

   (CL:UNLESS END (SETQ END LENGTH))
   (CHECK-SUBSEQ SEQUENCE START END LENGTH)
   (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
                           (COUNT MOST-POSITIVE-FIXNUM)
                           (KEY (FUNCTION IDENTITY))
                           &AUX
                           (LENGTH (CL:LENGTH SEQUENCE))) 
   (* raf "27-Jan-86 17:31")

   (CL:UNLESS END (SETQ END LENGTH))
   (CHECK-SUBSEQ SEQUENCE START END LENGTH)
   (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
                               (COUNT MOST-POSITIVE-FIXNUM)
                               (KEY (FUNCTION IDENTITY))
                               &AUX
                               (LENGTH (CL:LENGTH SEQUENCE))) 

                                                             (* raf "27-Jan-86 17:31")

   (CL:UNLESS END (SETQ END LENGTH))
   (CHECK-SUBSEQ SEQUENCE START END LENGTH)
   (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))))


(PUTPROPS CMLSEQMODIFY FILETYPE
 COMPILE-FILE)
(PUTPROPS CMLSEQMODIFY COPYRIGHT ("Xerox Corporation" 1986))
(DECLARE: DONTCOPY
  (FILEMAP (NIL)))
STOP