;;; -*- Mode:Lisp; Readtable:ZL; Package:USER; Base:8; Patch-File:T -*-
;;; Patch file for System version 124.104
;;; Reason:
;;;  Fix (TREE-EQUAL x y :test-not 'eql).  Also give error if you
;;;  give both :test and :test-not keywords to TREE-EQUAL.
;;;  
;;;  Make same argument check in:
;;;  	ASSOC COUNT DELETE DELETE-DUPLICATES FIND
;;;  	MISMATCH NINTERSECTION NSET-DIFFERENCE
;;;  	NSET-EXCLUSIVE-OR NSUBLIS NSUBST NSUBSTITUTE
;;;  	POSITION RASSOC REMOVE REMOVE-DUPLICATES SEARCH
;;;  	SUBLIS SUBST SUBSTITUTE 
;;;  As it turns out, the only Common Lisp functions that already DID
;;;  do this check were:
;;;  	ADJOIN INTERSECTION MEMBER SET-DIFFERENCE
;;;  	SET-EXCLUSIVE-OR SUBSETP UNION
;;; Written 24-Jun-88 15:27:37 by pld (Peter L. DeWolf) at site Gigamos Cambridge
;;; while running on Cthulhu from band 1
;;; with Experimental System 124.95, Experimental Local-File 74.3, Experimental File-Server 23.1, Experimental Unix-Interface 12.0, Experimental ZMail 72.1, Experimental Tape 23.6, Experimental Lambda-Diag 16.2, microcode 1761, SDU Boot Tape 3.14, SDU ROM 8, the old ones.



; From modified file DJ: L.SYS; QFCTNS.LISP#847 at 24-Jun-88 15:31:11
#8R SYSTEM-INTERNALS#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SYSTEM-INTERNALS")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: SYS; QFCTNS  "

(DEFUN TREE-EQUAL (X Y &KEY TEST TEST-NOT)
  "Compare two lists or trees recursively for matching structure and leaves.
TEST or TEST-NOT is a function to compare leaves (non-lists) with:
if TEST-NOT is specified, leaves match if that function returns NIL;
if TEST is specified, leaves match if that function returns T.
If no test is specified, EQL is used."
  (COND ((and test test-not)
	 (ferror "Both ~S and ~S specified" :test :test-not))
	((OR (EQ TEST 'EQ) (EQ TEST #'EQ))
	 (OR (EQ X Y) (TREE-EQUAL-EQ X Y)))
	((OR (EQ TEST 'EQL) (EQ TEST #'EQL)
	     (AND (NULL TEST) (NULL TEST-NOT)))
	 (TREE-EQUAL-EQL X Y))
	(T (TREE-EQUAL-1 X Y (OR TEST-NOT TEST) (NOT (NULL TEST-NOT))))))

))

; From modified file DJ: L.SYS; QFCTNS.LISP#847 at 24-Jun-88 15:31:22
#8R SYSTEM-INTERNALS#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SYSTEM-INTERNALS")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: SYS; QFCTNS  "

(DEFUN TREE-EQUAL-1 (X Y PRED INVERTP)
  (DO ((XTAIL X (CDR XTAIL))
       (YTAIL Y (CDR YTAIL)))
      (())
    (if (null xtail)
	(return (null ytail)))
    (IF (ATOM XTAIL)
	(RETURN (AND (ATOM YTAIL)
		     (EQ INVERTP (NOT (FUNCALL PRED XTAIL YTAIL))))))
    (IF (ATOM YTAIL) (RETURN NIL))
    (IF (NOT (TREE-EQUAL-1 (CAR XTAIL) (CAR YTAIL) PRED INVERTP))
	(RETURN NIL))))

))

; From modified file DJ: L.SYS; QFCTNS.LISP#847 at 24-Jun-88 15:32:33
#8R SYSTEM-INTERNALS#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SYSTEM-INTERNALS")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: SYS; QFCTNS  "

