(FILECREATED "27-Jan-86 17:32:42" {ERIS}<LISPCORE>LIBRARY>CMLSEQ.;14 133808
changes to: (MACROS SEQ-DISPATCH SUBST-DISPATCH)
(FNS MAKE-SEQUENCE-OF-TYPE CL:ELT CL:\SETELT MAKE-SEQUENCE REDUCE NSUBSTITUTE
NSUBSTITUTE-IF NSUBSTITUTE-IF-NOT)
previous date: "24-Jan-86 15:51:11" {ERIS}<LISPCORE>LIBRARY>CMLSEQ.;13)
(* Copyright (c) 1985, 1986 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT CMLSEQCOMS)
(RPAQQ CMLSEQCOMS [(MACROS SEQ-DISPATCH ELT-SLICE MAKE-SEQUENCE-LIKE TYPE-SPECIFIER VECTOR-COPY-SEQ
LIST-COPY-SEQ VECTOR-FILL LIST-FILL MUMBLE-REPLACE-FROM-MUMBLE
LIST-REPLACE-FROM-LIST LIST-REPLACE-FROM-MUMBLE MUMBLE-REPLACE-FROM-LIST
VECTOR-REVERSE LIST-REVERSE-MACRO VECTOR-NREVERSE LIST-NREVERSE-MACRO
CONCATENATE-TO-LIST CONCATENATE-TO-MUMBLE MAP-TO-LIST MAP-TO-SIMPLE
MAP-FOR-EFFECT MUMBLE-REDUCE MUMBLE-REDUCE-FROM-END LIST-REDUCE
LIST-REDUCE-FROM-END MUMBLE-DELETE MUMBLE-DELETE-FROM-END
NORMAL-MUMBLE-DELETE NORMAL-MUMBLE-DELETE-FROM-END LIST-DELETE
LIST-DELETE-FROM-END NORMAL-LIST-DELETE NORMAL-LIST-DELETE-FROM-END
IF-MUMBLE-DELETE IF-MUMBLE-DELETE-FROM-END IF-LIST-DELETE
IF-LIST-DELETE-FROM-END IF-NOT-MUMBLE-DELETE IF-NOT-MUMBLE-DELETE-FROM-END
IF-NOT-LIST-DELETE IF-NOT-LIST-DELETE-FROM-END MUMBLE-REMOVE-MACRO
MUMBLE-REMOVE MUMBLE-REMOVE-FROM-END NORMAL-MUMBLE-REMOVE
NORMAL-MUMBLE-REMOVE-FROM-END IF-MUMBLE-REMOVE IF-MUMBLE-REMOVE-FROM-END
IF-NOT-MUMBLE-REMOVE IF-NOT-MUMBLE-REMOVE-FROM-END LIST-REMOVE-MACRO
LIST-REMOVE LIST-REMOVE-FROM-END NORMAL-LIST-REMOVE
NORMAL-LIST-REMOVE-FROM-END IF-LIST-REMOVE IF-LIST-REMOVE-FROM-END
IF-NOT-LIST-REMOVE IF-NOT-LIST-REMOVE-FROM-END SUBST-DISPATCH
VECTOR-POSITION VECTOR-POSITION-IF LIST-POSITION LIST-POSITION-IF
VECTOR-POSITION-IF-NOT LIST-POSITION-IF-NOT VECTOR-COUNT LIST-COUNT
VECTOR-COUNT-IF LIST-COUNT-IF VECTOR-COUNT-IF-NOT LIST-COUNT-IF-NOT
VECTOR-FIND LIST-FIND VECTOR-FIND-IF LIST-FIND-IF VECTOR-FIND-IF-NOT
LIST-FIND-IF-NOT MATCH-VARS MATCHIFY-LIST IF-MISMATCH
MUMBLE-MUMBLE-MISMATCH MUMBLE-LIST-MISMATCH LIST-MUMBLE-MISMATCH
LIST-LIST-MISMATCH COMPARE-ELEMENTS SEARCH-COMPARE-LIST-LIST
SEARCH-COMPARE-LIST-VECTOR SEARCH-COMPARE-VECTOR-LIST
SEARCH-COMPARE-VECTOR-VECTOR SEARCH-COMPARE LIST-SEARCH VECTOR-SEARCH)
(PROP SETFN CL:ELT)
(FNS MAKE-SEQUENCE-OF-TYPE CL:ELT CL:\SETELT LIST-LENGTH* MAKE-SEQUENCE
VECTOR-SUBSEQ* LIST-SUBSEQ* SUBSEQ COPY-SEQ LIST-COPY-SEQ* VECTOR-COPY-SEQ*
LIST-FILL* VECTOR-FILL* FILL LIST-REPLACE-FROM-LIST*
LIST-REPLACE-FROM-VECTOR* VECTOR-REPLACE-FROM-LIST*
VECTOR-REPLACE-FROM-VECTOR* CL:REPLACE CL:REVERSE LIST-REVERSE*
VECTOR-REVERSE* LIST-NREVERSE* VECTOR-NREVERSE* CL:NREVERSE CONCATENATE
CONCAT-TO-LIST* CONCAT-TO-SIMPLE* CL:MAP CL:SOME CL:EVERY CL:NOTANY
CL:NOTEVERY REDUCE 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* CL:DELETE DELETE-IF DELETE-IF-NOT CL:REMOVE
REMOVE-IF REMOVE-IF-NOT LIST-REMOVE-DUPLICATES* VECTOR-REMOVE-DUPLICATES*
REMOVE-DUPLICATES LIST-DELETE-DUPLICATES* VECTOR-DELETE-DUPLICATES*
DELETE-DUPLICATES LIST-SUBSTITUTE* VECTOR-SUBSTITUTE* SUBSTITUTE
SUBSTITUTE-IF SUBSTITUTE-IF-NOT NSUBSTITUTE NLIST-SUBSTITUTE*
NVECTOR-SUBSTITUTE* NSUBSTITUTE-IF NLIST-SUBSTITUTE-IF*
NVECTOR-SUBSTITUTE-IF* NSUBSTITUTE-IF-NOT NLIST-SUBSTITUTE-IF-NOT*
NVECTOR-SUBSTITUTE-IF-NOT* CL:POSITION LIST-POSITION* VECTOR-POSITION*
POSITION-IF POSITION-IF-NOT CL:COUNT COUNT-IF COUNT-IF-NOT CL:FIND LIST-FIND*
VECTOR-FIND* FIND-IF FIND-IF-NOT MISMATCH SEARCH)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDVARS (NLAMA)
(NLAML)
(LAMA SEARCH MISMATCH FIND-IF-NOT FIND-IF CL:FIND COUNT-IF-NOT
COUNT-IF CL:COUNT POSITION-IF-NOT POSITION-IF CL:POSITION
NSUBSTITUTE-IF-NOT NSUBSTITUTE-IF NSUBSTITUTE
SUBSTITUTE-IF-NOT SUBSTITUTE-IF SUBSTITUTE DELETE-DUPLICATES
VECTOR-DELETE-DUPLICATES* REMOVE-DUPLICATES
VECTOR-REMOVE-DUPLICATES* REMOVE-IF-NOT REMOVE-IF CL:REMOVE
DELETE-IF-NOT DELETE-IF CL:DELETE REDUCE CL:NOTEVERY CL:NOTANY
CL:EVERY CL:SOME CL:MAP CONCAT-TO-SIMPLE* CONCAT-TO-LIST*
CONCATENATE CL:REPLACE FILL SUBSEQ LIST-SUBSEQ* VECTOR-SUBSEQ*
MAKE-SEQUENCE])
(DECLARE: EVAL@COMPILE
[DEFMACRO SEQ-DISPATCH (SEQUENCE LIST-FORM ARRAY-FORM)
(BQUOTE (COND ((CL:LISTP (\, SEQUENCE))
(\, LIST-FORM))
(T (\, ARRAY-FORM]
[DEFMACRO ELT-SLICE (SEQUENCES N)
"Returns a list of the Nth element of each of the sequences. Used by MAP
and friends."
(BQUOTE (CL:MAPCAR [FUNCTION (CL:LAMBDA (SEQ)
(CL:ELT SEQ (\, N]
(\, SEQUENCES]
[DEFMACRO MAKE-SEQUENCE-LIKE (SEQUENCE CL:LENGTH)
"Returns a sequence of the same type as SEQUENCE and the given LENGTH."
(BQUOTE (MAKE-SEQUENCE-OF-TYPE (TYPE-OF (\, SEQUENCE))
(\, CL:LENGTH]
[DEFMACRO TYPE-SPECIFIER (TYPE)
"Returns the broad class of which TYPE is a specific subclass."
(BQUOTE (COND ((CL:ATOM (\, TYPE))
(\, TYPE))
(T (CAR (\, TYPE]
[DEFMACRO VECTOR-COPY-SEQ (SEQUENCE TYPE)
(BQUOTE (LET [(CL:LENGTH (CL:LENGTH (THE VECTOR (\, SEQUENCE]
(CL:DO ((INDEX 0 (1+ INDEX))
(COPY (MAKE-SEQUENCE-OF-TYPE (\, TYPE)
CL:LENGTH)))
((= INDEX CL:LENGTH)
COPY)
(SETF (AREF COPY INDEX)
(AREF (\, SEQUENCE)
INDEX]
[DEFMACRO LIST-COPY-SEQ (LIST)
(BQUOTE (COND ((CL:ATOM (\, LIST))
(QUOTE NIL))
(T (LET [(RESULT (CONS (CAR (\, LIST))
(QUOTE NIL]
(CL:DO [(X (CDR (\, LIST))
(CDR X))
(SPLICE RESULT (CDR (RPLACD SPLICE (CONS (CAR X)
(QUOTE NIL]
((CL:ATOM X)
(COND ((NOT (NULL X))
(RPLACD SPLICE X)))
RESULT]
[DEFMACRO VECTOR-FILL (SEQUENCE ITEM START END)
(BQUOTE (CL:DO ((INDEX (\, START)
(1+ INDEX)))
((= INDEX (\, END))
(\, SEQUENCE))
(SETF (AREF (\, SEQUENCE)
INDEX)
(\, ITEM]
[DEFMACRO LIST-FILL (SEQUENCE ITEM START END)
(BQUOTE (CL:DO ((CURRENT (NTHCDR (\, START)
(\, SEQUENCE))
(CDR CURRENT))
(INDEX (\, START)
(1+ INDEX)))
((OR (CL:ATOM CURRENT)
(= INDEX (\, END)))
SEQUENCE)
(RPLACA CURRENT (\, ITEM]
[DEFMACRO MUMBLE-REPLACE-FROM-MUMBLE NIL (BQUOTE (COND [(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 (1- TARGET-START
))
TARGET-SEQUENCE)
(SETF (AREF TARGET-SEQUENCE
TARGET-INDEX)
(AREF SOURCE-SEQUENCE
SOURCE-INDEX]
(T (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)))
((NULL 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)
(NULL 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)
(NULL SOURCE-SEQUENCE))
TARGET-SEQUENCE)
(SETF (AREF TARGET-SEQUENCE TARGET-INDEX)
(CAR SOURCE-SEQUENCE]
[DEFMACRO VECTOR-REVERSE (SEQUENCE TYPE)
(BQUOTE (LET [(CL:LENGTH (CL:LENGTH (\, SEQUENCE]
(CL:DO ((FORWARD-INDEX 0 (1+ FORWARD-INDEX))
(BACKWARD-INDEX (1- CL:LENGTH)
(1- BACKWARD-INDEX))
(NEW-SEQUENCE (MAKE-SEQUENCE-OF-TYPE (\, TYPE)
CL:LENGTH)))
((= FORWARD-INDEX CL:LENGTH)
NEW-SEQUENCE)
(SETF (AREF NEW-SEQUENCE FORWARD-INDEX)
(AREF (\, SEQUENCE)
BACKWARD-INDEX]
[DEFMACRO LIST-REVERSE-MACRO (SEQUENCE)
(BQUOTE (CL:DO ((NEW-LIST NIL))
((CL:ATOM (\, SEQUENCE))
NEW-LIST)
(PUSH NEW-LIST (POP (\, SEQUENCE]
[DEFMACRO VECTOR-NREVERSE (SEQUENCE)
(BQUOTE (LET [(CL:LENGTH (CL:LENGTH (THE VECTOR (\, SEQUENCE]
(CL:DO ((LEFT-INDEX 0 (1+ LEFT-INDEX))
(RIGHT-INDEX (1- CL:LENGTH)
(1- RIGHT-INDEX))
(HALF-LENGTH (TRUNCATE CL:LENGTH 2)))
((= LEFT-INDEX HALF-LENGTH)
(\, SEQUENCE))
(ROTATEF (AREF (\, SEQUENCE)
LEFT-INDEX)
(AREF (\, SEQUENCE)
RIGHT-INDEX]
[DEFMACRO LIST-NREVERSE-MACRO (LIST)
(BQUOTE (CL:DO ([1ST (CDR (\, LIST))
(COND ((CL:ATOM 1ST)
1ST)
(T (CDR 1ST]
(2ND (\, LIST)
1ST)
(3RD (QUOTE NIL)
2ND))
((CL:ATOM 2ND)
3RD)
(RPLACD 2ND 3RD]
[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)))
((CL:ATOM SEQUENCE))
(SETQ SPLICE
(CDR (RPLACD SPLICE
(LIST (CAR SEQUENCE]
(CL:DO ((INDEX 0 (1+ INDEX))
(CL:LENGTH (CL:LENGTH SEQUENCE)))
((= INDEX CL:LENGTH))
(SETQ SPLICE (CDR (RPLACD SPLICE
(LIST (AREF SEQUENCE INDEX]
[DEFMACRO CONCATENATE-TO-MUMBLE (OUTPUT-TYPE-SPEC SEQUENCES)
(BQUOTE (CL:DO ((SEQS (\, SEQUENCES)
(CDR SEQS))
(TOTAL-LENGTH 0)
(LENGTHS NIL))
[(NULL SEQS)
(BREAK1 NIL T)
(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))
(SETQ INDEX (1+ INDEX)))
(CL:DO ((JNDEX 0 (1+ JNDEX)))
((= JNDEX (CAR LENGTHS)))
(SETF (AREF RESULT INDEX)
(AREF SEQUENCE JNDEX))
(SETQ INDEX (1+ INDEX]
(LET [(CL:LENGTH (CL:LENGTH (CAR SEQS]
(SETQ LENGTHS (NCONC LENGTHS (LIST CL:LENGTH)))
(SETQ TOTAL-LENGTH (+ TOTAL-LENGTH CL:LENGTH]
[DEFMACRO MAP-TO-LIST (FUNCTION SEQUENCES)
(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 (LIST (CL:APPLY
(\, FUNCTION)
(ELT-SLICE (\, SEQUENCES)
INDEX]
(LET [(CL:LENGTH (CL:LENGTH (CAR SEQS]
(COND ((< CL:LENGTH MIN-LENGTH)
(SETQ MIN-LENGTH CL:LENGTH))
(T NIL]
[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 [(CL:LENGTH (CL:LENGTH (CAR SEQS]
(COND ((< CL:LENGTH MIN-LENGTH)
(SETQ MIN-LENGTH CL:LENGTH))
(T NIL]
[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 [(CL:LENGTH (CL:LENGTH (CAR SEQS]
(COND ((< CL:LENGTH MIN-LENGTH)
(SETQ MIN-LENGTH CL:LENGTH))
(T NIL]
[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]
[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 LIST-REDUCE (FUNCTION SEQUENCE START END INITIAL-VALUE)
(BQUOTE (LET [(SEQUENCE (NTHCDR (\, START)
(\, SEQUENCE]
(CL:DO [(CL:COUNT [COND ((\, INITIAL-VALUE)
(\, START))
(T (1+ (\, START]
(1+ CL:COUNT))
(SEQUENCE (COND ((\, INITIAL-VALUE)
SEQUENCE)
(T (CDR SEQUENCE)))
(CDR SEQUENCE))
(VALUE (COND ((\, INITIAL-VALUE)
(\, INITIAL-VALUE))
(T (CAR SEQUENCE)))
(FUNCALL (\, FUNCTION)
VALUE
(CAR SEQUENCE]
((= CL:COUNT (\, END))
VALUE]
[DEFMACRO LIST-REDUCE-FROM-END (FUNCTION SEQUENCE START END INITIAL-VALUE)
(BQUOTE (LET [(SEQUENCE (NTHCDR (- (CL:LENGTH (\, SEQUENCE))
(\, END))
(CL:REVERSE (\, SEQUENCE]
(CL:DO ((CL:COUNT [COND ((\, INITIAL-VALUE)
(\, START))
(T (1+ (\, START]
(1+ CL:COUNT))
(SEQUENCE (COND ((\, INITIAL-VALUE)
SEQUENCE)
(T (CDR SEQUENCE)))
(CDR SEQUENCE))
(VALUE (COND ((\, INITIAL-VALUE)
(\, INITIAL-VALUE))
(T (CAR SEQUENCE)))
(FUNCALL (\, FUNCTION)
(CAR SEQUENCE)
VALUE)))
((= CL:COUNT (\, END))
VALUE]
[DEFMACRO MUMBLE-DELETE (PRED)
(BQUOTE (CL:DO ((INDEX START (1+ INDEX))
(JNDEX START)
(NUMBER-ZAPPED 0))
[(OR (= INDEX END)
(= NUMBER-ZAPPED CL:COUNT))
(CL:DO ((INDEX INDEX (1+ INDEX))
(* " copy the rest of the vector" *)
(JNDEX JNDEX (1+ JNDEX)))
((= INDEX CL:LENGTH)
(SHRINK-VECTOR SEQUENCE JNDEX))
(SETF (AREF SEQUENCE JNDEX)
(AREF SEQUENCE INDEX]
(SETF (AREF SEQUENCE JNDEX)
(AREF SEQUENCE INDEX))
(COND ((\, PRED)
(SETQ NUMBER-ZAPPED (1+ NUMBER-ZAPPED)))
(T (SETQ JNDEX (1+ JNDEX]
[DEFMACRO MUMBLE-DELETE-FROM-END (PRED)
(BQUOTE (CL:DO ((INDEX (1- END)
(1- INDEX))
(* " find the losers" *)
(NUMBER-ZAPPED 0)
(LOSERS NIL)
THIS-ELEMENT
(TERMINUS (1- START)))
[(OR (= INDEX TERMINUS)
(= NUMBER-ZAPPED CL:COUNT))
(CL:DO ((LOSERS LOSERS)
(* " delete the losers" *)
(INDEX START (1+ INDEX))
(JNDEX START))
[(OR (NULL LOSERS)
(= INDEX END))
(CL:DO ((INDEX INDEX (1+ INDEX))
(* " copy the rest of the vector" *)
(JNDEX JNDEX (1+ JNDEX)))
((= INDEX CL:LENGTH)
(SHRINK-VECTOR SEQUENCE JNDEX))
(SETF (AREF SEQUENCE JNDEX)
(AREF SEQUENCE INDEX]
(SETF (AREF SEQUENCE JNDEX)
(AREF SEQUENCE INDEX))
(COND ((= INDEX (CAR LOSERS))
(POP LOSERS))
(T (SETQ JNDEX (1+ JNDEX]
(SETQ THIS-ELEMENT (AREF SEQUENCE INDEX))
(COND ((\, PRED)
(SETQ NUMBER-ZAPPED (1+ NUMBER-ZAPPED))
(PUSH LOSERS INDEX]
[DEFMACRO NORMAL-MUMBLE-DELETE NIL (BQUOTE (MUMBLE-DELETE (COND
[TEST-NOT
(NOT (FUNCALL TEST-NOT ITEM
(FUNCALL KEY (AREF SEQUENCE
INDEX]
(T (FUNCALL TEST ITEM
(FUNCALL KEY (AREF SEQUENCE
INDEX]
[DEFMACRO NORMAL-MUMBLE-DELETE-FROM-END NIL (BQUOTE (MUMBLE-DELETE-FROM-END
(COND [TEST-NOT (NOT (FUNCALL TEST-NOT ITEM
(FUNCALL KEY
THIS-ELEMENT]
(T (FUNCALL TEST ITEM (FUNCALL KEY
THIS-ELEMENT]
[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 CL:COUNT))
(CDR HANDLE))
(COND ((\, PRED)
(RPLACD PREVIOUS (CDR CURRENT))
(SETQ NUMBER-ZAPPED (1+ NUMBER-ZAPPED)))
(T (SETQ PREVIOUS (CDR PREVIOUS]
[DEFMACRO LIST-DELETE-FROM-END (PRED)
(BQUOTE (LET* ((CL:REVERSE (CL:NREVERSE (THE LIST SEQUENCE)))
(HANDLE (CONS NIL CL:REVERSE)))
(CL:DO ((CURRENT (NTHCDR (- CL:LENGTH END)
CL:REVERSE)
(CDR CURRENT))
(PREVIOUS (NTHCDR (- CL:LENGTH END)
HANDLE))
(INDEX START (1+ INDEX))
(NUMBER-ZAPPED 0))
((OR (= INDEX END)
(= NUMBER-ZAPPED CL:COUNT))
(CL:NREVERSE (CDR HANDLE)))
(COND ((\, PRED)
(RPLACD PREVIOUS (CDR CURRENT))
(SETQ NUMBER-ZAPPED (1+ NUMBER-ZAPPED)))
(T (SETQ PREVIOUS (CDR PREVIOUS]
[DEFMACRO NORMAL-LIST-DELETE NIL (QUOTE (LIST-DELETE (COND [TEST-NOT
(NOT (FUNCALL TEST-NOT ITEM
(FUNCALL KEY (CAR CURRENT]
(T (FUNCALL TEST ITEM (FUNCALL
KEY
(CAR CURRENT]
[DEFMACRO NORMAL-LIST-DELETE-FROM-END NIL (QUOTE (LIST-DELETE-FROM-END
(COND [TEST-NOT (NOT (FUNCALL TEST-NOT ITEM
(FUNCALL KEY
(CAR CURRENT]
(T (FUNCALL TEST ITEM (FUNCALL KEY
(CAR CURRENT]
[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]
[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]
[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 CL:LENGTH)))
((= INDEX (\, BEGIN))
RESULT)
(SETF (AREF RESULT INDEX)
(AREF SEQUENCE INDEX]
(NEW-INDEX (\, BEGIN))
(NUMBER-ZAPPED 0)
(THIS-ELEMENT))
[(OR (= INDEX (\, FINISH))
(= NUMBER-ZAPPED CL: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]
(SETQ THIS-ELEMENT (AREF SEQUENCE INDEX))
(COND ((\, PRED)
(SETF (AREF RESULT NEW-INDEX)
THIS-ELEMENT)
(SETQ NEW-INDEX ((\, BUMP)
NEW-INDEX)))
(T (SETQ NUMBER-ZAPPED (1+ NUMBER-ZAPPED]
[DEFMACRO MUMBLE-REMOVE (PRED)
(BQUOTE (MUMBLE-REMOVE-MACRO 1+ 0 START END CL:LENGTH (\, PRED]
[DEFMACRO MUMBLE-REMOVE-FROM-END (PRED)
(BQUOTE (LET ((SEQUENCE (COPY-SEQ SEQUENCE)))
(MUMBLE-DELETE-FROM-END (NOT (\, PRED]
[DEFMACRO NORMAL-MUMBLE-REMOVE NIL (BQUOTE (MUMBLE-REMOVE (COND (TEST-NOT (FUNCALL TEST-NOT ITEM
(FUNCALL KEY
THIS-ELEMENT)
))
(T (NOT (FUNCALL TEST ITEM
(FUNCALL KEY
THIS-ELEMENT]
[DEFMACRO NORMAL-MUMBLE-REMOVE-FROM-END NIL (BQUOTE (MUMBLE-REMOVE-FROM-END
(COND (TEST-NOT (FUNCALL TEST-NOT ITEM
(FUNCALL KEY THIS-ELEMENT
)))
(T (NOT (FUNCALL TEST ITEM
(FUNCALL KEY THIS-ELEMENT]
[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-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 LIST-REMOVE-MACRO (PRED REVERSE?)
(BQUOTE (LET* [(\,@ (COND [REVERSE? (QUOTE ((SEQUENCE (CL:REVERSE (THE LIST SEQUENCE]
(T NIL)))
(SPLICE (LIST NIL))
(RESULTS (CL:DO ((INDEX 0 (1+ INDEX))
(BEFORE-START SPLICE))
((= INDEX START)
BEFORE-START)
(SETQ SPLICE (CDR (RPLACD SPLICE (LIST (POP SEQUENCE]
(CL:DO ((INDEX START (1+ INDEX))
(THIS-ELEMENT)
(NUMBER-ZAPPED 0))
[(OR (= INDEX END)
(= NUMBER-ZAPPED CL:COUNT))
(CL:DO ((INDEX INDEX (1+ INDEX)))
[(NULL SEQUENCE)
(\, (COND [REVERSE? (QUOTE (CL:NREVERSE (THE LIST (CDR RESULTS]
(T (QUOTE (CDR RESULTS]
(SETQ SPLICE (CDR (RPLACD SPLICE (LIST (POP SEQUENCE]
(SETQ THIS-ELEMENT (POP SEQUENCE))
(COND [(\, PRED)
(SETQ SPLICE (CDR (RPLACD SPLICE (LIST THIS-ELEMENT]
(T (SETQ NUMBER-ZAPPED (1+ 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-LIST-REMOVE NIL (BQUOTE (LIST-REMOVE (COND (TEST-NOT (FUNCALL TEST-NOT ITEM
(FUNCALL KEY
THIS-ELEMENT)))
(T (NOT (FUNCALL TEST ITEM
(FUNCALL KEY THIS-ELEMENT]
[DEFMACRO NORMAL-LIST-REMOVE-FROM-END NIL (BQUOTE (LIST-REMOVE-FROM-END
(COND (TEST-NOT (FUNCALL TEST-NOT ITEM
(FUNCALL KEY THIS-ELEMENT))
)
(T (NOT (FUNCALL TEST ITEM (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]
[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]
[DEFMACRO SUBST-DISPATCH (PRED)
(BQUOTE (COND [(CL:LISTP SEQUENCE)
(COND (FROM-END (CL:NREVERSE (LIST-SUBSTITUTE* (\, PRED)
NEW
(CL:REVERSE SEQUENCE)
(- CL:LENGTH END)
(- CL:LENGTH START)
CL:COUNT KEY TEST TEST-NOT OLD)))
(T (LIST-SUBSTITUTE* (\, PRED)
NEW SEQUENCE START END CL:COUNT KEY TEST TEST-NOT OLD]
(T (COND (FROM-END (VECTOR-SUBSTITUTE* (\, PRED)
NEW SEQUENCE -1 (1- CL:LENGTH)
-1 CL:LENGTH (1- END)
(1- START)
CL:COUNT KEY TEST TEST-NOT OLD))
(T (VECTOR-SUBSTITUTE* (\, PRED)
NEW SEQUENCE 1 0 CL:LENGTH CL:LENGTH START END CL:COUNT KEY
TEST TEST-NOT OLD]
[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:IF (FUNCALL TEST-NOT (\, ITEM)
(FUNCALL KEY (AREF (\, SEQUENCE)
INDEX)))
(RETURN INDEX))
(CL:IF (FUNCALL TEST (\, ITEM)
(FUNCALL KEY (AREF (\, SEQUENCE)
INDEX)))
(RETURN INDEX]
[DEFMACRO VECTOR-POSITION-IF (TEST SEQUENCE)
(BQUOTE (LET [(INCREMENTER (COND (FROM-END -1)
(T 1)))
(START (COND (FROM-END (1- END))
(T START)))
(END (COND (FROM-END (1- START))
(T END]
(CL:DO ((INDEX START (+ INDEX INCREMENTER)))
((= INDEX END)
NIL)
(COND ((FUNCALL (\, TEST)
(FUNCALL KEY (AREF (\, SEQUENCE)
INDEX)))
(RETURN INDEX))
(T NIL]
[DEFMACRO LIST-POSITION (ITEM SEQUENCE)
(BQUOTE (CL:IF FROM-END [CL:DO ([SEQUENCE (NTHCDR (- (CL:LENGTH SEQUENCE)
END)
(REVERSE (THE LIST (\, SEQUENCE]
(INDEX (1- END)
(1- INDEX)))
((OR (= INDEX (1- START))
(NULL SEQUENCE))
NIL)
(CL:IF TEST-NOT (CL:IF (FUNCALL TEST-NOT (\, ITEM)
(FUNCALL KEY (POP SEQUENCE)))
(RETURN INDEX))
(CL:IF (FUNCALL TEST (\, ITEM)
(FUNCALL KEY (POP SEQUENCE)))
(RETURN INDEX]
(CL:DO ((SEQUENCE (NTHCDR START (\, SEQUENCE)))
(INDEX START (1+ INDEX)))
((OR (= INDEX END)
(NULL SEQUENCE))
NIL)
(CL:IF TEST-NOT (CL:IF (FUNCALL TEST-NOT (\, ITEM)
(FUNCALL KEY (POP SEQUENCE)))
(RETURN INDEX))
(CL:IF (FUNCALL TEST (\, ITEM)
(FUNCALL KEY (POP SEQUENCE)))
(RETURN INDEX]
[DEFMACRO LIST-POSITION-IF (TEST SEQUENCE)
(BQUOTE (COND [FROM-END (CL:DO ([SEQUENCE (NTHCDR (- CL:LENGTH END)
(CL:REVERSE (THE LIST (\, SEQUENCE]
(INDEX (1- END)
(1- INDEX)))
((OR (= INDEX (1- START))
(NULL SEQUENCE))
NIL)
(COND ((FUNCALL (\, TEST)
(FUNCALL KEY (POP SEQUENCE)))
(RETURN INDEX))
(T NIL]
(T (CL:DO ((SEQUENCE (NTHCDR START (\, SEQUENCE)))
(INDEX START (1+ INDEX)))
((OR (= INDEX END)
(NULL SEQUENCE))
NIL)
(COND ((FUNCALL (\, TEST)
(FUNCALL KEY (POP SEQUENCE)))
(RETURN INDEX))
(T NIL]
[DEFMACRO VECTOR-POSITION-IF-NOT (TEST SEQUENCE)
(BQUOTE (LET [(INCREMENTER (COND (FROM-END -1)
(T 1)))
(START (COND (FROM-END (1- END))
(T START)))
(END (COND (FROM-END (1- START))
(T END]
(CL:DO ((INDEX START (+ INDEX INCREMENTER)))
((= INDEX END)
NIL)
(COND ([NOT (FUNCALL (\, TEST)
(FUNCALL KEY (AREF (\, SEQUENCE)
INDEX]
(RETURN INDEX))
(T NIL]
[DEFMACRO LIST-POSITION-IF-NOT (TEST SEQUENCE)
(BQUOTE (COND [FROM-END (CL:DO ([SEQUENCE (NTHCDR (- CL:LENGTH END)
(CL:REVERSE (THE LIST (\, SEQUENCE]
(INDEX (1- END)
(1- INDEX)))
((OR (= INDEX (1- START))
(NULL SEQUENCE))
NIL)
(COND ([NOT (FUNCALL (\, TEST)
(FUNCALL KEY (POP SEQUENCE]
(RETURN INDEX))
(T NIL]
(T (CL:DO ((SEQUENCE (NTHCDR START (\, SEQUENCE)))
(INDEX START (1+ INDEX)))
((OR (= INDEX END)
(NULL SEQUENCE))
NIL)
(COND ([NOT (FUNCALL (\, TEST)
(FUNCALL KEY (POP SEQUENCE]
(RETURN INDEX))
(T NIL]
[DEFMACRO VECTOR-COUNT (ITEM SEQUENCE)
(BQUOTE (CL:DO ((INDEX START (1+ INDEX))
(CL:COUNT 0))
((= INDEX END)
CL:COUNT)
(COND (TEST-NOT (COND ((FUNCALL TEST-NOT (\, ITEM)
(FUNCALL KEY (AREF (\, SEQUENCE)
INDEX)))
(SETQ CL:COUNT (1+ CL:COUNT)))
(T NIL)))
(T (COND ((FUNCALL TEST (\, ITEM)
(FUNCALL KEY (AREF (\, SEQUENCE)
INDEX)))
(SETQ CL:COUNT (1+ CL:COUNT)))
(T NIL]
[DEFMACRO LIST-COUNT (ITEM SEQUENCE)
(BQUOTE (CL:DO ((SEQUENCE (NTHCDR START (\, SEQUENCE)))
(INDEX START (1+ INDEX))
(CL:COUNT 0))
((OR (= INDEX END)
(NULL SEQUENCE))
CL:COUNT)
(COND (TEST-NOT (COND ((FUNCALL TEST-NOT (\, ITEM)
(FUNCALL KEY (POP SEQUENCE)))
(SETQ CL:COUNT (1+ CL:COUNT)))
(T NIL)))
(T (COND ((FUNCALL TEST (\, ITEM)
(FUNCALL KEY (POP SEQUENCE)))
(SETQ CL:COUNT (1+ CL:COUNT)))
(T NIL]
[DEFMACRO VECTOR-COUNT-IF (PREDICATE SEQUENCE)
(BQUOTE (CL:DO ((INDEX START (1+ INDEX))
(CL:COUNT 0))
((= INDEX END)
CL:COUNT)
(COND ((FUNCALL (\, PREDICATE)
(FUNCALL KEY (AREF (\, SEQUENCE)
INDEX)))
(SETQ CL:COUNT (1+ CL:COUNT)))
(T NIL]
[DEFMACRO LIST-COUNT-IF (PREDICATE SEQUENCE)
(BQUOTE (CL:DO ((SEQUENCE (NTHCDR START (\, SEQUENCE)))
(INDEX START (1+ INDEX))
(CL:COUNT 0))
((OR (= INDEX END)
(NULL SEQUENCE))
CL:COUNT)
(COND ((FUNCALL (\, PREDICATE)
(FUNCALL KEY (POP SEQUENCE)))
(SETQ CL:COUNT (1+ CL:COUNT)))
(T NIL]
[DEFMACRO VECTOR-COUNT-IF-NOT (PREDICATE SEQUENCE)
(BQUOTE (CL:DO ((INDEX START (1+ INDEX))
(CL:COUNT 0))
((= INDEX END)
CL:COUNT)
(COND ([NOT (FUNCALL (\, PREDICATE)
(FUNCALL KEY (AREF (\, SEQUENCE)
INDEX]
(SETQ CL:COUNT (1+ CL:COUNT)))
(T NIL]
[DEFMACRO LIST-COUNT-IF-NOT (PREDICATE SEQUENCE)
(BQUOTE (CL:DO ((SEQUENCE (NTHCDR START (\, SEQUENCE)))
(INDEX START (1+ INDEX))
(CL:COUNT 0))
((OR (= INDEX END)
(NULL SEQUENCE))
CL:COUNT)
(COND ([NOT (FUNCALL (\, PREDICATE)
(FUNCALL KEY (POP SEQUENCE]
(SETQ CL:COUNT (1+ CL:COUNT)))
(T NIL]
[DEFMACRO VECTOR-FIND (ITEM SEQUENCE)
(BQUOTE (LET [(INCREMENTER (COND (FROM-END -1)
(T 1)))
(START (COND (FROM-END (1- END))
(T START)))
(END (COND (FROM-END (1- START))
(T END]
(CL:DO ((INDEX START (+ INDEX INCREMENTER))
(CURRENT))
((= INDEX END)
NIL)
(SETQ CURRENT (AREF (\, SEQUENCE)
INDEX))
(COND (TEST-NOT (COND ((NOT (FUNCALL TEST-NOT (\, ITEM)
(FUNCALL KEY CURRENT)))
(RETURN CURRENT))
(T NIL)))
(T (COND ((FUNCALL TEST (\, ITEM)
(FUNCALL KEY CURRENT))
(RETURN CURRENT))
(T NIL]
[DEFMACRO LIST-FIND (ITEM SEQUENCE)
(BQUOTE (COND [FROM-END (CL:DO ([SEQUENCE (NTHCDR (- (CL:LENGTH (\, SEQUENCE))
END)
(CL:REVERSE (THE LIST (\, SEQUENCE]
(INDEX (1- END)
(1- INDEX))
(CURRENT))
((OR (= INDEX (1- START))
(NULL SEQUENCE))
NIL)
(SETQ CURRENT (POP SEQUENCE))
(COND (TEST-NOT (COND ((NOT (FUNCALL TEST-NOT (\, ITEM)
(FUNCALL KEY CURRENT)))
(RETURN CURRENT))
(T NIL)))
(T (COND ((FUNCALL TEST (\, ITEM)
(FUNCALL KEY CURRENT))
(RETURN CURRENT))
(T NIL]
(T (CL:DO ((SEQUENCE (NTHCDR START (\, SEQUENCE)))
(INDEX START (1+ INDEX))
(CURRENT))
((OR (= INDEX END)
(NULL SEQUENCE))
NIL)
(SETQ CURRENT (POP SEQUENCE))
(COND (TEST-NOT (COND ((NOT (FUNCALL TEST-NOT (\, ITEM)
(FUNCALL KEY CURRENT)))
(RETURN CURRENT))
(T NIL)))
(T (COND ((FUNCALL TEST (\, ITEM)
(FUNCALL KEY CURRENT))
(RETURN CURRENT))
(T NIL]
[DEFMACRO VECTOR-FIND-IF (TEST SEQUENCE)
(BQUOTE (LET [(INCREMENTER (COND (FROM-END -1)
(T 1)))
(START (COND (FROM-END (1- END))
(T START)))
(END (COND (FROM-END (1- START))
(T END]
(CL:DO ((INDEX START (+ INDEX INCREMENTER))
(CURRENT))
((= INDEX END)
NIL)
(SETQ CURRENT (AREF (\, SEQUENCE)
INDEX))
(COND ((FUNCALL (\, TEST)
(FUNCALL KEY CURRENT))
(RETURN CURRENT))
(T NIL]
[DEFMACRO LIST-FIND-IF (TEST SEQUENCE)
(BQUOTE (COND [FROM-END (CL:DO ([SEQUENCE (NTHCDR (- CL:LENGTH END)
(CL:REVERSE (THE LIST (\, SEQUENCE]
(INDEX (1- END)
(1- INDEX))
(CURRENT))
((OR (= INDEX (1- START))
(NULL SEQUENCE))
NIL)
(SETQ CURRENT (POP SEQUENCE))
(COND ((FUNCALL (\, TEST)
(FUNCALL KEY CURRENT))
(RETURN CURRENT))
(T NIL]
(T (CL:DO ((SEQUENCE (NTHCDR START (\, SEQUENCE)))
(INDEX START (1+ INDEX))
(CURRENT))
((OR (= INDEX END)
(NULL SEQUENCE))
NIL)
(SETQ CURRENT (POP SEQUENCE))
(COND ((FUNCALL (\, TEST)
(FUNCALL KEY CURRENT))
(RETURN CURRENT))
(T NIL]
[DEFMACRO VECTOR-FIND-IF-NOT (TEST SEQUENCE)
(BQUOTE (LET [(INCREMENTER (COND (FROM-END -1)
(T 1)))
(START (COND (FROM-END (1- END))
(T START)))
(END (COND (FROM-END (1- START))
(T END]
(CL:DO ((INDEX START (+ INDEX INCREMENTER))
(CURRENT))
((= INDEX END)
NIL)
(SETQ CURRENT (AREF (\, SEQUENCE)
INDEX))
(COND ((NOT (FUNCALL (\, TEST)
(FUNCALL KEY CURRENT)))
(RETURN CURRENT))
(T NIL]
[DEFMACRO LIST-FIND-IF-NOT (TEST SEQUENCE)
(BQUOTE (COND [FROM-END (CL:DO ([SEQUENCE (NTHCDR (- CL:LENGTH END)
(CL:REVERSE (THE LIST (\, SEQUENCE]
(INDEX (1- END)
(1- INDEX))
(CURRENT))
((OR (= INDEX (1- START))
(NULL SEQUENCE))
NIL)
(SETQ CURRENT (POP SEQUENCE))
(COND ((NOT (FUNCALL (\, TEST)
(FUNCALL KEY CURRENT)))
(RETURN CURRENT))
(T NIL]
(T (CL:DO ((SEQUENCE (NTHCDR START (\, SEQUENCE)))
(INDEX START (1+ INDEX))
(CURRENT))
((OR (= INDEX END)
(NULL SEQUENCE))
NIL)
(SETQ CURRENT (POP SEQUENCE))
(COND ((NOT (FUNCALL (\, TEST)
(FUNCALL KEY CURRENT)))
(RETURN CURRENT))
(T NIL]
[DEFMACRO MATCH-VARS (&REST BODY)
(BQUOTE (LET [(INC (COND (FROM-END -1)
(T 1)))
(START1 (COND (FROM-END (1- END1))
(T START1)))
(START2 (COND (FROM-END (1- END2))
(T START2)))
(END1 (COND (FROM-END (1- START1))
(T END1)))
(END2 (COND (FROM-END (1- START2))
(T END2]
(\,@ BODY]
[DEFMACRO MATCHIFY-LIST (SEQUENCE START CL:LENGTH END)
(BQUOTE (SETQ (\, SEQUENCE)
(COND [FROM-END (NTHCDR (- (\, CL:LENGTH)
(\, START)
1)
(CL:REVERSE (THE LIST (\, SEQUENCE]
(T (NTHCDR (\, START)
(\, SEQUENCE]
[DEFMACRO IF-MISMATCH (ELT1 ELT2)
(BQUOTE (COND [(= INDEX1 END1)
(RETURN (COND ((= INDEX2 END2)
NIL)
(T (COND (FROM-END (1+ INDEX1))
(T INDEX1]
[(= INDEX2 END2)
(RETURN (COND (FROM-END (1+ INDEX1))
(T INDEX1]
(TEST-NOT (COND [(FUNCALL TEST-NOT (FUNCALL KEY (\, ELT1))
(FUNCALL KEY (\, ELT2)))
(RETURN (COND (FROM-END (1+ INDEX1))
(T INDEX1]
(T NIL)))
(T (COND [[NOT (FUNCALL TEST (FUNCALL KEY (\, ELT1))
(FUNCALL KEY (\, ELT2]
(RETURN (COND (FROM-END (1+ INDEX1))
(T INDEX1]
(T NIL]
[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)
(POP SEQUENCE2]
[DEFMACRO LIST-MUMBLE-MISMATCH NIL (BQUOTE (CL:DO ((INDEX1 START1 (+ INDEX1 INC))
(INDEX2 START2 (+ INDEX2 INC)))
(NIL)
(IF-MISMATCH (POP SEQUENCE1)
(AREF SEQUENCE2 INDEX2]
[DEFMACRO LIST-LIST-MISMATCH NIL (BQUOTE (CL:DO ((INDEX1 START1 (+ INDEX1 INC))
(INDEX2 START2 (+ INDEX2 INC)))
(NIL)
(IF-MISMATCH (POP SEQUENCE1)
(POP SEQUENCE2]
[DEFMACRO COMPARE-ELEMENTS (ELT1 ELT2)
(BQUOTE (COND (TEST-NOT (COND ((FUNCALL TEST-NOT (FUNCALL KEY (\, ELT1))
(FUNCALL KEY (\, ELT2)))
(RETURN NIL))
(T T)))
(T (COND ([NOT (FUNCALL TEST (FUNCALL KEY (\, ELT1))
(FUNCALL KEY (\, ELT2]
(RETURN NIL))
(T T]
[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 (NULL MAIN)
(NULL 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 (NULL 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)
(NULL 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)
(COND [(EQ MAIN-TYPE (QUOTE LIST))
(BQUOTE (SEQ-DISPATCH (\, SUB)
(SEARCH-COMPARE-LIST-LIST (\, MAIN)
(\, SUB))
(SEARCH-COMPARE-LIST-VECTOR (\, MAIN)
(\, SUB]
(T (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)
(COND [(SEARCH-COMPARE LIST MAIN (\, SUB)
INDEX2)
(COND (FROM-END (SETQ LAST-MATCH INDEX2))
(T (RETURN INDEX2]
(T NIL]
[DEFMACRO VECTOR-SEARCH (MAIN SUB)
(BQUOTE (CL:DO ((INDEX2 START2 (1+ INDEX2))
(TERMINUS (- END2 (- END1 START1)))
(LAST-MATCH NIL))
((> INDEX2 TERMINUS)
LAST-MATCH)
(COND [(SEARCH-COMPARE VECTOR (\, MAIN)
(\, SUB)
INDEX2)
(COND (FROM-END (SETQ LAST-MATCH INDEX2))
(T (RETURN INDEX2]
(T NIL]
)
(PUTPROPS CL:ELT SETFN CL:\SETELT)
(DEFINEQ
(MAKE-SEQUENCE-OF-TYPE
[CL:LAMBDA (TYPE CL:LENGTH) (* raf
"27-Jan-86 17:30")
(DECLARE (TYPE FIXNUM CL:LENGTH))
(CASE (TYPE-SPECIFIER TYPE)
(LIST (MAKE-LIST CL:LENGTH))
[(BIT-VECTOR SIMPLE-BIT-VECTOR)
(MAKE-ARRAY CL:LENGTH :ELEMENT-TYPE (QUOTE (MOD 2]
((STRING SIMPLE-STRING)
(MAKE-STRING CL:LENGTH))
(SIMPLE-VECTOR (MAKE-ARRAY CL:LENGTH))
[(ARRAY SIMPLE-ARRAY VECTOR)
(COND
((CL:LISTP TYPE)
(MAKE-ARRAY CL:LENGTH :ELEMENT-TYPE (CADR TYPE)))
(T (MAKE-ARRAY CL:LENGTH]
[(BIT-VECTOR SIMPLE-BIT-VECTOR)
(MAKE-ARRAY CL:LENGTH :ELEMENT-TYPE (QUOTE (MOD 2]
(T (CL:ERROR "~S is a bad type specifier for sequence functions." TYPE])
(CL:ELT
[CL:LAMBDA (SEQUENCE INDEX) (* raf
"27-Jan-86 17:30")
(COND
[(CL:LISTP SEQUENCE)
(COND
((< INDEX 0)
(CL:ERROR "~S: index too small." INDEX))
(T (CL:DO ((CL:COUNT INDEX (1- CL:COUNT)))
((= CL:COUNT 0)
(CAR SEQUENCE))
(COND
((CL:ATOM SEQUENCE)
(CL:ERROR "~S: index too large." INDEX))
(T (SETQ SEQUENCE (CDR SEQUENCE]
(T (AREF SEQUENCE INDEX])
(CL:\SETELT
[CL:LAMBDA (SEQUENCE INDEX NEWVAL) (* raf
"27-Jan-86 17:30")
(COND
[(CL:LISTP SEQUENCE)
(COND
((< INDEX 0)
(CL:ERROR "~S: index too small." INDEX))
(T (CL:DO ((CL:COUNT INDEX (1- CL:COUNT))
(SEQ SEQUENCE))
((= CL:COUNT 0)
(RPLACA SEQ NEWVAL)
SEQUENCE)
(COND
((CL:ATOM (CDR SEQ))
(CL:ERROR "~S: index too large." INDEX))
(T (SETQ SEQ (CDR SEQ]
(T (SETF (AREF SEQUENCE INDEX)
NEWVAL])
(LIST-LENGTH*
[CL:LAMBDA (SEQUENCE)
(CL:DO ((CL:COUNT 0 (1+ CL:COUNT)))
((CL:ATOM SEQUENCE)
CL:COUNT)
(SETQ SEQUENCE (CDR SEQUENCE])
(MAKE-SEQUENCE
[CL:LAMBDA (TYPE CL:LENGTH &KEY INITIAL-ELEMENT) (* raf
"27-Jan-86 17:30")
(DECLARE (TYPE FIXNUM CL:LENGTH))
(CASE (TYPE-SPECIFIER TYPE)
(LIST (MAKE-LIST CL:LENGTH :INITIAL-ELEMENT INITIAL-ELEMENT))
[(SIMPLE-STRING STRING)
(COND
(INITIAL-ELEMENT (CL:DO ((INDEX 0 (1+ INDEX))
(STRING (MAKE-STRING CL:LENGTH)))
((= INDEX CL:LENGTH)
STRING)
(SETF (CHAR (THE SIMPLE-STRING STRING)
INDEX)
INITIAL-ELEMENT)))
(T (MAKE-STRING CL:LENGTH]
(SIMPLE-VECTOR (MAKE-ARRAY CL:LENGTH :INITIAL-ELEMENT INITIAL-ELEMENT))
[(ARRAY VECTOR SIMPLE-ARRAY)
(COND
((CL:LISTP TYPE)
(MAKE-ARRAY CL:LENGTH :ELEMENT-TYPE (CADR TYPE)
:INITIAL-ELEMENT INITIAL-ELEMENT))
(T (MAKE-ARRAY CL:LENGTH :INITIAL-ELEMENT INITIAL-ELEMENT]
((BIT-VECTOR SIMPLE-BIT-VECTOR)
(MAKE-ARRAY CL:LENGTH :ELEMENT-TYPE (QUOTE (MOD 2))
:INITIAL-ELEMENT INITIAL-ELEMENT))
(T (CL:ERROR "~S is a bad type specifier for sequences." TYPE])
(VECTOR-SUBSEQ*
[CL:LAMBDA (SEQUENCE START &OPTIONAL END) (* raf
"17-Dec-85 22:37")
(DECLARE (TYPE VECTOR SEQUENCE))
[COND
((NULL END)
(SETQ END (CL:LENGTH 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])
(LIST-SUBSEQ*
[CL:LAMBDA (SEQUENCE START &OPTIONAL END)
(DECLARE (TYPE LIST SEQUENCE)) (* raf
"17-Dec-85 22:37")
(COND
((AND END (>= START END))
NIL)
(T (LET* [(GROVELED (NTHCDR START SEQUENCE))
(RESULT (LIST (CAR GROVELED]
(COND
(GROVELED (CL:DO ((LIST (CDR GROVELED)
(CDR LIST))
[SPLICE RESULT (CDR (RPLACD SPLICE (LIST (CAR LIST]
(INDEX (1+ START)
(1+ INDEX)))
((OR (CL:ATOM LIST)
(AND END (= INDEX END)))
RESULT)))
(T NIL])
(SUBSEQ
(CL:LAMBDA (SEQUENCE START &OPTIONAL END)
"Returns a copy of a subsequence of SEQUENCE starting with element number
START and continuing to the end of SEQUENCE or the optional END."
(SEQ-DISPATCH SEQUENCE (LIST-SUBSEQ* SEQUENCE START END)
(VECTOR-SUBSEQ* SEQUENCE START END))))
(COPY-SEQ
(CL:LAMBDA (SEQUENCE)
"Returns a copy of SEQUENCE which is EQUAL to SEQUENCE but not EQ."
(SEQ-DISPATCH SEQUENCE (LIST-COPY-SEQ* SEQUENCE)
(VECTOR-COPY-SEQ* SEQUENCE))))
(LIST-COPY-SEQ*
(CL:LAMBDA (SEQUENCE)
(LIST-COPY-SEQ SEQUENCE)))
(VECTOR-COPY-SEQ*
(CL:LAMBDA (SEQUENCE)
(VECTOR-COPY-SEQ SEQUENCE (TYPE-OF SEQUENCE))))
(LIST-FILL*
(CL:LAMBDA (SEQUENCE ITEM START END)
(DECLARE (TYPE LIST SEQUENCE)) (* raf
"17-Dec-85 22:37")
(COND
((NOT END)
(SETQ END (CL:LENGTH SEQUENCE)))
(T NIL))
(LIST-FILL SEQUENCE ITEM START END)))
(VECTOR-FILL*
(CL:LAMBDA (SEQUENCE ITEM START END)
(DECLARE (TYPE VECTOR SEQUENCE)) (* raf
"17-Dec-85 22:37")
[COND
((NULL END)
(SETQ END (CL:LENGTH SEQUENCE]
(VECTOR-FILL SEQUENCE ITEM START END)))
(FILL
(CL:LAMBDA (SEQUENCE ITEM &KEY (START 0)
END)
"Replace the specified elements of SEQUENCE with ITEM."
(SEQ-DISPATCH SEQUENCE (LIST-FILL* SEQUENCE ITEM START END)
(VECTOR-FILL* SEQUENCE ITEM START END))))
(LIST-REPLACE-FROM-LIST*
(CL:LAMBDA (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)))
(LIST-REPLACE-FROM-VECTOR*
(CL:LAMBDA (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)))
(VECTOR-REPLACE-FROM-LIST*
(CL:LAMBDA (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)))
(VECTOR-REPLACE-FROM-VECTOR*
(CL:LAMBDA (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)))
(CL:REPLACE
[CL:LAMBDA (TARGET-SEQUENCE SOURCE-SEQUENCE &KEY ((:START1 TARGET-START)
0)
((:END1 TARGET-END))
((:START2 SOURCE-START)
0)
((:END2 SOURCE-END)))
"The target sequence is destructively modified by copying successive
elements into it from the source sequence."
[COND
((NOT TARGET-END)
(SETQ TARGET-END (CL:LENGTH TARGET-SEQUENCE]
[COND
((NOT SOURCE-END)
(SETQ SOURCE-END (CL:LENGTH SOURCE-SEQUENCE]
(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])
(CL:REVERSE
(CL:LAMBDA (SEQUENCE)
"Returns a new sequence containing the same elements but in reverse order."
(SEQ-DISPATCH SEQUENCE (LIST-REVERSE* SEQUENCE)
(VECTOR-REVERSE* SEQUENCE))))
(LIST-REVERSE*
(CL:LAMBDA (SEQUENCE)
(LIST-REVERSE-MACRO SEQUENCE)))
(VECTOR-REVERSE*
(CL:LAMBDA (SEQUENCE) (* raf
"18-Dec-85 00:07")
(VECTOR-REVERSE SEQUENCE (TYPE-OF SEQUENCE))))
(LIST-NREVERSE*
(CL:LAMBDA (SEQUENCE)
(LIST-NREVERSE-MACRO SEQUENCE)))
(VECTOR-NREVERSE*
(CL:LAMBDA (SEQUENCE)
(VECTOR-NREVERSE SEQUENCE)))
(CL:NREVERSE
(CL:LAMBDA (SEQUENCE) (* kbr:
"31-Aug-85 17:57")
(* Returns a sequence of
the same elements in
reverse order
(the argument is
destroyed) *)
(SEQ-DISPATCH SEQUENCE (LIST-NREVERSE* SEQUENCE)
(VECTOR-NREVERSE* SEQUENCE))))
(CONCATENATE
[CL:LAMBDA (OUTPUT-TYPE-SPEC &REST SEQUENCES) (* kbr:
"31-Aug-85 19:50")
(CASE (TYPE-SPECIFIER OUTPUT-TYPE-SPEC)
(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*)
OUTPUT-TYPE-SPEC SEQUENCES))
(T (CL:ERROR "~S: invalid output type specification." OUTPUT-TYPE-SPEC])
(CONCAT-TO-LIST*
(CL:LAMBDA (&REST SEQUENCES)
(CONCATENATE-TO-LIST SEQUENCES)))
(CONCAT-TO-SIMPLE*
[CL:LAMBDA (OUTPUT-TYPE-SPEC &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 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))
(SETQ INDEX (1+ INDEX)))
(CL:DO ((JNDEX 0 (1+ JNDEX)))
((= JNDEX (CAR LENGTHS)))
(SETF (AREF RESULT INDEX)
(AREF SEQUENCE JNDEX))
(SETQ INDEX (1+ INDEX]
(LET [(CL:LENGTH (CL:LENGTH (CAR SEQS]
(SETQ LENGTHS (NCONC LENGTHS (LIST CL:LENGTH)))
(SETQ TOTAL-LENGTH (+ TOTAL-LENGTH CL:LENGTH])
(CL:MAP
[CL:LAMBDA (OUTPUT-TYPE-SPEC FUNCTION FIRST-SEQUENCE &REST MORE-SEQUENCES)
"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 OUTPUT-TYPE-SPEC)
(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 OUTPUT-TYPE-SPEC FUNCTION SEQUENCES))
(T (CL:ERROR "~S: invalid output type specifier." OUTPUT-TYPE-SPEC])
(CL:SOME
[CL:LAMBDA (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))
(CL:LENGTH (CL:LENGTH FIRST-SEQUENCE))
(SEQUENCES (CONS FIRST-SEQUENCE MORE-SEQUENCES)))
[(NULL SEQS)
(CL:DO ((INDEX 0 (1+ INDEX)))
((= INDEX CL:LENGTH)
NIL)
(LET [(RESULT (CL:APPLY PREDICATE (ELT-SLICE SEQUENCES INDEX]
(COND
(RESULT (RETURN RESULT))
(T NIL]
(LET [(THIS (CL:LENGTH (CAR SEQS]
(COND
((< THIS CL:LENGTH)
(SETQ CL:LENGTH THIS))
(T NIL])
(CL:EVERY
[CL:LAMBDA (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))
(CL:LENGTH (CL:LENGTH FIRST-SEQUENCE))
(SEQUENCES (CONS FIRST-SEQUENCE MORE-SEQUENCES)))
[(NULL SEQS)
(CL:DO ((INDEX 0 (1+ INDEX)))
((= INDEX CL:LENGTH)
T)
(LET [(RESULT (CL:APPLY PREDICATE (ELT-SLICE SEQUENCES INDEX]
(COND
((NOT RESULT)
(RETURN NIL))
(T NIL]
(LET [(THIS (CL:LENGTH (CAR SEQS]
(COND
((< THIS CL:LENGTH)
(SETQ CL:LENGTH THIS))
(T NIL])
(CL:NOTANY
[CL:LAMBDA (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))
(CL:LENGTH (CL:LENGTH FIRST-SEQUENCE))
(SEQUENCES (CONS FIRST-SEQUENCE MORE-SEQUENCES)))
[(NULL SEQS)
(CL:DO ((INDEX 0 (1+ INDEX)))
((= INDEX CL:LENGTH)
T)
(LET [(RESULT (CL:APPLY PREDICATE (ELT-SLICE SEQUENCES INDEX]
(COND
(RESULT (RETURN NIL))
(T NIL]
(LET [(THIS (CL:LENGTH (CAR SEQS]
(COND
((< THIS CL:LENGTH)
(SETQ CL:LENGTH THIS))
(T NIL])
(CL:NOTEVERY
[CL:LAMBDA (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))
(CL:LENGTH (CL:LENGTH FIRST-SEQUENCE))
(SEQUENCES (CONS FIRST-SEQUENCE MORE-SEQUENCES)))
[(NULL SEQS)
(CL:DO ((INDEX 0 (1+ INDEX)))
((= INDEX CL:LENGTH)
NIL)
(LET [(RESULT (CL:APPLY PREDICATE (ELT-SLICE SEQUENCES INDEX]
(COND
((NOT RESULT)
(RETURN T))
(T NIL]
(LET [(THIS (CL:LENGTH (CAR SEQS]
(COND
((< THIS CL:LENGTH)
(SETQ CL:LENGTH THIS))
(T NIL])
(REDUCE
[CL:LAMBDA (FUNCTION SEQUENCE &KEY FROM-END (START 0)
(END (CL:LENGTH SEQUENCE))
INITIAL-VALUE) (* raf
"27-Jan-86 17:31")
(COND
[(= END START)
(COND
(INITIAL-VALUE INITIAL-VALUE)
(T (FUNCALL FUNCTION]
[(CL:LISTP SEQUENCE)
(COND
(FROM-END (LIST-REDUCE-FROM-END FUNCTION SEQUENCE START END INITIAL-VALUE))
(T (LIST-REDUCE FUNCTION SEQUENCE START END INITIAL-VALUE]
(T (COND
[FROM-END (COND
((NOT (SLISP-ARRAY-P SEQUENCE))
[COND
((NOT INITIAL-VALUE)
(SETQ END (1- END))
(SETQ INITIAL-VALUE (AREF SEQUENCE END]
(MUMBLE-REDUCE-FROM-END FUNCTION SEQUENCE START END INITIAL-VALUE AREF))
(T [COND
((NOT INITIAL-VALUE)
(SETQ END (1- END))
(SETQ INITIAL-VALUE (AREF SEQUENCE END]
(MUMBLE-REDUCE-FROM-END FUNCTION SEQUENCE START END INITIAL-VALUE AREF]
(T (COND
((NOT (SLISP-ARRAY-P SEQUENCE))
[COND
((NOT INITIAL-VALUE)
(SETQ INITIAL-VALUE (AREF SEQUENCE START))
(SETQ START (1+ START]
(MUMBLE-REDUCE FUNCTION SEQUENCE START END INITIAL-VALUE AREF))
(T [COND
((NOT INITIAL-VALUE)
(SETQ INITIAL-VALUE (AREF SEQUENCE START))
(SETQ START (1+ START]
(MUMBLE-REDUCE FUNCTION SEQUENCE START END INITIAL-VALUE AREF])
(CL:COERCE
[CL:LAMBDA (OBJECT OUTPUT-TYPE-SPEC) (* raf
"18-Dec-85 01:42")
(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)) (*
" Can't coerce a string to a bit-vector!"
*)
((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)) (*
" Can't coerce a bit-vector to a string!"
*)
((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))
(*
" Can't coerce a string to a bit-vector!"
*)
((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)) (*
" Can't coerce a bit-vector to a string!"
*)
(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])
(CL:DELETE
[CL:LAMBDA (ITEM SEQUENCE &KEY FROM-END (TEST (FUNCTION EQL))
TEST-NOT
(START 0)
(END (CL:LENGTH SEQUENCE))
(CL:COUNT MOST-POSITIVE-FIXNUM)
(KEY (FUNCTION IDENTITY)))
"Returns a sequence formed by destructively removing the specified Item from
the given Sequence."
(LET ((CL:LENGTH (CL:LENGTH SEQUENCE)))
(SEQ-DISPATCH SEQUENCE (COND
(FROM-END (NORMAL-LIST-DELETE-FROM-END))
(T (NORMAL-LIST-DELETE)))
(COND
(FROM-END (NORMAL-MUMBLE-DELETE-FROM-END))
(T (NORMAL-MUMBLE-DELETE])
(DELETE-IF
[CL:LAMBDA (PREDICATE SEQUENCE &KEY FROM-END (START 0)
(KEY (FUNCTION IDENTITY))
(END (CL:LENGTH SEQUENCE))
(CL:COUNT MOST-POSITIVE-FIXNUM))
"Returns a sequence formed by destructively removing the elements satisfying
the specified Predicate from the given Sequence."
(LET ((CL:LENGTH (CL:LENGTH SEQUENCE)))
(SEQ-DISPATCH SEQUENCE (COND
(FROM-END (IF-LIST-DELETE-FROM-END))
(T (IF-LIST-DELETE)))
(COND
(FROM-END (IF-MUMBLE-DELETE-FROM-END))
(T (IF-MUMBLE-DELETE])
(DELETE-IF-NOT
[CL:LAMBDA (PREDICATE SEQUENCE &KEY FROM-END (START 0)
(END (CL:LENGTH SEQUENCE))
(KEY (FUNCTION IDENTITY))
(CL:COUNT MOST-POSITIVE-FIXNUM))
"Returns a sequence formed by destructively removing the elements not
satisfying the specified Predicate from the given Sequence."
(LET ((CL:LENGTH (CL:LENGTH SEQUENCE)))
(SEQ-DISPATCH SEQUENCE (COND
(FROM-END (IF-NOT-LIST-DELETE-FROM-END))
(T (IF-NOT-LIST-DELETE)))
(COND
(FROM-END (IF-NOT-MUMBLE-DELETE-FROM-END))
(T (IF-NOT-MUMBLE-DELETE])
(CL:REMOVE
[CL:LAMBDA (ITEM SEQUENCE &KEY FROM-END (TEST (FUNCTION EQL))
TEST-NOT
(START 0)
(END (CL:LENGTH SEQUENCE))
(CL:COUNT MOST-POSITIVE-FIXNUM)
(KEY (FUNCTION IDENTITY))) (* raf
" 3-Dec-85 23:31")
(LET ((CL:LENGTH (CL:LENGTH SEQUENCE)))
(SEQ-DISPATCH SEQUENCE (COND
(FROM-END (NORMAL-LIST-REMOVE-FROM-END))
(T (NORMAL-LIST-REMOVE)))
(COND
(FROM-END (NORMAL-MUMBLE-REMOVE-FROM-END))
(T (NORMAL-MUMBLE-REMOVE])
(REMOVE-IF
[CL:LAMBDA (PREDICATE SEQUENCE &KEY FROM-END (START 0)
(END (CL:LENGTH SEQUENCE))
(CL:COUNT MOST-POSITIVE-FIXNUM)
(KEY (FUNCTION IDENTITY)))
"Returns a copy of sequence with elements such that predicate(element)
is non-null are removed"
(LET ((CL:LENGTH (CL:LENGTH SEQUENCE)))
(SEQ-DISPATCH SEQUENCE (COND
(FROM-END (IF-LIST-REMOVE-FROM-END))
(T (IF-LIST-REMOVE)))
(COND
(FROM-END (IF-MUMBLE-REMOVE-FROM-END))
(T (IF-MUMBLE-REMOVE])
(REMOVE-IF-NOT
[CL:LAMBDA (PREDICATE SEQUENCE &KEY FROM-END (START 0)
(END (CL:LENGTH SEQUENCE))
(CL:COUNT MOST-POSITIVE-FIXNUM)
(KEY (FUNCTION IDENTITY)))
"Returns a copy of sequence with elements such that predicate(element)
is null are removed"
(LET ((CL:LENGTH (CL:LENGTH SEQUENCE)))
(SEQ-DISPATCH SEQUENCE (COND
(FROM-END (IF-NOT-LIST-REMOVE-FROM-END))
(T (IF-NOT-LIST-REMOVE)))
(COND
(FROM-END (IF-NOT-MUMBLE-REMOVE-FROM-END))
(T (IF-NOT-MUMBLE-REMOVE])
(LIST-REMOVE-DUPLICATES*
(CL:LAMBDA (LIST TEST TEST-NOT START END KEY FROM-END)
(LET* ((RESULT (LIST NIL)) (*
" Put a marker on the beginning to splice with."
*)
(SPLICE RESULT)
(CURRENT LIST))
(CL:DO ((INDEX 0 (1+ INDEX)))
((= INDEX START))
[SETQ SPLICE (CDR (RPLACD SPLICE (LIST (CAR CURRENT]
(SETQ CURRENT (CDR CURRENT)))
(CL:DO ((INDEX 0 (1+ INDEX)))
((OR (AND END (= INDEX END))
(CL:ATOM CURRENT)))
(COND
[[OR (AND FROM-END (NOT (CL:MEMBER (FUNCALL KEY (CAR CURRENT))
(NTHCDR START RESULT)
:TEST TEST :TEST-NOT TEST-NOT :KEY KEY)))
(AND (NOT FROM-END)
(NOT (CL:DO ((IT (FUNCALL KEY (CAR CURRENT)))
(L (CDR CURRENT)
(CDR L))
(I (1+ INDEX)
(1+ I)))
((OR (CL:ATOM L)
(= I END))
NIL)
(COND
((COND
(TEST-NOT (NOT (FUNCALL TEST-NOT (FUNCALL
KEY
(CAR L))
IT)))
(T (FUNCALL TEST (FUNCALL KEY (CAR L))
IT)))
(RETURN T))
(T NIL]
(SETQ SPLICE (CDR (RPLACD SPLICE (LIST (CAR CURRENT]
(T NIL))
(SETQ CURRENT (CDR CURRENT)))
(CL:DO NIL ((CL:ATOM CURRENT))
[SETQ SPLICE (CDR (RPLACD SPLICE (LIST (CAR CURRENT]
(SETQ CURRENT (CDR CURRENT)))
(CDR RESULT))))
(VECTOR-REMOVE-DUPLICATES*
(CL:LAMBDA (VECTOR TEST TEST-NOT START END KEY FROM-END &OPTIONAL (CL:LENGTH (CL:LENGTH VECTOR)))
(DECLARE (TYPE VECTOR VECTOR)) (* raf
"17-Dec-85 22:38")
(LET ((RESULT (MAKE-SEQUENCE-LIKE VECTOR CL:LENGTH))
(INDEX 0)
(JNDEX START))
(CL:DO NIL ((= INDEX START))
(SETF (AREF RESULT INDEX)
(AREF VECTOR INDEX))
(SETQ INDEX (1+ INDEX)))
(CL:DO ((CL:ELT))
((= INDEX END))
(SETQ CL:ELT (AREF VECTOR INDEX))
[COND
([NOT (OR (AND FROM-END
(CL:POSITION (FUNCALL KEY CL:ELT)
RESULT :START START :END JNDEX :TEST TEST :TEST-NOT TEST-NOT
:KEY KEY))
(AND (NOT FROM-END)
(CL:POSITION (FUNCALL KEY CL:ELT)
VECTOR :START (1+ INDEX)
:END END :TEST TEST :TEST-NOT TEST-NOT :KEY KEY]
(SETF (AREF RESULT JNDEX)
CL:ELT)
(SETQ JNDEX (1+ JNDEX]
(SETQ INDEX (1+ INDEX)))
(CL:DO NIL ((= INDEX CL:LENGTH))
(SETF (AREF RESULT JNDEX)
(AREF VECTOR INDEX))
(SETQ INDEX (1+ INDEX))
(SETQ JNDEX (1+ JNDEX)))
(SHRINK-VECTOR RESULT JNDEX))))
(REMOVE-DUPLICATES
(CL:LAMBDA (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 (COND
(SEQUENCE (LIST-REMOVE-DUPLICATES* SEQUENCE TEST TEST-NOT START END KEY
FROM-END))
(T NIL))
(VECTOR-REMOVE-DUPLICATES* SEQUENCE TEST TEST-NOT START END KEY FROM-END))))
(LIST-DELETE-DUPLICATES*
[CL:LAMBDA (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))
(COND
((CL:DO ((X (COND
(FROM-END (NTHCDR (1+ START)
HANDLE))
(T (CDR CURRENT)))
(CDR X))
(I (1+ INDEX)
(1+ I)))
((OR (NULL X)
(AND (NOT FROM-END)
(= I END))
(EQ X CURRENT))
NIL)
(COND
([COND
[TEST-NOT (NOT (FUNCALL TEST-NOT (FUNCALL KEY (CAR CURRENT))
(FUNCALL KEY (CAR X]
(T (FUNCALL TEST (FUNCALL KEY (CAR CURRENT))
(FUNCALL KEY (CAR X]
(RETURN T))
(T NIL)))
(RPLACD PREVIOUS (CDR CURRENT)))
(T (SETQ PREVIOUS (CDR PREVIOUS])
(VECTOR-DELETE-DUPLICATES*
[CL:LAMBDA (VECTOR TEST TEST-NOT KEY FROM-END START END &OPTIONAL (CL: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)) (*
" copy the rest of the vector
" *)
(JNDEX JNDEX (1+ JNDEX)))
((= INDEX CL:LENGTH)
(SHRINK-VECTOR VECTOR JNDEX)
VECTOR)
(SETF (AREF VECTOR JNDEX)
(AREF VECTOR INDEX]
(SETF (AREF VECTOR JNDEX)
(AREF VECTOR INDEX))
(COND
((NOT (CL:POSITION (FUNCALL KEY (AREF VECTOR INDEX))
VECTOR :KEY KEY :START (COND
(FROM-END START)
(T (1+ INDEX)))
:TEST TEST :END (COND
(FROM-END JNDEX)
(T END))
:TEST-NOT TEST-NOT))
(SETQ JNDEX (1+ JNDEX])
(DELETE-DUPLICATES
(CL:LAMBDA (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))))
(LIST-SUBSTITUTE*
(CL:LAMBDA (PRED NEW LIST START END CL:COUNT KEY TEST TEST-NOT OLD) (* kbr:
"31-Aug-85 20:01")
(LET* ((RESULT (LIST NIL))
CL:ELT
(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]
(SETQ LIST (CDR LIST)))
(CL:DO ((INDEX START (1+ INDEX)))
((OR (AND END (= INDEX END))
(NULL LIST)
(= CL:COUNT 0)))
(SETQ CL:ELT (CAR LIST))
[SETQ SPLICE
(CDR (RPLACD SPLICE
(LIST (COND
([CASE PRED [NORMAL (COND
(TEST-NOT (NOT (FUNCALL TEST-NOT
(FUNCALL KEY
CL:ELT)
OLD)))
(T (FUNCALL TEST (FUNCALL KEY CL:ELT)
OLD]
(IF (FUNCALL TEST (FUNCALL KEY CL:ELT)))
(IF-NOT (NOT (FUNCALL TEST (FUNCALL KEY CL:ELT]
(SETQ CL:COUNT (1- CL:COUNT))
NEW)
(T CL:ELT]
(SETQ LIST (CDR LIST)))
(CL:DO NIL ((NULL LIST))
[SETQ SPLICE (CDR (RPLACD SPLICE (LIST (CAR LIST]
(SETQ LIST (CDR LIST)))
(CDR RESULT))))
(VECTOR-SUBSTITUTE*
(CL:LAMBDA (PRED NEW SEQUENCE INCREMENTER LEFT RIGHT CL:LENGTH START END CL:COUNT KEY TEST TEST-NOT
OLD) (* kbr:
"31-Aug-85 20:01")
(LET ((RESULT (MAKE-SEQUENCE-LIKE SEQUENCE CL:LENGTH))
(INDEX LEFT))
(CL:DO NIL ((= INDEX START))
(SETF (AREF RESULT INDEX)
(AREF SEQUENCE INDEX))
(SETQ INDEX (+ INDEX INCREMENTER)))
(CL:DO ((CL:ELT))
((OR (= INDEX END)
(= CL:COUNT 0)))
(SETQ CL:ELT (AREF SEQUENCE INDEX))
(SETF (AREF RESULT INDEX)
(COND
([CASE PRED [NORMAL (COND
(TEST-NOT (NOT (FUNCALL TEST-NOT (FUNCALL KEY CL:ELT)
OLD)))
(T (FUNCALL TEST (FUNCALL KEY CL:ELT)
OLD]
(IF (FUNCALL TEST (FUNCALL KEY CL:ELT)))
(IF-NOT (NOT (FUNCALL TEST (FUNCALL KEY CL:ELT]
(SETQ CL:COUNT (1- CL:COUNT))
NEW)
(T CL:ELT)))
(SETQ INDEX (+ INDEX INCREMENTER)))
(CL:DO NIL ((= INDEX RIGHT))
(SETF (AREF RESULT INDEX)
(AREF SEQUENCE INDEX))
(SETQ INDEX (+ INDEX INCREMENTER)))
RESULT)))
(SUBSTITUTE
[CL:LAMBDA (NEW OLD SEQUENCE &KEY FROM-END (TEST (FUNCTION EQL))
TEST-NOT
(START 0)
(CL: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 equal to Old are replaced with New. See manual
for details."
(LET ((CL:LENGTH (CL:LENGTH SEQUENCE))
(OLD (FUNCALL KEY OLD)))
(SUBST-DISPATCH (QUOTE NORMAL])
(SUBSTITUTE-IF
[CL:LAMBDA (NEW TEST SEQUENCE &KEY FROM-END (START 0)
(END (CL:LENGTH SEQUENCE))
(CL: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. See
manual for details."
(LET ((CL:LENGTH (CL:LENGTH SEQUENCE))
TEST-NOT OLD)
(SUBST-DISPATCH (QUOTE CL:IF])
(SUBSTITUTE-IF-NOT
[CL:LAMBDA (NEW TEST SEQUENCE &KEY FROM-END (START 0)
(END (CL:LENGTH SEQUENCE))
(CL: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.
See manual for details."
(LET ((CL:LENGTH (CL:LENGTH SEQUENCE))
TEST-NOT OLD)
(SUBST-DISPATCH (QUOTE IF-NOT])
(NSUBSTITUTE
[CL:LAMBDA (NEW OLD SEQUENCE &KEY FROM-END (TEST (FUNCTION EQL))
TEST-NOT
(END (COND
((VECTORP SEQUENCE)
(CL:LENGTH (THE VECTOR SEQUENCE)))
(T NIL)))
(CL:COUNT MOST-POSITIVE-FIXNUM)
(KEY (FUNCTION IDENTITY))
(START 0)) (* raf
"27-Jan-86 17:31")
(LET ((INCREMENTER 1))
(COND
(FROM-END (PSETQ START (1- END)
END
(1- START)
INCREMENTER -1))
(T NIL))
(COND
[(CL:LISTP SEQUENCE)
(COND
(FROM-END (CL:NREVERSE (NLIST-SUBSTITUTE* NEW OLD (CL:NREVERSE (THE LIST SEQUENCE))
TEST TEST-NOT START END CL:COUNT KEY)))
(T (NLIST-SUBSTITUTE* NEW OLD SEQUENCE TEST TEST-NOT START END CL:COUNT KEY]
(T (NVECTOR-SUBSTITUTE* NEW OLD SEQUENCE INCREMENTER TEST TEST-NOT START END CL:COUNT KEY
])
(NLIST-SUBSTITUTE*
[CL:LAMBDA (NEW OLD SEQUENCE TEST TEST-NOT START END CL:COUNT KEY)
(CL:DO ((LIST (NTHCDR START SEQUENCE)
(CDR LIST))
(INDEX START (1+ INDEX)))
((OR (AND END (= INDEX END))
(NULL LIST)
(= CL:COUNT 0))
SEQUENCE)
(COND
((COND
(TEST-NOT (NOT (FUNCALL TEST-NOT (FUNCALL KEY (CAR LIST))
OLD)))
(T (FUNCALL TEST (FUNCALL KEY (CAR LIST))
OLD)))
(RPLACA LIST NEW)
(SETQ CL:COUNT (1- CL:COUNT])
(NVECTOR-SUBSTITUTE*
[CL:LAMBDA (NEW OLD SEQUENCE INCREMENTER TEST TEST-NOT START END CL:COUNT KEY)
(CL:DO ((INDEX START (+ INDEX INCREMENTER)))
((OR (= INDEX END)
(= CL:COUNT 0))
SEQUENCE)
(COND
((COND
[TEST-NOT (NOT (FUNCALL TEST-NOT (FUNCALL KEY (AREF SEQUENCE INDEX)
OLD]
(T (FUNCALL TEST (FUNCALL KEY (AREF SEQUENCE INDEX))
OLD)))
(SETF (AREF SEQUENCE INDEX)
NEW)
(SETQ CL:COUNT (1- CL:COUNT])
(NSUBSTITUTE-IF
[CL:LAMBDA (NEW TEST SEQUENCE &KEY FROM-END (START 0)
(END (COND
((VECTORP SEQUENCE)
(CL:LENGTH (THE VECTOR SEQUENCE)))
(T NIL)))
(CL:COUNT MOST-POSITIVE-FIXNUM)
(KEY (FUNCTION IDENTITY))) (* raf
"27-Jan-86 17:31")
(LET ((INCREMENTER 1))
(COND
(FROM-END (PSETQ START (1- END)
END
(1- START)
INCREMENTER -1))
(T NIL))
(COND
[(CL:LISTP SEQUENCE)
(COND
(FROM-END (CL:NREVERSE (NLIST-SUBSTITUTE-IF* NEW TEST (CL:NREVERSE (THE LIST SEQUENCE
))
START END CL:COUNT KEY)))
(T (NLIST-SUBSTITUTE-IF* NEW TEST SEQUENCE START END CL:COUNT KEY]
(T (NVECTOR-SUBSTITUTE-IF* NEW TEST SEQUENCE INCREMENTER START END CL:COUNT KEY])
(NLIST-SUBSTITUTE-IF*
[CL:LAMBDA (NEW TEST SEQUENCE START END CL:COUNT KEY)
(CL:DO ((LIST (NTHCDR START SEQUENCE)
(CDR LIST))
(INDEX START (1+ INDEX)))
((OR (AND END (= INDEX END))
(NULL LIST)
(= CL:COUNT 0))
SEQUENCE)
(COND
((FUNCALL TEST (FUNCALL KEY (CAR LIST)))
(RPLACA LIST NEW)
(SETQ CL:COUNT (1- CL:COUNT])
(NVECTOR-SUBSTITUTE-IF*
[CL:LAMBDA (NEW TEST SEQUENCE INCREMENTER START END CL:COUNT KEY)
(CL:DO ((INDEX START (+ INDEX INCREMENTER)))
((OR (= INDEX END)
(= CL:COUNT 0))
SEQUENCE)
(COND
((FUNCALL TEST (FUNCALL KEY (AREF SEQUENCE INDEX)))
(SETF (AREF SEQUENCE INDEX)
NEW)
(SETQ CL:COUNT (1- CL:COUNT])
(NSUBSTITUTE-IF-NOT
[CL:LAMBDA (NEW TEST SEQUENCE &KEY FROM-END (START 0)
(END (COND
((VECTORP SEQUENCE)
(CL:LENGTH (THE VECTOR SEQUENCE)))
(T NIL)))
(CL:COUNT MOST-POSITIVE-FIXNUM)
(KEY (FUNCTION IDENTITY))) (* raf
"27-Jan-86 17:31")
(LET ((INCREMENTER 1))
(COND
(FROM-END (PSETQ START (1- END)
END
(1- START)
INCREMENTER -1))
(T NIL))
(COND
[(CL:LISTP SEQUENCE)
(COND
(FROM-END (CL:NREVERSE (NLIST-SUBSTITUTE-IF-NOT* NEW TEST (CL:NREVERSE (THE LIST
SEQUENCE)
)
START END CL:COUNT KEY)))
(T (NLIST-SUBSTITUTE-IF-NOT* NEW TEST SEQUENCE START END CL:COUNT KEY]
(T (NVECTOR-SUBSTITUTE-IF-NOT* NEW TEST SEQUENCE INCREMENTER START END CL:COUNT KEY])
(NLIST-SUBSTITUTE-IF-NOT*
[CL:LAMBDA (NEW TEST SEQUENCE START END CL:COUNT KEY)
(CL:DO ((LIST (NTHCDR START SEQUENCE)
(CDR LIST))
(INDEX START (1+ INDEX)))
((OR (AND END (= INDEX END))
(NULL LIST)
(= CL:COUNT 0))
SEQUENCE)
(COND
([NOT (FUNCALL TEST (FUNCALL KEY (CAR LIST]
(RPLACA LIST NEW)
(SETQ CL:COUNT (1- CL:COUNT])
(NVECTOR-SUBSTITUTE-IF-NOT*
[CL:LAMBDA (NEW TEST SEQUENCE INCREMENTER START END CL:COUNT KEY)
(CL:DO ((INDEX START (+ INDEX INCREMENTER)))
((OR (= INDEX END)
(= CL:COUNT 0))
SEQUENCE)
(COND
([NOT (FUNCALL TEST (FUNCALL KEY (AREF SEQUENCE INDEX]
(SETF (AREF SEQUENCE INDEX)
NEW)
(SETQ CL:COUNT (1- CL:COUNT])
(CL:POSITION
(CL:LAMBDA (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))))
(LIST-POSITION*
(CL:LAMBDA (ITEM SEQUENCE FROM-END TEST TEST-NOT START END KEY)
(LIST-POSITION ITEM SEQUENCE)))
(VECTOR-POSITION*
(CL:LAMBDA (ITEM SEQUENCE FROM-END TEST TEST-NOT START END KEY)
(VECTOR-POSITION ITEM SEQUENCE)))
(POSITION-IF
[CL:LAMBDA (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 ((CL:LENGTH (CL:LENGTH SEQUENCE)))
(SEQ-DISPATCH SEQUENCE (LIST-POSITION-IF TEST SEQUENCE)
(VECTOR-POSITION-IF TEST SEQUENCE])
(POSITION-IF-NOT
[CL:LAMBDA (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 ((CL:LENGTH (CL:LENGTH SEQUENCE)))
(SEQ-DISPATCH SEQUENCE (LIST-POSITION-IF-NOT TEST SEQUENCE)
(VECTOR-POSITION-IF-NOT TEST SEQUENCE])
(CL:COUNT
(CL:LAMBDA (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")
(DECLARE (TYPE IGNORE FROM-END))
(SEQ-DISPATCH SEQUENCE (LIST-COUNT ITEM SEQUENCE)
(VECTOR-COUNT ITEM SEQUENCE))))
(COUNT-IF
(CL:LAMBDA (TEST SEQUENCE &KEY FROM-END (START 0)
(END (CL:LENGTH SEQUENCE))
(KEY (FUNCTION IDENTITY))) (* raf
"17-Dec-85 22:40")
(DECLARE (TYPE IGNORE FROM-END))
(SEQ-DISPATCH SEQUENCE (LIST-COUNT-IF TEST SEQUENCE)
(VECTOR-COUNT-IF TEST SEQUENCE))))
(COUNT-IF-NOT
(CL:LAMBDA (TEST SEQUENCE &KEY FROM-END (START 0)
(END (CL:LENGTH SEQUENCE))
(KEY (FUNCTION IDENTITY))) (* raf
"17-Dec-85 22:40")
(DECLARE (TYPE IGNORE FROM-END))
(SEQ-DISPATCH SEQUENCE (LIST-COUNT-IF-NOT TEST SEQUENCE)
(VECTOR-COUNT-IF-NOT TEST SEQUENCE))))
(CL:FIND
(CL:LAMBDA (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))))
(LIST-FIND*
(CL:LAMBDA (ITEM SEQUENCE FROM-END TEST TEST-NOT START END KEY)
(LIST-FIND ITEM SEQUENCE)))
(VECTOR-FIND*
(CL:LAMBDA (ITEM SEQUENCE FROM-END TEST TEST-NOT START END KEY)
(VECTOR-FIND ITEM SEQUENCE)))
(FIND-IF
[CL:LAMBDA (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 ((CL:LENGTH (CL:LENGTH SEQUENCE)))
(SEQ-DISPATCH SEQUENCE (LIST-FIND-IF TEST SEQUENCE)
(VECTOR-FIND-IF TEST SEQUENCE])
(FIND-IF-NOT
[CL:LAMBDA (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 ((CL:LENGTH (CL:LENGTH SEQUENCE)))
(SEQ-DISPATCH SEQUENCE (LIST-FIND-IF-NOT TEST SEQUENCE)
(VECTOR-FIND-IF-NOT TEST SEQUENCE])
(MISMATCH
[CL:LAMBDA (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])
(SEARCH
(CL:LAMBDA (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 SEARCH MISMATCH FIND-IF-NOT FIND-IF CL:FIND COUNT-IF-NOT COUNT-IF CL:COUNT
POSITION-IF-NOT POSITION-IF CL:POSITION NSUBSTITUTE-IF-NOT NSUBSTITUTE-IF
NSUBSTITUTE SUBSTITUTE-IF-NOT SUBSTITUTE-IF SUBSTITUTE DELETE-DUPLICATES
VECTOR-DELETE-DUPLICATES* REMOVE-DUPLICATES VECTOR-REMOVE-DUPLICATES*
REMOVE-IF-NOT REMOVE-IF CL:REMOVE DELETE-IF-NOT DELETE-IF CL:DELETE REDUCE
CL:NOTEVERY CL:NOTANY CL:EVERY CL:SOME CL:MAP CONCAT-TO-SIMPLE* CONCAT-TO-LIST*
CONCATENATE CL:REPLACE FILL SUBSEQ LIST-SUBSEQ* VECTOR-SUBSEQ* MAKE-SEQUENCE)
)
(PUTPROPS CMLSEQ COPYRIGHT ("Xerox Corporation" 1985 1986))
(DECLARE: DONTCOPY
(FILEMAP (NIL (72021 132951 (MAKE-SEQUENCE-OF-TYPE 72031 . 72941) (CL:ELT 72943 . 73612) (CL:\SETELT
73614 . 74381) (LIST-LENGTH* 74383 . 74555) (MAKE-SEQUENCE 74557 . 76012) (VECTOR-SUBSEQ* 76014 .
76589) (LIST-SUBSEQ* 76591 . 77512) (SUBSEQ 77514 . 77824) (COPY-SEQ 77826 . 78026) (LIST-COPY-SEQ*
78028 . 78098) (VECTOR-COPY-SEQ* 78100 . 78193) (LIST-FILL* 78195 . 78549) (VECTOR-FILL* 78551 . 78892
) (FILL 78894 . 79144) (LIST-REPLACE-FROM-LIST* 79146 . 79474) (LIST-REPLACE-FROM-VECTOR* 79476 .
79808) (VECTOR-REPLACE-FROM-LIST* 79810 . 80142) (VECTOR-REPLACE-FROM-VECTOR* 80144 . 80480) (
CL:REPLACE 80482 . 81344) (CL:REVERSE 81346 . 81554) (LIST-REVERSE* 81556 . 81630) (VECTOR-REVERSE*
81632 . 81876) (LIST-NREVERSE* 81878 . 81954) (VECTOR-NREVERSE* 81956 . 82030) (CL:NREVERSE 82032 .
82779) (CONCATENATE 82781 . 83403) (CONCAT-TO-LIST* 83405 . 83490) (CONCAT-TO-SIMPLE* 83492 . 85049) (
CL:MAP 85051 . 85853) (CL:SOME 85855 . 86811) (CL:EVERY 86813 . 87812) (CL:NOTANY 87814 . 88800) (
CL:NOTEVERY 88802 . 89807) (REDUCE 89809 . 91752) (CL:COERCE 91754 . 97052) (LIST-TO-STRING* 97054 .
97496) (LIST-TO-BIT-VECTOR* 97498 . 98013) (LIST-TO-VECTOR* 98015 . 98471) (VECTOR-TO-LIST* 98473 .
98794) (VECTOR-TO-VECTOR* 98796 . 99258) (VECTOR-TO-STRING* 99260 . 99708) (VECTOR-TO-BIT-VECTOR*
99710 . 100231) (STRING-TO-SIMPLE-STRING* 100233 . 100780) (BIT-VECTOR-TO-SIMPLE-BIT-VECTOR* 100782 .
101378) (CL:DELETE 101380 . 102110) (DELETE-IF 102112 . 102791) (DELETE-IF-NOT 102793 . 103496) (
CL:REMOVE 103498 . 104252) (REMOVE-IF 104254 . 104907) (REMOVE-IF-NOT 104909 . 105574) (
LIST-REMOVE-DUPLICATES* 105576 . 108068) (VECTOR-REMOVE-DUPLICATES* 108070 . 109722) (
REMOVE-DUPLICATES 109724 . 110420) (LIST-DELETE-DUPLICATES* 110422 . 111974) (
VECTOR-DELETE-DUPLICATES* 111976 . 113419) (DELETE-DUPLICATES 113421 . 114175) (LIST-SUBSTITUTE*
114177 . 116316) (VECTOR-SUBSTITUTE* 116318 . 117999) (SUBSTITUTE 118001 . 118560) (SUBSTITUTE-IF
118562 . 119053) (SUBSTITUTE-IF-NOT 119055 . 119554) (NSUBSTITUTE 119556 . 120805) (NLIST-SUBSTITUTE*
120807 . 121460) (NVECTOR-SUBSTITUTE* 121462 . 122103) (NSUBSTITUTE-IF 122105 . 123311) (
NLIST-SUBSTITUTE-IF* 123313 . 123772) (NVECTOR-SUBSTITUTE-IF* 123774 . 124195) (NSUBSTITUTE-IF-NOT
124197 . 125505) (NLIST-SUBSTITUTE-IF-NOT* 125507 . 125973) (NVECTOR-SUBSTITUTE-IF-NOT* 125975 .
126403) (CL:POSITION 126405 . 126938) (LIST-POSITION* 126940 . 127057) (VECTOR-POSITION* 127059 .
127180) (POSITION-IF 127182 . 127576) (POSITION-IF-NOT 127578 . 127988) (CL:COUNT 127990 . 128477) (
COUNT-IF 128479 . 128903) (COUNT-IF-NOT 128905 . 129341) (CL:FIND 129343 . 129842) (LIST-FIND* 129844
. 129953) (VECTOR-FIND* 129955 . 130068) (FIND-IF 130070 . 130453) (FIND-IF-NOT 130455 . 130854) (
MISMATCH 130856 . 132234) (SEARCH 132236 . 132949)))))
STOP