(FILECREATED " 1-Aug-85 16:36:09" {ERIS}<LISPCORE>LIBRARY>CMLSEQ.;7
 4555   

      changes to:  (FNS CL:POSITION CL:LENGTH MAP1 MAPCAN CL:REPLACE \EQL-IS-EQ LIST-NREVERSE* 
NREVERSE VECTOR-POSITION*) (VARS CMLSEQCOMS) (MACROS SEQ-DISPATCH LIST-NREVERSE-MACRO VECTOR-POSITION)

      previous date: "31-Jul-85 04:48:50" {ERIS}<LISPCORE>LIBRARY>CMLSEQ.;1)


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

(PRETTYCOMPRINT CMLSEQCOMS)

(RPAQQ CMLSEQCOMS
 ((MACROS LIST-NREVERSE-MACRO SEQ-DISPATCH VECTOR-POSITION) (FNS CL:POSITION 
CL:REPLACE CL:LENGTH MAP1 MAPCAN NREVERSE LIST-NREVERSE* VECTOR-POSITION* \EQL-IS-EQ SCHAR) (DECLARE: 
DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA) (NLAML) (LAMA CL:POSITION)))))
(DECLARE: EVAL@COMPILE 
(DEFMACRO LIST-NREVERSE-MACRO (LIST) (BQUOTE (CL:DO ((1ST (CDR (\, LIST)) (CL:IF (CL:ATOM 1ST) 1ST (
CDR 1ST))) (2ND (\, LIST) 1ST) (3RD (QUOTE NIL) 2ND)) ((CL:ATOM 2ND) 3RD) (RPLACD 2ND 3RD))))
(DEFMACRO SEQ-DISPATCH (SEQUENCE LIST-FORM ARRAY-FORM) (BQUOTE (CL:IF (CL:LISTP (\, SEQUENCE)) (\, 
LIST-FORM) (\, ARRAY-FORM))))
(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)))))))
)
(DEFINEQ

(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))))

(CL:REPLACE

(CL:LAMBDA (TARGET-SEQUENCE SOURCE-SEQUENCE &KEY ((:START1 TARGET-START) 0) ((:END1 TARGET-END)) ((
:START2 SOURCE-START) 0) ((:END2 SOURCE-END))) (* lmm " 1-Aug-85 12:28") (CL:UNLESS TARGET-END (SETQ 
TARGET-END (CL:LENGTH TARGET-SEQUENCE))) (CL:UNLESS 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:LENGTH

(LAMBDA (X) (if (STRINGP X) then (NCHARS X) elseif (LISTP X) then (LENGTH X) else (HELP))))

(MAP1

(CL:LAMBDA (FUNCTION ORIGINAL-ARGLISTS ACCUMULATE TAKE-CAR) 
"This function is called by mapc, mapcar, mapcan, mapl, maplist, and mapcon.
  It Maps function over the arglists in the appropriate way. It is done when any
  of the arglists runs out.  Until then, it CDRs down the arglists calling the
  function and accumulating results as desired." (LET* ((ARGLISTS (COPY-LIST ORIGINAL-ARGLISTS)) (
RET-LIST (LIST NIL)) (TEMP RET-LIST)) (CL:DO ((RES NIL) (ARGS (QUOTE NIL) (QUOTE NIL))) ((DOLIST (X 
ARGLISTS NIL) (CL:IF (NULL X) (RETURN T))) (CL:IF ACCUMULATE (CDR RET-LIST) (CAR ORIGINAL-ARGLISTS))) 
(CL:DO ((L ARGLISTS (CDR L))) ((NULL L)) (CL:PUSH (CL:IF TAKE-CAR (CAAR L) (CAR L)) ARGS) (SETF (CAR L
) (CDAR L))) (SETQ RES (APPLY FUNCTION (NREVERSE ARGS))) (CASE ACCUMULATE (:NCONC (SETQ TEMP (LAST (
NCONC TEMP RES)))) (:LIST (RPLACD TEMP (LIST RES)) (SETQ TEMP (CDR TEMP))))))))

(MAPCAN

(CL:LAMBDA (FUNCTION LIST &REST MORE-LISTS) 
"Applies fn to successive elements of list, returns NCONC of results." (MAP1 FUNCTION (CONS LIST 
MORE-LISTS) :NCONC T)))

(NREVERSE

(CL:LAMBDA (SEQUENCE) 
"Returns a sequence of the same elements in reverse order; the argument
   is destroyed." (SEQ-DISPATCH SEQUENCE (LIST-NREVERSE* SEQUENCE) (VECTOR-NREVERSE* SEQUENCE))))

(LIST-NREVERSE*

(CL:LAMBDA (SEQUENCE) (LIST-NREVERSE-MACRO SEQUENCE)))

(VECTOR-POSITION*

(CL:LAMBDA (ITEM SEQUENCE FROM-END TEST TEST-NOT START END KEY) (VECTOR-POSITION ITEM SEQUENCE)))

(\EQL-IS-EQ

(LAMBDA (X) (* lmm " 1-Aug-85 12:16") (OR (SMALLP X) (LITATOM X) (TYPENAMEP X (QUOTE CHARACTER)))))

(SCHAR

(CL:LAMBDA (STRING INDEX) (INT-CHAR (NTHCHARCODE STRING (ADD1 INDEX)))))
)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS 

(ADDTOVAR NLAMA
 )

(ADDTOVAR NLAML
 )

(ADDTOVAR LAMA
 CL:POSITION)
)
(PUTPROPS CMLSEQ COPYRIGHT ("Xerox Corporation" 1985))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (1553 4335 (CL:POSITION 1563 . 2007) (CL:REPLACE 2009 . 2542) (CL:LENGTH 2544 . 2650) (
MAP1 2652 . 3546) (MAPCAN 3548 . 3726) (NREVERSE 3728 . 3934) (LIST-NREVERSE* 3936 . 4010) (
VECTOR-POSITION* 4012 . 4131) (\EQL-IS-EQ 4133 . 4248) (SCHAR 4250 . 4333)))))
STOP