(DEFUN SUBLIS (ALIST TREE &KEY &OPTIONAL TEST TEST-NOT KEY)
  "Make multiple replacements in TREE, copying structure as needed.
ALIST specifies the replacements; each element's car is something to replace,
and the cdr is what to replace it with.
Each atom or subtree found anywhere in TREE is compared against each
object to be replaced.  If KEY is non-NIL, it is a function to apply
to that non-list from TREE to get the thing to actually compare.
TEST and TEST-NOT specify how to do comparison.
The value is a predicate which accepts two arguments.
If TEST-NOT is specified, an object is replaced if the predicate returns NIL.
If TEST is specified, an object is replaced if the predicate returns non-NIL."
  (when (and test test-not)
    (ferror "Both ~S and ~S specified" :test :test-not))
  (SUBLIS-1 ALIST TREE KEY (OR TEST-NOT TEST 'EQL) (NOT (NULL TEST-NOT)) NIL))

))

; From modified file DJ: L.SYS; QFCTNS.LISP#847 at 24-Jun-88 15:32:48
#8R SYSTEM-INTERNALS#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SYSTEM-INTERNALS")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: SYS; QFCTNS  "

(DEFUN NSUBLIS (ALIST TREE &KEY &OPTIONAL TEST TEST-NOT KEY)
  "Structure-modifying version of SUBLIS.  Same as SUBLIS except modifies structure of TREE."
  (when (and test test-not)
    (ferror "Both ~S and ~S specified" :test :test-not))
  (SUBLIS-1 ALIST TREE KEY (OR TEST-NOT TEST 'EQL) (NOT (NULL TEST-NOT)) T))

))

; From modified file DJ: L.SYS; GENRIC.LISP#59 at 24-Jun-88 15:44:39
#10R SYSTEM-INTERNALS#: #!:CL
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SYSTEM-INTERNALS")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: SYS; GENRIC  "


(defun cl:remove (item sequence &key test test-not (start 0) end count key from-end)
  "Return SEQUENCE, partially copied so that elements matching ITEM are omitted.
START and END specify a subsequence to consider; elements outside
 that subsequence will not be removed even if they would match.
 They default to 0 and NIL (which means the end of the sequence).
KEY, if non-NIL, is a function to be applied to each element
 to get the object to match against ITEM.  If KEY is NIL,
 the element itself is matched.
TEST is a function of two args to use to compare ITEM against an element (or key).
 An element matches when the TEST function returns non-NIL.
 Alternatively, specify as TEST-NOT a function to use which returns NIL if there is a match.
COUNT can be used to specify how many elements to remove (at maximum);
 after that many have been found, the rest are left alone.
FROM-END, if non-NIL, means that the last COUNT matching elements
 should be removed, rather than the first COUNT many."
  (when (and test test-not)
    (ferror "Both ~S and ~S specified" :test :test-not))
  (funcall (etypecase sequence
	     (list #'remove-from-list)
	     (vector #'remove-from-array))
	   item sequence start end count (or test-not test) (not (null test-not))
	   key from-end nil))

))

; From modified file DJ: L.SYS; GENRIC.LISP#59 at 24-Jun-88 15:44:41
#10R SYSTEM-INTERNALS#: #!:CL
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SYSTEM-INTERNALS")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: SYS; GENRIC  "


(defun cl:delete (item sequence &key test test-not (start 0) end count key from-end)
  "Return SEQUENCE, partially copied so that elements matching ITEM are omitted.
START and END specify a subsequence to consider; elements outside
 that subsequence will not be removed even if they would match.
 They default to 0 and NIL (which means the end of the sequence).
KEY, if non-NIL, is a function to be applied to each element
 to get the object to match against ITEM.  If KEY is NIL,
 the element itself is matched.
TEST is a function of two args to use to compare ITEM against an element (or key).
 An element matches when the TEST function returns non-NIL.
 Alternatively, specify as TEST-NOT a function to use which returns NIL if there is a match.
COUNT can be used to specify how many elements to remove (at maximum);
 after that many have been found, the rest are left alone.
FROM-END, if non-NIL, means that the last COUNT matching elements
 should be removed, rather than the first COUNT many."
  (when (and test test-not)
    (ferror "Both ~S and ~S specified" :test :test-not))
  (funcall (etypecase sequence
	     (list #'delete-from-list)
	     (vector #'delete-from-array))
	   item sequence start end count (or test-not test) (not (null test-not))
	   key from-end nil))

))

; From modified file DJ: L.SYS; GENRIC.LISP#59 at 24-Jun-88 15:44:53
#10R SYSTEM-INTERNALS#: #!:CL
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SYSTEM-INTERNALS")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: SYS; GENRIC  "

(defun remove-duplicates (sequence &key (start 0) end key from-end test test-not)
  "Returns SEQUENCE, partially copied if necessary, omitting duplicate elements.
Elements are compared using TEST, a function of two arguments.
 Elements match if TEST returns non-NIL.  Alternatively, specify TEST-NOT;
 then elements match if TEST-NOT returns NIL.
If KEY is non-NIL, then it is a function of one arg, which is applied
 to each element to get the \"key\" which is passed to TEST or TEST-NOT.
START and END are indices specifying the part of SUBSEQUENCE considered.
 They default to 0 and NIL (which means the end of SEQUENCE).
 Elements outside this subsequence are not looked at.
Duplicate elements are not necessarily identical.
Normally the last duplicate element is the one retained.
If FROM-END is non-NIL, the first one is retained."
  (when (and test test-not)
    (ferror "Both ~S and ~S specified" :test :test-not))
  (funcall (etypecase sequence
	     (list #'remove-duplicates-from-list)
	     (vector #'remove-duplicates-from-array))
	   sequence start end (or test-not test) (not (null test-not)) key from-end))

))

; From modified file DJ: L.SYS; GENRIC.LISP#59 at 24-Jun-88 15:45:04
#10R SYSTEM-INTERNALS#: #!:CL
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SYSTEM-INTERNALS")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: SYS; GENRIC  "


(defun delete-duplicates (sequence &key (start 0) end key from-end test test-not)
  "Like REMOVE-DUPLICATES except that SEQUENCE may be destructively modified.
\(If it is an array, it will probably be copied anyway.)
Returns SEQUENCE, sans any duplicate elements.
Elements are compared using TEST, a function of two arguments.
 Elements match if TEST returns non-NIL.  Alternatively, specify TEST-NOT;
 then elements match if TEST-NOT returns NIL.
If KEY is non-NIL, then it is a function of one arg, which is applied
 to each element to get the \"key\" which is passed to TEST or TEST-NOT.
START and END are indices specifying the part of SUBSEQUENCE considered.
 They default to 0 and NIL (which means the end of SEQUENCE).
 Elements outside this subsequence are not looked at.
Duplicate elements are not necessarily identical.
Normally the last duplicate element is the one retained.
If FROM-END is non-NIL, the first one is retained."
  (when (and test test-not)
    (ferror "Both ~S and ~S specified" :test :test-not))
  (funcall (etypecase sequence
	     (list #'delete-duplicates-from-list)
	     (vector #'delete-duplicates-from-array))
	   sequence start end (or test-not test) (not (null test-not)) key from-end))

))

; From modified file DJ: L.SYS; GENRIC.LISP#59 at 24-Jun-88 15:45:13
#10R SYSTEM-INTERNALS#: #!:CL
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SYSTEM-INTERNALS")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: SYS; GENRIC  "


(defun substitute (newitem olditem sequence
		   &key test test-not (start 0) end count key from-end)
  "Return SEQUENCE copied if necessary so that NEWITEM replaces any elements matching OLDITEM.
SEQUENCE can be a list or an array.  A list may be copied partially.
If COUNT is non-NIL, it is the number of such elements to replace.
The first COUNT-many suitable elements are replaced, or,
 if FROM-END is non-NIL, the last COUNT-many are replaced.
TEST is a function of two args to use to compare OLDITEM against an element (or key).
 An element matches when the TEST function returns non-NIL.
 Alternatively, specify as TEST-NOT a function to use which returns NIL if there is a match.
KEY, if non-NIL, is a function to be applied to each element to get a key,
 which is passed to TEST or TEST-NOT.  If KEY is NIL, the element itself is used.
START and END are indices restricting substitution to a subsequence of SEQUENCE.
 They default to 0 and NIL (which means the end of SEQUENCE).
 Elements outside that range are never substituted for."
  (when (and test test-not)
    (ferror "Both ~S and ~S specified" :test :test-not))
  (funcall (etypecase sequence
	     (list #'substitute-in-list)
	     (vector #'substitute-in-array))
	   t newitem olditem sequence start end count (or test-not test) (not (null test-not))
	   key from-end nil))

))

; From modified file DJ: L.SYS; GENRIC.LISP#59 at 24-Jun-88 15:45:22
#10R SYSTEM-INTERNALS#: #!:CL
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SYSTEM-INTERNALS")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: SYS; GENRIC  "


(defun nsubstitute (newitem olditem sequence
		    &key test test-not (start 0) end count key from-end)
  "Like SUBSTITUTE except that SEQUENCE may be destructively modified rather than copied."
  (when (and test test-not)
    (ferror "Both ~S and ~S specified" :test :test-not))
  (funcall (etypecase sequence
	     (list #'substitute-in-list)
	     (vector #'substitute-in-array))
	   nil newitem olditem sequence start end count
	   (or test-not test) (not (null test-not)) key from-end nil))

))

; From modified file DJ: L.SYS; GENRIC.LISP#59 at 24-Jun-88 15:45:31
#10R SYSTEM-INTERNALS#: #!:CL
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SYSTEM-INTERNALS")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: SYS; GENRIC  "


(defun position (item sequence &key from-end test test-not (start 0) end key)
  "Return index in SEQUENCE of first element that matches ITEM.
Value is NIL if no element matches.  SEQUENCE can be a list or an array.
TEST is a function of two args to use to compare ITEM against an element (or key).
 An element matches when the TEST function returns non-NIL.
 Alternatively, specify as TEST-NOT a function to use which returns NIL if there is a match.
KEY, if non-NIL, is a function to be applied to each element to get a key,
 which is passed to TEST or TEST-NOT.  If KEY is NIL, the element itself is used.
START and END are indices restricting substitution to a subsequence of SEQUENCE.
 They default to 0 and NIL (which means the end of SEQUENCE).
 Elements outside that range are not tested.
 The value is the index in SEQUENCE, not in the subsequence which was searched.
If FROM-END is non-NIL, the value describes the LAST element in SEQUENCE
 (or specified subsequence) that matches."
  (check-type sequence sequence)
  (when (and test test-not)
    (ferror "Both ~S and ~S specified" :test :test-not))
  (if (and (cl:listp sequence) (null from-end) (eq start 0) (null end) (null key)
	   (or (eq test 'eq) (eq test #'eql)))
      (find-position-in-list item sequence)
    (nth-value 1 (find-1 item sequence start end (or test-not test) (not (null test-not))
			 key from-end nil))))

))

; From modified file DJ: L.SYS; GENRIC.LISP#59 at 24-Jun-88 15:45:39
#10R SYSTEM-INTERNALS#: #!:CL
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SYSTEM-INTERNALS")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: SYS; GENRIC  "


(defun find (item sequence &key from-end test test-not (start 0) end key)
  "Return first element of SEQUENCE that matches ITEM.
Value is NIL if no element matches.  SEQUENCE can be a list or an array.
TEST is a function of two args to use to compare ITEM against an element (or key).
 An element matches when the TEST function returns non-NIL.
 Alternatively, specify as TEST-NOT a function to use which returns NIL if there is a match.
KEY, if non-NIL, is a function to be applied to each element to get a key,
 which is passed to TEST or TEST-NOT.  If KEY is NIL, the element itself is used.
START and END are indices restricting substitution to a subsequence of SEQUENCE.
 They default to 0 and NIL (which means the end of SEQUENCE).
 Elements outside that range are not tested.
If FROM-END is non-NIL, the value is the LAST element in SEQUENCE
 (or specified subsequence) that matches."
  (check-type sequence sequence)
  (when (and test test-not)
    (ferror "Both ~S and ~S specified" :test :test-not))
  (values (find-1 item sequence start end (or test-not test) (not (null test-not))
		  key from-end nil)))

;; Copied from LAD: RELEASE-3.SYS; GENRIC.LISP#60 on 27-Mar-87 12:21:42

))

; From modified file DJ: L.SYS; GENRIC.LISP#59 at 24-Jun-88 15:45:45
#10R SYSTEM-INTERNALS#: #!:CL
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SYSTEM-INTERNALS")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: SYS; GENRIC  "

(defun count (item sequence &key from-end test test-not (start 0) end key)
  "Return number of elements of SEQUENCE (a list or vector) that match ITEM.
TEST is a function of two args to use to compare ITEM against an element (or key).
 An element matches when the TEST function returns non-NIL.
 Alternatively, specify as TEST-NOT a function to use which returns NIL if there is a match.
KEY, if non-NIL, is a function to be applied to each element to get a key,
 which is passed to TEST or TEST-NOT.  If KEY is NIL, the element itself is used.
START and END are indices restricting substitution to a subsequence of SEQUENCE.
 They default to 0 and NIL (which means the end of SEQUENCE).
 Elements outside that range are not counted."
  from-end ; purely for Steele, p. 257
  (check-type sequence sequence)
  (when (and test test-not)
    (ferror "Both ~S and ~S specified" :test :test-not))
  (count-1 item sequence start end (or test-not test) (not (null test-not)) key nil))

))

; From modified file DJ: L.SYS; GENRIC.LISP#59 at 24-Jun-88 15:45:56
#10R SYSTEM-INTERNALS#: #!:CL
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SYSTEM-INTERNALS")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: SYS; GENRIC  "

(defun mismatch (sequence1 sequence2 &key from-end test test-not key
					  (start1 0) end1 (start2 0) end2)
  "Return index in SEQUENCE1 of first mismatch between it and SEQUENCE2.
Elements are compared one by one, starting with elements at indexes START1 and START2
 and stopping when index 1 reaches END1 or index 2 reaches END2.
If sequences match, value is NIL.  If they match until one is exhausted but not both,
 the value is the index in SEQUENCE1 at which one sequence is exhausted.
TEST is a function of two args to use to compare two elements.
 The elements match when the TEST function returns non-NIL.
 Alternatively, specify as TEST-NOT a function to use which returns NIL if there is a match.
KEY, if non-NIL, is a function to be applied to each element to get a key,
 which is passed to TEST or TEST-NOT.  If KEY is NIL, the element itself is used.
FROM-END non-NIL means comparison aligns right ends of the specified
 subsequences and returns one plus the index of the rightmost mismatch."
  (check-type sequence1 sequence)
  (check-type sequence2 sequence)
  (when (and test test-not)
    (ferror "Both ~S and ~S specified" :test :test-not))
  (mismatch-1 sequence1 sequence2 start1 end1 start2 end2
	      (or test-not test) (not (null test-not)) key from-end))

))

