(FILECREATED "30-Sep-86 11:57:39" ("compiled on " {ERIS}SOURCES>CMLLIST.;10) "24-Sep-86 19:51:31" recompiled changes: TREE-EQUAL %%TEST XXTEST1 XXTEST0 CL:MEMBER ADJOIN in "Xerox Lisp 24-Sep-86 ..." dated "24-Sep-86 20:08:23") (FILECREATED "30-Sep-86 11:53:23" {ERIS}SOURCES>CMLLIST.;10 57557 changes to: (VARS CMLLISTCOMS) (FNS CL:MEMBER XXTEST1 XXTEST0 %%TEST TREE-EQUAL ADJOIN) (FUNCTIONS XXTEST1 XXTEST0 %%%%TEST1 %%%%TEST0) (MACROS CL:LIST-EVERY) previous date: "29-Sep-86 20:03:51" {ERIS}SOURCES>CMLLIST.;7) TREE-EQUAL D1 (L (0 -args-)) { ekaqlaHlLdK)gHl_OdN)h_M7O>o agLkaLl\agOkaOl_OIJO IJM (170Q %%TREE-EQUAL-TEST 161Q %%TREE-EQUAL-TEST-NOT 75Q CL:ERROR) (125Q :TEST-NOT 102Q :TEST 33Q EQL) ( 72Q "Both TEST and TEST-NOT supplied.") %%TREE-EQUAL-TEST D1 (L (2 TEST 1 Y 0 X)) +@A@AB @AbbAh@AlB(17Q %%TREE-EQUAL-TEST) NIL () %%TREE-EQUAL-TEST-NOT D1 (L (2 TEST-NOT 1 Y 0 X)) -@A@AB @AbbAh@AlBh(17Q %%TREE-EQUAL-TEST-NOT) NIL () ENDP D1 (I 0 OBJECT) @iho@ (20Q ERROR) NIL ( 14Q "Arg not list") LIST-LENGTH D1 (L (0 LIST)) 1j@dId H HkIJHdjhHlIJ(21Q ENDP 12Q ENDP) NIL () CL:NTH D1 (L (1 LIST 0 N)) @A (4 NTHCDR) NIL () %%SETNTH D1 (L (2 NEWVAL 1 LIST 0 N)) Bj@o@ @HjHAd o@ ABBbHkX(57Q \FZEROP 53Q CL:ERROR 40Q ENDP 13Q CL:ERROR) NIL ( 47Q "~S is too large an index for SETF of NTH." 7 "~S is an illegal N for SETF of NTH.") CL:FIRST D1 (L (0 LIST)) @NIL NIL () SECOND D1 (L (0 LIST)) @NIL NIL () THIRD D1 (L (0 LIST)) @NIL NIL () FOURTH D1 (L (0 LIST)) @NIL NIL () FIFTH D1 (L (0 LIST)) @NIL NIL () SIXTH D1 (L (0 LIST)) @NIL NIL () SEVENTH D1 (L (0 LIST)) @NIL NIL () EIGHTH D1 (L (0 LIST)) @NIL NIL () NINTH D1 (L (0 LIST)) @NIL NIL () TENTH D1 (L (0 LIST)) @NIL NIL () REST D1 (L (0 LIST)) @NIL NIL () NTHCDR D1 (L (1 LIST 0 N)) -@3 j@o@ @j AAd hb@kb(35Q ENDP 25Q %%= 17Q CL:ERROR) NIL ( 13Q "N = ~S is illegal for NTHCDR.") MAKE-LIST D1 (L (0 -args-)) SekaQHlKdJhjIoI agKkaKl[Ih]jMdd NkLN(107Q \FZEROP 43Q CL:ERROR) (50Q :INITIAL-ELEMENT) ( 37Q "~S is an illegal size for MAKE-LIST.") CL:APPEND D1 (P 4 N P 2 N P 1 VAL P 0 L) 3e HdjhkkaHaYkHkKLLaI LmԼI(47Q %%APPEND) NIL () %%APPEND D1 (P 1 TAIL P 0 ANSWER I 1 L2 I 0 L1) 8`@ A@@bhX@ IAKJHI@@bhMLI(30Q ENDP 6 ENDP) NIL () COPY-LIST D1 (L (0 L)) @dhHY@bdI@H&NIL NIL () COPY-ALIST D1 (L (0 ALIST)) E@d*o@ @@@h!@HYdJIHJdIdI&(15Q CL:ERROR) NIL ( 11Q "~S is not a list.") COPY-TREE D1 (L (0 OBJECT)) @d @ (14Q COPY-TREE 7 COPY-TREE) NIL () REVAPPEND D1 (L (1 Y 0 X)) @AHd IHIX(11Q ENDP) NIL () NRECONC D1 (L (1 Y 0 X)) @ A (7 \NCONC2 3 NREVERSE) NIL () BUTLAST D1 (L (0 -args-)) LekaalHklajJjI kջJKhIIh]K_J MNdL&LOkհ(66Q %%= 35Q LENGTH) NIL () NBUTLAST D1 (L (0 -args-)) Eeka!lHklajJjI kջJKhIIKNJ MhILLNkվ(62Q %%= 35Q LENGTH) NIL () CL:LDIFF D1 (L (1 SUBLIST 0 LIST)) @!hhYHHAIJdH&HXNIL NIL () %%TEST D1 (L (4 KEY 3 TEST-NOT 2 TEST 1 KEYITEM 0 ITEM)) B@AkDlBC@AkDlCh(34Q SHOULDNT) NIL () XXTEST1 D1 (L (3 KEY 2 TEST 1 KEYITEM 0 ITEM)) @AkClBNIL NIL () XXTEST0 D1 (L (3 KEY 2 TEST-NOT 1 KEYITEM 0 ITEM)) @AkClBhNIL NIL () CL:SUBST D1 (L (0 -args-)) eka lalaHlMdLAhHl__OdO@h_Hl__OdO@h_NPOJo JagMkaMl]agOkaOl_agOkaOl_NOg^Og_IJKNOO (270Q %%SUBST 130Q CL:ERROR) (251Q IDENTITY 241Q EQL 207Q :KEY 161Q :TEST-NOT 136Q :TEST) ( 125Q "Both TEST and TEST-NOT supplied.") %%SUBST D1 (L (5 KEY 4 TEST-NOT 3 TEST 2 TREE 1 OLD 0 NEW)) =ABCDE @BB@ABCDE @ABCDE HdBIBBHI(46Q %%SUBST 33Q %%SUBST 10Q %%TEST) NIL () SUBST-IF D1 (L (0 -args-)) <ekaQlalaHlMdLgIJKN agMkaMl](46Q %%SUBST-IF) (53Q :KEY 36Q IDENTITY) () %%SUBST-IF D1 (L (3 KEY 2 TREE 1 TEST 0 NEW)) 5BdkCkA@B@ABC @ABC HdBIBBHI(36Q %%SUBST-IF 26Q %%SUBST-IF) NIL () SUBST-IF-NOT D1 (L (0 -args-)) <ekaQlalaHlMdLgIJKN agMkaMl](46Q %%SUBST-IF-NOT) (53Q :KEY 36Q IDENTITY) () %%SUBST-IF-NOT D1 (L (3 KEY 2 TREE 1 TEST 0 NEW)) 5BdkCkA@B@ABC @ABC HdBIBBHI(36Q %%SUBST-IF-NOT 26Q %%SUBST-IF-NOT) NIL () NSUBST D1 (L (0 -args-)) eka lalaHlMdLAhHl__OdO@h_Hl__OdO@h_NPOJo JagMkaMl]agOkaOl_agOkaOl_NOg^Og_IJKNOO (270Q %%NSUBST 130Q CL:ERROR) (251Q IDENTITY 241Q EQL 207Q :KEY 161Q :TEST-NOT 136Q :TEST) ( 125Q "Both TEST and TEST-NOT supplied.") %%NSUBST D1 (L (5 KEY 4 TEST-NOT 3 TEST 2 TREE 1 OLD 0 NEW)) MPABCDE @BXBAHCDE H@JI@AHCDE AHCDE H@LKBH(75Q %%TEST 62Q %%NSUBST 36Q %%TEST 13Q %%TEST) NIL () NSUBST-IF D1 (L (0 -args-)) <ekaQlalaHlMdLgIJKN agMkaMl](46Q %%NSUBST-IF) (53Q :KEY 36Q IDENTITY) () %%NSUBST-IF D1 (L (3 KEY 2 TREE 1 TEST 0 NEW)) QBdkCkA@BB]dkCkAH@JIkCkAH@LKBM_@AMC ONMX(104Q %%NSUBST-IF) NIL () NSUBST-IF-NOT D1 (L (0 -args-)) <ekaQlalaHlMdLgIJKN agMkaMl](46Q %%NSUBST-IF-NOT) (53Q :KEY 36Q IDENTITY) () %%NSUBST-IF-NOT D1 (L (3 KEY 2 TREE 1 TEST 0 NEW)) QBdkCkA@BB]dkCkAH@JIkCkAH@LKBM_@AMC ONMX(104Q %%NSUBST-IF-NOT) NIL () CL:SUBLIS D1 (L (0 -args-)) eka laHlLdK>hHl_OdN@h_Hl__OdO@h_MPOJo JagLkaLl\agOkaOl_agOkaOl_MOg]Og_IJMOO (260Q %%SUBLIS 121Q CL:ERROR) (242Q IDENTITY 232Q EQL 200Q :KEY 152Q :TEST-NOT 127Q :TEST) ( 116Q "Both TEST and TEST-NOT supplied.") %%SUBLIS D1 (L (4 KEY 3 TEST-NOT 2 TEST 1 TREE 0 ALIST)) DAkD@BCg AA@ABCD @ABCD HdAIAAHI(55Q %%SUBLIS 43Q %%SUBLIS 20Q %%ASSOC 14Q SYMBOL-FUNCTION) (11Q IDENTITY) () NSUBLIS D1 (L (0 -args-)) eka laHlLdK?hHl_OdNAh_Hl__OdOAh_OQOJo LagLkaLl\agOkaOl_agOkaOl_OOg_MgIJOOM (260Q %%NSUBLIS 122Q CL:ERROR) (244Q IDENTITY 234Q EQL 201Q :TEST-NOT 153Q :TEST 130Q :KEY) ( 117Q "Both TEST and TEST-NOT supplied.") %%NSUBLIS D1 (L (4 KEY 3 TEST-NOT 2 TEST 1 TREE 0 ALIST)) | AkD@BCg AAhA]d kD@BCg X'NHJIkD@BCg XNHLKAM_@MBCD _OOM^(154Q %%NSUBLIS 122Q %%ASSOC 116Q SYMBOL-FUNCTION 64Q %%ASSOC 60Q SYMBOL-FUNCTION 23Q %%ASSOC 17Q SYMBOL-FUNCTION) (113Q IDENTITY 55Q IDENTITY 14Q IDENTITY) () CL:MEMBER D1 (L (0 -args-)) eka laHlLdK>hHl_OdN@h_Hl__OdO@h_MPOJo JagLkaLl\agOkaOl_agOkaOl_MOg]Og_MJ_IOMO OOOJ_IOOO OO(326Q XXTEST0 270Q XXTEST1 121Q CL:ERROR) (242Q IDENTITY 232Q EQL 200Q :KEY 152Q :TEST-NOT 127Q :TEST) ( 116Q "Both TEST and TEST-NOT supplied.") %%MEMBER D1 (L (4 KEY 3 TEST-NOT 2 TEST 1 LIST 0 ITEM)) AHY@IBCD II(22Q %%TEST) NIL () MEMBER-IF D1 (L (0 -args-)) YekaQlaHlLdKgJd$agLkaLl\oJ J^d hkMkINN(106Q ENDP 77Q CL:ERROR) (50Q :KEY 32Q IDENTITY) ( 73Q "~S is not a list.") MEMBER-IF-NOT D1 (L (0 -args-)) YekaQlaHlLdKgJd$agLkaLl\oJ J^d hkMkINN(106Q ENDP 77Q CL:ERROR) (50Q :KEY 32Q IDENTITY) ( 73Q "~S is not a list.") ADJOIN D1 (L (0 -args-)) eka laHlLdK>hHl_OdN@h_Hl__OdO@h_MPOJo JagLkaLl\agOkaOl_agOkaOl_MOg]Og_IdkOJMOO JJ(265Q %%MEMBER 121Q CL:ERROR) (242Q IDENTITY 232Q EQL 200Q :KEY 152Q :TEST-NOT 127Q :TEST) ( 116Q "Both TEST and TEST-NOT supplied.") CL:UNION D1 (L (0 -args-)) ekalaHlLdK>hHl_OdN@h_Hl__OdO@h_MPOJo JagLkaLl\agOkaOl_agOkaOl_MOg]Og_I_J_O_kOIMOO OO_O(302Q %%MEMBER 121Q CL:ERROR) (242Q IDENTITY 232Q EQL 200Q :KEY 152Q :TEST-NOT 127Q :TEST) ( 116Q "Both TEST and TEST-NOT supplied.") NUNION D1 (L (0 -args-)) ekalaHlLdK>hHl_OdN@h_Hl__OdO@h_MPOJo JagLkaLl\agOkaOl_agOkaOl_MOg]Og_I_Jd OkOIMOO J_O_O_OOOJZ(301Q %%MEMBER 256Q ENDP 121Q CL:ERROR) (242Q IDENTITY 232Q EQL 200Q :KEY 152Q :TEST-NOT 127Q :TEST) ( 116Q "Both TEST and TEST-NOT supplied.") CL:INTERSECTION D1 (L (0 -args-)) ekalaHlLdK>hHl_OdN@h_Hl__OdO@h_MPOJo JagLkaLl\agOkaOl_agOkaOl_MOg]Og_h_I_O_kOJMOO OO_O(302Q %%MEMBER 121Q CL:ERROR) (242Q IDENTITY 232Q EQL 200Q :KEY 152Q :TEST-NOT 127Q :TEST) ( 116Q "Both TEST and TEST-NOT supplied.") NINTERSECTION D1 (L (0 -args-)) ekalaHlLdK>hHl_OdN@h_Hl__OdO@h_MPOJo JagLkaLl\agOkaOl_agOkaOl_MOg]Og_h_Id OkOJMOO I_O_O_OOOIY(301Q %%MEMBER 256Q ENDP 121Q CL:ERROR) (242Q IDENTITY 232Q EQL 200Q :KEY 152Q :TEST-NOT 127Q :TEST) ( 116Q "Both TEST and TEST-NOT supplied.") SET-DIFFERENCE D1 (L (0 -args-)) ekalaHlLdK>hHl_OdN@h_Hl__OdO@h_MPOJo JagLkaLl\agOkaOl_agOkaOl_MOg]Og_h_I_O_kOJMOO OO_O(302Q %%MEMBER 121Q CL:ERROR) (242Q IDENTITY 232Q EQL 200Q :KEY 152Q :TEST-NOT 127Q :TEST) ( 116Q "Both TEST and TEST-NOT supplied.") NSET-DIFFERENCE D1 (L (0 -args-)) ekalaHlLdK>hHl_OdN@h_Hl__OdO@h_MPOJo JagLkaLl\agOkaOl_agOkaOl_MOg]Og_h_Id OkOJMOO I_O_O_OOOIY(301Q %%MEMBER 256Q ENDP 121Q CL:ERROR) (242Q IDENTITY 232Q EQL 200Q :KEY 152Q :TEST-NOT 127Q :TEST) ( 116Q "Both TEST and TEST-NOT supplied.") SET-EXCLUSIVE-OR D1 (L (0 -args-)) ekalaHlLdK>hHl_OdN@h_Hl__OdO@h_MPOJo JagLkaLl\agOkaOl_agOkaOl_MOg]Og_h_I_ J_$O_kOJMOO OO_O_ kOIMOO O O_O(346Q %%MEMBER 307Q %%MEMBER 121Q CL:ERROR) (242Q IDENTITY 232Q EQL 200Q :KEY 152Q :TEST-NOT 127Q :TEST) ( 116Q "Both TEST and TEST-NOT supplied.") NSET-EXCLUSIVE-OR D1 (L (0 -args-)) jeka laHlLdK>hHl_OdN@h_Hl__OdO@h_MPOJo JagLkaLl\agOkaOl_agOkaOl_MOg]Og_PI_h_OkO_h_$J_OO_"kO_ OOO lOhOO lM\i_OOOgMgOgO OOOgMgOgO O"OYOO$OO{O_$nONO"JJI(456Q CL:DELETE 423Q CL:DELETE 121Q CL:ERROR) (450Q :KEY 443Q :TEST-NOT 437Q :TEST 415Q :KEY 410Q :TEST-NOT 404Q :TEST 242Q IDENTITY 232Q EQL 200Q :KEY 152Q :TEST-NOT 127Q :TEST) ( 116Q "Both TEST and TEST-NOT supplied.") SUBSETP D1 (L (0 -args-)) eka laHlLdK>hHl_OdN@h_Hl__OdO@h_MPOJo JagLkaLl\agOkaOl_agOkaOl_MOg]Og_I_ikOJMOO hO(274Q %%MEMBER 121Q CL:ERROR) (242Q IDENTITY 232Q EQL 200Q :KEY 152Q :TEST-NOT 127Q :TEST) ( 116Q "Both TEST and TEST-NOT supplied.") ACONS D1 (L (2 ALIST 1 DATUM 0 KEY)) @ABNIL NIL () PAIRLIS D1 (L (2 ALIST 1 DATA 0 KEYS)) p@AHd I BH MI GHIh[HIHd I JBMLKH I J_HIhONJo h(154Q CL:ERROR 116Q ENDP 110Q ENDP 72Q ENDP 64Q ENDP 36Q ENDP 30Q ENDP 21Q ENDP 13Q ENDP) NIL ( 151Q "PAIRLIS keys and data have different length.") CL:ASSOC D1 (L (0 -args-)) eka laHlLdK>hHl_OdN@h_Hl__OdO@h_MPOJo JagLkaLl\agOkaOl_agOkaOl_MOg]Og_IJMOO (260Q %%ASSOC 121Q CL:ERROR) (242Q IDENTITY 232Q EQL 200Q :KEY 152Q :TEST-NOT 127Q :TEST) ( 116Q "Both TEST and TEST-NOT supplied.") %%ASSOC D1 (L (4 KEY 3 TEST-NOT 2 TEST 1 ALIST 0 ITEM)) #AHd h@HBCD HHX(30Q %%TEST 10Q ENDP) NIL () ASSOC-IF D1 (L (1 ALIST 0 PREDICATE)) AHd hHdk@HHX(10Q ENDP) NIL () ASSOC-IF-NOT D1 (L (1 ALIST 0 PREDICATE)) AHd hHdk@HHX(10Q ENDP) NIL () RASSOC D1 (L (0 -args-)) eka laHlLdK>hHl_OdN@h_Hl__OdO@h_MPOJo JagLkaLl\agOkaOl_agOkaOl_MOg]Og_J_d hIOMOO OO(300Q %%TEST 254Q ENDP 121Q CL:ERROR) (242Q IDENTITY 232Q EQL 200Q :KEY 152Q :TEST-NOT 127Q :TEST) ( 116Q "Both TEST and TEST-NOT supplied.") RASSOC-IF D1 (L (1 ALIST 0 PREDICATE)) AHd hHdk@HHX(10Q ENDP) NIL () RASSOC-IF-NOT D1 (L (1 ALIST 0 PREDICATE)) AHd hHdk@HHX(10Q ENDP) NIL () CL:MAPCAR D1 (L (0 -args-)) F eka!laHl2MdLNIJKgi a_OOh_Mk]O&_(46Q %%MAP) (42Q :LIST) () CL:MAPLIST D1 (L (0 -args-)) F eka!laHl2MdLNIJKgh a_OOh_Mk]O&_(46Q %%MAP) (42Q :LIST) () CL:MAPC D1 (L (0 -args-)) D eka!laHl2MdLNIJKhi a_OOh_Mk]O&_(44Q %%MAP) NIL () MAPL D1 (L (0 -args-)) D eka!laHl2MdLNIJKhd a_OOh_Mk]O&_(44Q %%MAP) NIL () MAPCAN D1 (L (0 -args-)) F eka!laHl2MdLNIJKgi a_OOh_Mk]O&_(46Q %%MAP) (42Q :NCONC) () CL:MAPCON D1 (L (0 -args-)) F eka!laHl2MdLNIJKgh a_OOh_Mk]O&_(46Q %%MAP) (42Q :NCONC) () %%MAP D1 (L (3 TAKE-CAR 2 ACCUMULATE 1 ORIGINAL-ARGLISTS 0 FUNCTION)) lA qhhYHddiBIAH_COOLO^NMO@L BdgJK g JK&Jh(130Q LAST 125Q \NCONC2 107Q APPLY 104Q NREVERSE 3 COPY-LIST) (134Q :LIST 115Q :NCONC) () DELQ D1 (L (0 -args-)) SekaQlalHjilaJh] $KLjLIMLkռN MZ JMM^M(102Q \FZEROP 40Q ENDP) NIL () (PRETTYCOMPRINT CMLLISTCOMS) (RPAQQ CMLLISTCOMS ((* ;;; "CMLLIST. Common Lisp Lists Covers all of chapter 15 -- By Kelly Roach, Larry Masinter, and Ron Fischer, Frank Shih." ) (COMS (* ;; "Section 15.1 Conses.") (* ;; "CAR, CDR, ..., CDDDDR (all functions on pages 262-263) are OK.") (* ;; "CONS is OK.") (FNS TREE-EQUAL %%TREE-EQUAL-TEST %%TREE-EQUAL-TEST-NOT)) (COMS (* ;; "Section 15.2 Lists.") (FNS ENDP LIST-LENGTH) ( COMS (FNS CL:NTH %%SETNTH) (PROP SETFN CL:NTH)) (COMS (FNS CL:FIRST SECOND THIRD FOURTH FIFTH SIXTH SEVENTH EIGHTH NINTH TENTH REST) (* ;; "Macros to make SETF work and code optimize") (OPTIMIZERS CL:FIRST SECOND THIRD FOURTH FIFTH SIXTH SEVENTH EIGHTH NINTH TENTH REST)) (FNS NTHCDR) (* ;; "LAST LIST LIST* are OK.") (FNS MAKE-LIST) (* ;; "Common Lisp APPEND is different from Interlisp APPEND because Interlisp APPEND copies its last arg while Common Lisp APPEND does not. See page 268 of the silver book." ) (FNS CL:APPEND %%APPEND) (FNS COPY-LIST COPY-ALIST COPY-TREE REVAPPEND) (* ;; "NCONC is OK.") (FNS NRECONC) (* ;; "CL:PUSH and CL:PUSHNEW are macros defined somewhere else. Don't know where that is. POP is OK.") ( FNS BUTLAST NBUTLAST CL:LDIFF)) (COMS (* ;; "Section 15.3 Alteration of List Structure.") (* ;; "RPLACA RPLACD are OK.")) (COMS (* ;; "Section 15.4 Substitution of Expressions.") (DECLARE: DONTCOPY DOEVAL@COMPILE (FUNCTIONS SPLICE TEST-KEYS-SUPPLIED)) (FNS %%TEST) (FNS XXTEST1 XXTEST0) (FNS CL:SUBST %%SUBST SUBST-IF %%SUBST-IF SUBST-IF-NOT %%SUBST-IF-NOT NSUBST %%NSUBST NSUBST-IF %%NSUBST-IF NSUBST-IF-NOT %%NSUBST-IF-NOT) (FNS CL:SUBLIS %%SUBLIS NSUBLIS %%NSUBLIS)) (COMS (* ;; "Section 15.5 Usng Lists as Sets.") (FNS CL:MEMBER %%MEMBER MEMBER-IF MEMBER-IF-NOT) (OPTIMIZERS CL:MEMBER) (* ;; "TAILP is OK.") (FNS ADJOIN) (FNS CL:UNION NUNION) (FNS CL:INTERSECTION NINTERSECTION ) (FNS SET-DIFFERENCE NSET-DIFFERENCE) (FNS SET-EXCLUSIVE-OR NSET-EXCLUSIVE-OR) (FNS SUBSETP)) (COMS ( * ;; "Section 15.6 Association Lists.") (FNS ACONS PAIRLIS) (FNS CL:ASSOC %%ASSOC ASSOC-IF ASSOC-IF-NOT RASSOC RASSOC-IF RASSOC-IF-NOT)) (COMS (* ;; "Section 7.8.4 Mapping") (FNS CL:MAPCAR CL:MAPLIST CL:MAPC MAPL MAPCAN CL:MAPCON %%MAP)) (COMS (* ;; "Stuff I'm not sure where to place yet.") (* ;; "It seems that DELQ ASSQ MEMQ aren't part of Common Lisp but part of Spice Lisp. What functions in the system are currently depending on these functions?" ) (FNS DELQ) (PROP DMACRO CL:LIST-EVERY) (P (MOVD (QUOTE ASSOC) (QUOTE ASSQ)) (MOVD (QUOTE FMEMB) ( QUOTE MEMQ)))) (DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA) (NLAML) ( LAMA DELQ %%MAP CL:MAPCON MAPCAN MAPL CL:MAPC CL:MAPLIST CL:MAPCAR RASSOC-IF-NOT RASSOC-IF RASSOC ASSOC-IF-NOT ASSOC-IF %%ASSOC CL:ASSOC PAIRLIS ACONS SUBSETP NSET-EXCLUSIVE-OR SET-EXCLUSIVE-OR NSET-DIFFERENCE SET-DIFFERENCE NINTERSECTION CL:INTERSECTION NUNION CL:UNION ADJOIN MEMBER-IF-NOT MEMBER-IF %%MEMBER CL:MEMBER %%NSUBLIS NSUBLIS %%SUBLIS CL:SUBLIS %%NSUBST-IF-NOT NSUBST-IF-NOT %%NSUBST-IF NSUBST-IF %%NSUBST NSUBST %%SUBST-IF-NOT SUBST-IF-NOT %%SUBST-IF SUBST-IF %%SUBST CL:SUBST XXTEST0 XXTEST1 %%TEST CL:LDIFF NBUTLAST BUTLAST NRECONC REVAPPEND COPY-TREE COPY-ALIST CL:APPEND MAKE-LIST NTHCDR REST TENTH NINTH EIGHTH SEVENTH SIXTH FIFTH FOURTH THIRD SECOND CL:FIRST %%SETNTH CL:NTH LIST-LENGTH %%TREE-EQUAL-TEST-NOT %%TREE-EQUAL-TEST TREE-EQUAL))))) (PUTPROPS CL:NTH SETFN %%SETNTH) (DEFOPTIMIZER CL:FIRST (&REST ARGS) (CONS (QUOTE CAR) ARGS)) (DEFOPTIMIZER SECOND (&REST ARGS) (CONS (QUOTE CADR) ARGS)) (DEFOPTIMIZER THIRD (LIST) (BQUOTE (CADDR (\, LIST)))) (DEFOPTIMIZER FOURTH (LIST) (BQUOTE (CADDDR (\, LIST)))) (DEFOPTIMIZER FIFTH (LIST) (BQUOTE (CAR (CDDDDR (\, LIST))))) (DEFOPTIMIZER SIXTH (LIST) (BQUOTE (CADR (CDDDDR (\, LIST))))) (DEFOPTIMIZER SEVENTH (LIST) (BQUOTE (CADDR (CDDDDR (\, LIST))))) (DEFOPTIMIZER EIGHTH (LIST) (BQUOTE (CADDDR (CDDDDR (\, LIST))))) (DEFOPTIMIZER NINTH (LIST) (BQUOTE (CAR (CDDDDR (CDDDDR (\, LIST)))))) (DEFOPTIMIZER TENTH (LIST) (BQUOTE (CADR (CDDDDR (CDDDDR (\, LIST)))))) (DEFOPTIMIZER REST (LIST) (BQUOTE (CDR (\, LIST)))) (DEFOPTIMIZER CL:MEMBER (ITEM LIST &KEY (TEST (QUOTE (FUNCTION EQL)) TESTSUPPLIED) (TEST-NOT NIL TESTNOTSUPPLIED) (KEY (QUOTE (FUNCTION IDENTITY)))) (* optimize simple cases) (LET ((TESTC ( CONSTANTEXPRESSIONP TEST)) (KEYC (CONSTANTEXPRESSIONP KEY)) (TESTNOTC (CONSTANTEXPRESSIONP TEST-NOT)) (LISTC (CONSTANTEXPRESSIONP LIST))) (COND ((AND LISTC KEYC (EQ (CAR TESTC) (QUOTE EQL)) (EVERY (CAR LISTC) (FUNCTION (LAMBDA (X) (NOT (NUMBERP (APPLY* (CAR KEYC) X))))))) (SETQ TESTC (QUOTE (EQ))))) ( COND ((AND TESTC KEYC TESTNOTC) (if (AND (EQ (CAR TESTC) (QUOTE EQ)) (EQ (CAR KEYC) (QUOTE IDENTITY)) (NOT TESTNOTSUPPLIED)) then (LIST (QUOTE FMEMB) ITEM LIST) else (LET ((ITERVAR (GENSYM "MEMBER")) ( ITEMVAR (GENSYM "MEMBER-ITEM"))) (BQUOTE (LET ((, ITEMVAR , ITEM)) (for , ITERVAR on , LIST , (if TESTNOTSUPPLIED then (QUOTE unless) else (QUOTE when)) (, (if TESTNOTSUPPLIED then (CAR TESTNOTC) else (CAR TESTC)) (, (CAR KEYC) (CAR , ITERVAR)) , ITEMVAR) do (RETURN , ITERVAR))))))) (T (QUOTE IGNOREMACRO))))) (PUTPROPS CL:LIST-EVERY DMACRO (DEFMACRO (FUNCTION &REST LISTS) (LET ((GENSYM (GENSYM)) (TAIL-VARS ( for X in LISTS collect (GENSYM)))) (BQUOTE (LET (((\, GENSYM) T)) (CL:DO ((\,@ (for X in LISTS as TAIL-VAR in TAIL-VARS collect (LIST TAIL-VAR X (BQUOTE (CDR (\, TAIL-VAR))))))) ((NOT (AND (\,@ TAIL-VARS))) (\, GENSYM)) (OR (SETQ (\, GENSYM) (AND (\, GENSYM) (FUNCALL (\, FUNCTION) (\,@ (for X in TAIL-VARS collect (BQUOTE (CAR (\, X)))))))) (RETURN NIL)))))))) (MOVD (QUOTE ASSOC) (QUOTE ASSQ)) (MOVD (QUOTE FMEMB) (QUOTE MEMQ)) (PUTPROPS CMLLIST COPYRIGHT ("Xerox Corporation" 1985 1986)) NIL