; From modified file DJ: L.SYS; GENRIC.LISP#59 at 24-Jun-88 15:46:03
#10R SYSTEM-INTERNALS#: #!:CL
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SYSTEM-INTERNALS")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: SYS; GENRIC  "

(defun search (for-sequence-1 in-sequence-2 &key (start1 0) end1 (start2 0) end2
						 from-end test test-not key)
  "Return index in IN-SEQUENCE-2 of first subsequence that matches FOR-SEQUENCE-1.
If no occurrence is found, the value is NIL.
MISMATCH is used to do the matching, with TEST, TEST-NOT and KEY passed along.
START1 and END1 are indices specifying a subsequence of FOR-SEQUENCE-1 to search for.
 The rest of FOR-SEQUENCE-1 might as well not be there.
START2 and END2 are indices specifying a subsequence of IN-SEQUENCE-2 to search through.
 However, the value returned is an index into the entire IN-SEQUENCE-2.
If FROM-END is non-NIL, the value is the index of the LAST subsequence that
 matches FOR-SEQUENCE-1 or the specified part of it.
In either case, the value returned is the index of the beginning of
 the subsequence (of IN-SEQUENCE-2) that matches."
  (check-type for-sequence-1 sequence)
  (check-type in-sequence-2 sequence)
  (when (and test test-not)
    (ferror "Both ~S and ~S specified" :test :test-not))
  (let* ((length1 (- (or end1 (length for-sequence-1)) start1))
	 (really-backwards (and from-end (arrayp in-sequence-2)))
	 (pretend-backwards (and from-end (not (arrayp in-sequence-2))))
	 (real-end2 (- (or end2 (length in-sequence-2)) length1 -1))
	 (test (or test-not test #'eql))
	 (invertp (not (null test-not))))
    (unless (< real-end2 0)
      ;; If REALLY-BACKWARDS, we actually step backwards through IN-SEQUENCE-2.
      ;; If PRETEND-BACKWARDS, we step forwards but remember the last thing we found.
      (do ((index (seq-start in-sequence-2 start2))
	   (inc (if really-backwards -1 1))
	   (i (if really-backwards (1- real-end2) start2)
	      (+ i inc))
	   last-index-if-from-end
	   (stop-index (if really-backwards (1- start2) (seq-end in-sequence-2 real-end2)))
	   (START-KEY-1 (FUNCALL (OR KEY #'IDENTITY)
				 (ELT FOR-SEQUENCE-1 START1))))
	  ((IF REALLY-BACKWARDS
	       (OR (< I 0)
		   (EQ INDEX STOP-INDEX))
	     (EQ INDEX STOP-INDEX))
	   LAST-INDEX-IF-FROM-END)
	(if really-backwards (setq index i))
	(and (eq invertp (not (funcall test start-key-1
				       (key-fetch-inc key in-sequence-2 index))))
	     (not (mismatch-1 for-sequence-1 in-sequence-2 start1 end1 i (+ i length1)
			      test invertp key nil))
	     (if pretend-backwards
		 (setq last-index-if-from-end i)
	       (return i)))))))

;; Copied from LAD: RELEASE-3.SYS; GENRIC.LISP#60 on 27-Mar-87 12:21:45

))

; From modified file DJ: L.SYS; GENRIC.LISP#59 at 24-Jun-88 15:46:08
#10R SYSTEM-INTERNALS#: #!:CL
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SYSTEM-INTERNALS")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: SYS; GENRIC  "

(defun cl:subst (new old tree &key test test-not key)
  "Replace with NEW every atom or subtree in TREE which matches OLD.
List structure is copied as necessary so that the original TREE is not modified.
KEY, if non-NIL, is a function applied to each element to get the
 object to match against.  If KEY is NIL, the element itself is used.
TEST is a function passed OLD and the element (or its key).
 There is a match if TEST returns non-NIL.  TEST defaults to EQL.
Alternatively, pass TEST-NOT, a function to return NIL when there is a match."
  (when (and test test-not)
    (ferror "Both ~S and ~S specified" :test :test-not))
  (block subst
    (when (and (null test-not) (null key))
      (cond ((or (null test) (eq test 'eql) (eq test #'eql))
	     (return-from subst (subst-eql new old tree)))
	    ((or (eq test #'eq) (eq test 'eq))
	     (return-from subst (subst-eq new old tree)))))
    (subst-1 new old tree (or test-not test) (not (null test-not)) key nil)))

))

; From modified file DJ: L.SYS; GENRIC.LISP#59 at 24-Jun-88 15:46:10
#10R SYSTEM-INTERNALS#: #!:CL
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SYSTEM-INTERNALS")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: SYS; GENRIC  "


(defun nsubst (new old tree &key test test-not key)
  "Destructively replace with NEW every atom or subtree in TREE which matches OLD.
KEY, if non-NIL, is a function applied to each element to get the
 object to match against.  If KEY is NIL, the element itself is used.
TEST is a function passed OLD and the element (or its key).
 There is a match if TEST returns non-NIL.  TEST defaults to EQL.
Alternatively, pass TEST-NOT, a function to return NIL when there is a match."
  (when (and test test-not)
    (ferror "Both ~S and ~S specified" :test :test-not))
  (when (and (null test-not) (null key))
    (cond ((or (null test) (eq test #'eql) (eq test 'eql))
	   (return-from nsubst (nsubst-eql new old tree)))
	  ((or (eq test #'eq) (eq test 'eq))
	   (return-from nsubst (nsubst-eq new old tree)))))
  (nsubst-1 new old tree (or test-not test) (not (null test-not)) key nil))

))

; From modified file DJ: L.SYS; GENRIC.LISP#59 at 24-Jun-88 15:46:31
#10R SYSTEM-INTERNALS#: #!:CL
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SYSTEM-INTERNALS")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: SYS; GENRIC  "

(defun cl:assoc (item list &key test test-not key)
  "Returns the first element of LIST whose car matches ITEM, or NIL if none.
TEST is a function used to compare ITEM with each car;
 they match if it returns non-NIL.  TEST defaults to EQL.
Alternatively, specify TEST-NOT, a function which returns NIL for a match."
  (when (and test test-not)
    (ferror "Both ~S and ~S specified" :test :test-not))
  (assoc-1 item list test test-not key))

;; Copied from LAD: RELEASE-3.SYS; GENRIC.LISP#60 on 27-Mar-87 12:21:58

))

; From modified file DJ: L.SYS; GENRIC.LISP#59 at 24-Jun-88 15:46:39
#10R SYSTEM-INTERNALS#: #!:CL
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SYSTEM-INTERNALS")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: SYS; GENRIC  "

(defun cl:rassoc (item list &key test test-not key)
  "Returns the first element of LIST whose cdr matches ITEM, or NIL if none.
TEST is a function used to compare ITEM with each cdr;
 they match if it returns non-NIL.  TEST defaults to EQL.
Alternatively, specify TEST-NOT, a function which returns NIL for a match."
  (when (and test test-not)
    (ferror "Both ~S and ~S specified" :test :test-not))
  (rassoc-1 item list test test-not key))

;; Copied from LAD: RELEASE-3.SYS; GENRIC.LISP#60 on 27-Mar-87 12:22:00

))

; From modified file DJ: L.SYS; GENRIC.LISP#59 at 24-Jun-88 15:46:51
#10R SYSTEM-INTERNALS#: #!:CL
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SYSTEM-INTERNALS")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: SYS; GENRIC  "


(defun cl:nintersection (list1 list2 &rest stuff &key test test-not key)
  "Destructively modify LIST1 to be the intersection of LIST1 and LIST2, regarded as sets.
Any element of LIST1 which fails to match some element of LIST2 is deleted.
TEST is used to compare two elements; it returns T if they match.
 It defaults to EQL.
 Alternately, specify TEST-NOT, a function to return NIL if they match.
If KEY is non-NIL, it is a function to apply to each element
 to get a key which is then passed to TEST or TEST-NOT instead of the element."
  (when (and test test-not)
    (ferror "Both ~S and ~S specified" :test :test-not))
  (block nintersection
    (do ((list list1 (cdr list))
	 (result)
	 (old))
	((null list) result)
      (cond ((if (null stuff)
		 (member-eql (car list) list2)
	       (member-1 (if key (funcall key (car list)) (car list)) list2 test test-not key))
	     (or result (setq result list))
	     (setq old list))
	    (old
	     (setf (cdr old) (cdr list)))))))

))

; From modified file DJ: L.SYS; GENRIC.LISP#59 at 24-Jun-88 15:47:08
#10R SYSTEM-INTERNALS#: #!:CL
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SYSTEM-INTERNALS")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: SYS; GENRIC  "


(defun nset-difference (list1 list2 &rest stuff &key test test-not key)
  "Destructively modify LIST1 to be the LIST1 minus LIST2, regarded as sets.
Any element of LIST1 which matches an element of LIST2 is deleted.
TEST is used to compare two elements; it returns T if they match.
 It defaults to EQL.
 Alternately, specify TEST-NOT, a function to return NIL if they match.
If KEY is non-NIL, it is a function to apply to each element
 to get a key which is then passed to TEST or TEST-NOT instead of the element."
  (when (and test test-not)
    (ferror "Both ~S and ~S specified" :test :test-not))
  (do ((list list1 (cdr list))
       (result)
       (old))
      ((null list) result)
    (cond ((not (if (null stuff)
		    (member-eql (car list) list2)
		  (member-1 (if key (funcall key (car list)) (car list))
			    list2 test test-not key)))
	   (or result (setq result list))
	   (setq old list))
	  (old
	   (setf (cdr old) (cdr list))))))

))

; From modified file DJ: L.SYS; GENRIC.LISP#59 at 24-Jun-88 15:47:19
#10R SYSTEM-INTERNALS#: #!:CL
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SYSTEM-INTERNALS")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: SYS; GENRIC  "


(defun nset-exclusive-or (list1 list2 &rest stuff &key test test-not key)
  "Destructively return the differences between LIST1 and LIST2, regarded as sets.
Any element of either list which matches nothing in the other list is in the result.
If neither argument has duplicate elements, neither does the value.
Both arguments can be chewed up in producing the result.
TEST is used to compare two elements; it returns T if they match.
 It defaults to EQL.
 Alternately, specify TEST-NOT, a function to return NIL if they match.
If KEY is non-NIL, it is a function to apply to each element
 to get a key which is then passed to TEST or TEST-NOT instead of the element."
  (when (and test test-not)
    (ferror "Both ~S and ~S specified" :test :test-not))
  (do* ((list list1 savecdr)
	(result)
	removed
	(savecdr (cdr list) (cdr list))
	(old))
       ((null list)
	(nconc result (apply #'nset-difference list2 removed stuff)))
    (cond ((not (if (null stuff)
		    (member-eql (car list) list2)
		  (member-1 (if key (funcall key (car list)) (car list))
			    list2 test test-not key)))
	   (or result (setq result list))
	   (setq old list))
	  (t
	   (if old (setf (cdr old) (cdr list)))
	   (setf (cdr list) removed)
	   (setq removed list)))))

))