mirror of
git://git.code.sf.net/p/sbcl/sbcl
synced 2026-09-10 07:26:40 -04:00
Remove anti-pattern
Target-only code with eval-when around defmacro, or worse, sb!xc:defmacro, is wrong. The cross-compiler will only ever want the target's variant of defmacro (and to imply otherwise is obfuscatory). The tree shaker does the right thing with no further code decorations needed.
This commit is contained in:
Douglas Katzman
parent
8ac3802908
commit
bbaae542da
|
|
@ -1737,7 +1737,3 @@ to :INTERPRET, an interpreter will be used.")
|
|||
(symbol (or (eq x t) (eq (symbol-package x) *keyword-package*)))
|
||||
(cons nil)
|
||||
(t t)))
|
||||
|
||||
(defmacro eval-when-compile-toplevel (&body body)
|
||||
`(eval-when (:compile-toplevel :execute #!+sb-devel :load-toplevel)
|
||||
,@body))
|
||||
|
|
|
|||
|
|
@ -23,8 +23,7 @@
|
|||
,(make-array n :initial-element 0))))))
|
||||
(def-it))
|
||||
|
||||
(eval-when-compile-toplevel
|
||||
(sb!xc:defmacro deferr (name args &rest body)
|
||||
(defmacro deferr (name args &rest body)
|
||||
(multiple-value-bind (llks required optional rest) (parse-lambda-list args)
|
||||
(declare (ignore llks))
|
||||
(aver (not rest))
|
||||
|
|
@ -34,7 +33,7 @@
|
|||
`(setf (svref **internal-error-handlers** ,(error-number-or-lose name))
|
||||
(named-lambda ,(string name) (,@args)
|
||||
(declare (optimize (sb!c::verify-arg-count 0)))
|
||||
,@body)))) ; EVAL-WHEN
|
||||
,@body)))
|
||||
|
||||
;;; Backtrace code may want to know the error that caused
|
||||
;;; interruption, but there are other means to get code interrupted
|
||||
|
|
|
|||
|
|
@ -152,8 +152,7 @@
|
|||
;; Signal a type error for non-sequences.
|
||||
;; This is for dispatching within sequence functions that have
|
||||
;; the EXPLICIT-CHECK attribute on at least their sequence arg(s).
|
||||
(eval-when-compile-toplevel
|
||||
(sb!xc:defmacro seq-dispatch-checking
|
||||
(defmacro seq-dispatch-checking
|
||||
(sequence list-form vector-form &optional (other-form nil other-form-p))
|
||||
`(cond ((listp ,sequence)
|
||||
(let ((,sequence (truly-the list ,sequence)))
|
||||
|
|
@ -180,12 +179,12 @@
|
|||
;;; a sequence. This assumes that the containing function declares its
|
||||
;;; result to be explicitly checked,
|
||||
;;; and that the LIST and VECTOR cases never fail to return a sequence.
|
||||
(sb!xc:defmacro seq-dispatch-checking=>seq
|
||||
(defmacro seq-dispatch-checking=>seq
|
||||
(sequence list-form vector-form other-form)
|
||||
`(seq-dispatch-checking ,sequence ,list-form ,vector-form
|
||||
(the sequence (values ,other-form)))))
|
||||
(the sequence (values ,other-form))))
|
||||
|
||||
(sb!xc:defmacro %make-sequence-like (sequence length)
|
||||
(defmacro %make-sequence-like (sequence length)
|
||||
"Return a sequence of the same type as SEQUENCE and the given LENGTH."
|
||||
`(seq-dispatch ,sequence
|
||||
(make-list ,length)
|
||||
|
|
@ -717,11 +716,9 @@
|
|||
(funcall getter vector2 index2))))))))
|
||||
vector1)
|
||||
|
||||
(eval-when-compile-toplevel
|
||||
|
||||
;;; If we are copying around in the same vector, be careful not to copy the
|
||||
;;; same elements over repeatedly. We do this by copying backwards.
|
||||
(sb!xc:defmacro vector-replace-from-vector ()
|
||||
(defmacro vector-replace-from-vector ()
|
||||
`(let ((nelts (min (- target-end target-start)
|
||||
(- source-end source-start))))
|
||||
(with-array-data ((data1 target-sequence) (start1 target-start) (end1))
|
||||
|
|
@ -741,7 +738,7 @@
|
|||
(vector-replace data1 data2 start1 start2 end1 1)))))
|
||||
target-sequence))
|
||||
|
||||
(sb!xc:defmacro list-replace-from-list ()
|
||||
(defmacro list-replace-from-list ()
|
||||
`(if (and (eq target-sequence source-sequence) (> target-start source-start))
|
||||
(let ((new-elts (subseq source-sequence source-start
|
||||
(+ (the fixnum source-start)
|
||||
|
|
@ -767,7 +764,7 @@
|
|||
(declare (fixnum target-index source-index))
|
||||
(rplaca target-sequence-ref (car source-sequence-ref)))))
|
||||
|
||||
(sb!xc:defmacro list-replace-from-vector ()
|
||||
(defmacro list-replace-from-vector ()
|
||||
`(do ((target-index target-start (1+ target-index))
|
||||
(source-index source-start (1+ source-index))
|
||||
(target-sequence-ref (nthcdr target-start target-sequence)
|
||||
|
|
@ -779,7 +776,7 @@
|
|||
(declare (fixnum source-index target-index))
|
||||
(rplaca target-sequence-ref (aref source-sequence source-index))))
|
||||
|
||||
(sb!xc:defmacro vector-replace-from-list ()
|
||||
(defmacro vector-replace-from-list ()
|
||||
`(do ((target-index target-start (1+ target-index))
|
||||
(source-index source-start (1+ source-index))
|
||||
(source-sequence (nthcdr source-start source-sequence)
|
||||
|
|
@ -791,8 +788,6 @@
|
|||
(declare (fixnum target-index source-index))
|
||||
(setf (aref target-sequence target-index) (car source-sequence))))
|
||||
|
||||
) ; EVAL-WHEN
|
||||
|
||||
;;;; The support routines for REPLACE are used by compiler transforms, so we
|
||||
;;;; worry about dealing with END being supplied or defaulting to NIL
|
||||
;;;; at this level.
|
||||
|
|
@ -1404,9 +1399,7 @@ many elements are copied."
|
|||
|
||||
;;;; REDUCE
|
||||
|
||||
(eval-when-compile-toplevel
|
||||
|
||||
(sb!xc:defmacro mumble-reduce (function
|
||||
(defmacro mumble-reduce (function
|
||||
sequence
|
||||
key
|
||||
start
|
||||
|
|
@ -1419,7 +1412,7 @@ many elements are copied."
|
|||
(setq value (funcall ,function value
|
||||
(apply-key ,key (,ref ,sequence index))))))
|
||||
|
||||
(sb!xc:defmacro mumble-reduce-from-end (function
|
||||
(defmacro mumble-reduce-from-end (function
|
||||
sequence
|
||||
key
|
||||
start
|
||||
|
|
@ -1434,7 +1427,7 @@ many elements are copied."
|
|||
(apply-key ,key (,ref ,sequence index))
|
||||
value))))
|
||||
|
||||
(sb!xc:defmacro list-reduce (function
|
||||
(defmacro list-reduce (function
|
||||
sequence
|
||||
key
|
||||
start
|
||||
|
|
@ -1450,7 +1443,7 @@ many elements are copied."
|
|||
(funcall ,function value (apply-key ,key (car sequence)))))
|
||||
((>= count ,end) value))))
|
||||
|
||||
(sb!xc:defmacro list-reduce-from-end (function
|
||||
(defmacro list-reduce-from-end (function
|
||||
sequence
|
||||
key
|
||||
start
|
||||
|
|
@ -1467,8 +1460,6 @@ many elements are copied."
|
|||
(funcall ,function (apply-key ,key (car sequence)) value)))
|
||||
((>= count ,end) value))))
|
||||
|
||||
) ; EVAL-WHEN
|
||||
|
||||
(define-sequence-traverser reduce (function sequence &rest args &key key
|
||||
from-end start end (initial-value nil ivp))
|
||||
(declare (type index start)
|
||||
|
|
@ -1505,9 +1496,7 @@ many elements are copied."
|
|||
|
||||
;;;; DELETE
|
||||
|
||||
(eval-when-compile-toplevel
|
||||
|
||||
(sb!xc:defmacro mumble-delete (pred)
|
||||
(defmacro mumble-delete (pred)
|
||||
`(do ((index start (1+ index))
|
||||
(jndex start)
|
||||
(number-zapped 0))
|
||||
|
|
@ -1524,7 +1513,7 @@ many elements are copied."
|
|||
(incf number-zapped)
|
||||
(incf jndex))))
|
||||
|
||||
(sb!xc:defmacro mumble-delete-from-end (pred)
|
||||
(defmacro mumble-delete-from-end (pred)
|
||||
`(do ((index (1- (the fixnum end)) (1- index)) ; Find the losers.
|
||||
(number-zapped 0)
|
||||
(losers ())
|
||||
|
|
@ -1552,19 +1541,19 @@ many elements are copied."
|
|||
(incf number-zapped)
|
||||
(push index losers))))
|
||||
|
||||
(sb!xc:defmacro normal-mumble-delete ()
|
||||
(defmacro normal-mumble-delete ()
|
||||
`(mumble-delete
|
||||
(if test-not
|
||||
(not (funcall test-not item (apply-key key (aref sequence index))))
|
||||
(funcall test item (apply-key key (aref sequence index))))))
|
||||
|
||||
(sb!xc:defmacro normal-mumble-delete-from-end ()
|
||||
(defmacro normal-mumble-delete-from-end ()
|
||||
`(mumble-delete-from-end
|
||||
(if test-not
|
||||
(not (funcall test-not item (apply-key key this-element)))
|
||||
(funcall test item (apply-key key this-element)))))
|
||||
|
||||
(sb!xc:defmacro list-delete (pred)
|
||||
(defmacro list-delete (pred)
|
||||
`(let ((handle (cons nil sequence)))
|
||||
(declare (truly-dynamic-extent handle))
|
||||
(do* ((previous (nthcdr start handle))
|
||||
|
|
@ -1580,7 +1569,7 @@ many elements are copied."
|
|||
(t
|
||||
(pop previous))))))
|
||||
|
||||
(sb!xc:defmacro list-delete-from-end (pred)
|
||||
(defmacro list-delete-from-end (pred)
|
||||
`(let* ((reverse (nreverse sequence))
|
||||
(handle (cons nil reverse)))
|
||||
(declare (truly-dynamic-extent handle))
|
||||
|
|
@ -1597,20 +1586,18 @@ many elements are copied."
|
|||
(t
|
||||
(pop previous))))))
|
||||
|
||||
(sb!xc:defmacro normal-list-delete ()
|
||||
(defmacro normal-list-delete ()
|
||||
'(list-delete
|
||||
(if test-not
|
||||
(not (funcall test-not item (apply-key key (car current))))
|
||||
(funcall test item (apply-key key (car current))))))
|
||||
|
||||
(sb!xc:defmacro normal-list-delete-from-end ()
|
||||
(defmacro normal-list-delete-from-end ()
|
||||
'(list-delete-from-end
|
||||
(if test-not
|
||||
(not (funcall test-not item (apply-key key (car current))))
|
||||
(funcall test item (apply-key key (car current))))))
|
||||
|
||||
) ; EVAL-WHEN
|
||||
|
||||
(define-sequence-traverser delete
|
||||
(item sequence &rest args &key from-end test test-not start
|
||||
end count key)
|
||||
|
|
@ -1632,26 +1619,22 @@ many elements are copied."
|
|||
(normal-mumble-delete)))
|
||||
(apply #'sb!sequence:delete item sequence args)))
|
||||
|
||||
(eval-when-compile-toplevel
|
||||
|
||||
(sb!xc:defmacro if-mumble-delete ()
|
||||
(defmacro if-mumble-delete ()
|
||||
`(mumble-delete
|
||||
(funcall predicate (apply-key key (aref sequence index)))))
|
||||
|
||||
(sb!xc:defmacro if-mumble-delete-from-end ()
|
||||
(defmacro if-mumble-delete-from-end ()
|
||||
`(mumble-delete-from-end
|
||||
(funcall predicate (apply-key key this-element))))
|
||||
|
||||
(sb!xc:defmacro if-list-delete ()
|
||||
(defmacro if-list-delete ()
|
||||
'(list-delete
|
||||
(funcall predicate (apply-key key (car current)))))
|
||||
|
||||
(sb!xc:defmacro if-list-delete-from-end ()
|
||||
(defmacro if-list-delete-from-end ()
|
||||
'(list-delete-from-end
|
||||
(funcall predicate (apply-key key (car current)))))
|
||||
|
||||
) ; EVAL-WHEN
|
||||
|
||||
(define-sequence-traverser delete-if
|
||||
(predicate sequence &rest args &key from-end start key end count)
|
||||
"Return a sequence formed by destructively removing the elements satisfying
|
||||
|
|
@ -1672,26 +1655,22 @@ many elements are copied."
|
|||
(if-mumble-delete)))
|
||||
(apply #'sb!sequence:delete-if predicate sequence args)))
|
||||
|
||||
(eval-when-compile-toplevel
|
||||
|
||||
(sb!xc:defmacro if-not-mumble-delete ()
|
||||
(defmacro if-not-mumble-delete ()
|
||||
`(mumble-delete
|
||||
(not (funcall predicate (apply-key key (aref sequence index))))))
|
||||
|
||||
(sb!xc:defmacro if-not-mumble-delete-from-end ()
|
||||
(defmacro if-not-mumble-delete-from-end ()
|
||||
`(mumble-delete-from-end
|
||||
(not (funcall predicate (apply-key key this-element)))))
|
||||
|
||||
(sb!xc:defmacro if-not-list-delete ()
|
||||
(defmacro if-not-list-delete ()
|
||||
'(list-delete
|
||||
(not (funcall predicate (apply-key key (car current))))))
|
||||
|
||||
(sb!xc:defmacro if-not-list-delete-from-end ()
|
||||
(defmacro if-not-list-delete-from-end ()
|
||||
'(list-delete-from-end
|
||||
(not (funcall predicate (apply-key key (car current))))))
|
||||
|
||||
) ; EVAL-WHEN
|
||||
|
||||
(define-sequence-traverser delete-if-not
|
||||
(predicate sequence &rest args &key from-end start end key count)
|
||||
"Return a sequence formed by destructively removing the elements not
|
||||
|
|
@ -1714,11 +1693,9 @@ many elements are copied."
|
|||
|
||||
;;;; REMOVE
|
||||
|
||||
(eval-when-compile-toplevel
|
||||
|
||||
;;; MUMBLE-REMOVE-MACRO does not include (removes) each element that
|
||||
;;; satisfies the predicate.
|
||||
(sb!xc:defmacro mumble-remove-macro (bump left begin finish right pred)
|
||||
(defmacro mumble-remove-macro (bump left begin finish right pred)
|
||||
`(do ((index ,begin (,bump index))
|
||||
(result
|
||||
(do ((index ,left (,bump index))
|
||||
|
|
@ -1742,41 +1719,41 @@ many elements are copied."
|
|||
(t (setf (aref result new-index) this-element)
|
||||
(setq new-index (,bump new-index))))))
|
||||
|
||||
(sb!xc:defmacro mumble-remove (pred)
|
||||
(defmacro mumble-remove (pred)
|
||||
`(mumble-remove-macro 1+ 0 start end length ,pred))
|
||||
|
||||
(sb!xc:defmacro mumble-remove-from-end (pred)
|
||||
(defmacro mumble-remove-from-end (pred)
|
||||
`(let ((sequence (copy-seq sequence)))
|
||||
(mumble-delete-from-end ,pred)))
|
||||
|
||||
(sb!xc:defmacro normal-mumble-remove ()
|
||||
(defmacro normal-mumble-remove ()
|
||||
`(mumble-remove
|
||||
(if test-not
|
||||
(not (funcall test-not item (apply-key key this-element)))
|
||||
(funcall test item (apply-key key this-element)))))
|
||||
|
||||
(sb!xc:defmacro normal-mumble-remove-from-end ()
|
||||
(defmacro normal-mumble-remove-from-end ()
|
||||
`(mumble-remove-from-end
|
||||
(if test-not
|
||||
(not (funcall test-not item (apply-key key this-element)))
|
||||
(funcall test item (apply-key key this-element)))))
|
||||
|
||||
(sb!xc:defmacro if-mumble-remove ()
|
||||
(defmacro if-mumble-remove ()
|
||||
`(mumble-remove (funcall predicate (apply-key key this-element))))
|
||||
|
||||
(sb!xc:defmacro if-mumble-remove-from-end ()
|
||||
(defmacro if-mumble-remove-from-end ()
|
||||
`(mumble-remove-from-end (funcall predicate (apply-key key this-element))))
|
||||
|
||||
(sb!xc:defmacro if-not-mumble-remove ()
|
||||
(defmacro if-not-mumble-remove ()
|
||||
`(mumble-remove (not (funcall predicate (apply-key key this-element)))))
|
||||
|
||||
(sb!xc:defmacro if-not-mumble-remove-from-end ()
|
||||
(defmacro if-not-mumble-remove-from-end ()
|
||||
`(mumble-remove-from-end
|
||||
(not (funcall predicate (apply-key key this-element)))))
|
||||
|
||||
;;; LIST-REMOVE-MACRO does not include (removes) each element that satisfies
|
||||
;;; the predicate.
|
||||
(sb!xc:defmacro list-remove-macro (pred reverse?)
|
||||
(defmacro list-remove-macro (pred reverse?)
|
||||
`(let* ((sequence ,(if reverse?
|
||||
'(reverse (the list sequence))
|
||||
'sequence))
|
||||
|
|
@ -1821,42 +1798,40 @@ many elements are copied."
|
|||
(incf number-zapped)
|
||||
(setf splice (cdr (rplacd splice (list this-element))))))))
|
||||
|
||||
(sb!xc:defmacro list-remove (pred)
|
||||
(defmacro list-remove (pred)
|
||||
`(list-remove-macro ,pred nil))
|
||||
|
||||
(sb!xc:defmacro list-remove-from-end (pred)
|
||||
(defmacro list-remove-from-end (pred)
|
||||
`(list-remove-macro ,pred t))
|
||||
|
||||
(sb!xc:defmacro normal-list-remove ()
|
||||
(defmacro normal-list-remove ()
|
||||
`(list-remove
|
||||
(if test-not
|
||||
(not (funcall test-not item (apply-key key this-element)))
|
||||
(funcall test item (apply-key key this-element)))))
|
||||
|
||||
(sb!xc:defmacro normal-list-remove-from-end ()
|
||||
(defmacro normal-list-remove-from-end ()
|
||||
`(list-remove-from-end
|
||||
(if test-not
|
||||
(not (funcall test-not item (apply-key key this-element)))
|
||||
(funcall test item (apply-key key this-element)))))
|
||||
|
||||
(sb!xc:defmacro if-list-remove ()
|
||||
(defmacro if-list-remove ()
|
||||
`(list-remove
|
||||
(funcall predicate (apply-key key this-element))))
|
||||
|
||||
(sb!xc:defmacro if-list-remove-from-end ()
|
||||
(defmacro if-list-remove-from-end ()
|
||||
`(list-remove-from-end
|
||||
(funcall predicate (apply-key key this-element))))
|
||||
|
||||
(sb!xc:defmacro if-not-list-remove ()
|
||||
(defmacro if-not-list-remove ()
|
||||
`(list-remove
|
||||
(not (funcall predicate (apply-key key this-element)))))
|
||||
|
||||
(sb!xc:defmacro if-not-list-remove-from-end ()
|
||||
(defmacro if-not-list-remove-from-end ()
|
||||
`(list-remove-from-end
|
||||
(not (funcall predicate (apply-key key this-element)))))
|
||||
|
||||
) ; EVAL-WHEN
|
||||
|
||||
(define-sequence-traverser remove
|
||||
(item sequence &rest args &key from-end test test-not start
|
||||
end count key)
|
||||
|
|
@ -2231,9 +2206,7 @@ many elements are copied."
|
|||
(incf index incrementer))
|
||||
result))
|
||||
|
||||
(eval-when-compile-toplevel
|
||||
|
||||
(sb!xc:defmacro subst-dispatch (pred)
|
||||
(defmacro subst-dispatch (pred)
|
||||
`(seq-dispatch-checking=>seq sequence
|
||||
(let ((end (or end length)))
|
||||
(declare (type index end))
|
||||
|
|
@ -2268,7 +2241,6 @@ many elements are copied."
|
|||
((normal) `(apply #'sb!sequence:substitute new old sequence args))
|
||||
((if) `(apply #'sb!sequence:substitute-if new predicate sequence args))
|
||||
((if-not) `(apply #'sb!sequence:substitute-if-not new predicate sequence args)))))
|
||||
) ; EVAL-WHEN
|
||||
|
||||
(define-sequence-traverser substitute
|
||||
(new old sequence &rest args &key from-end test test-not
|
||||
|
|
@ -2644,9 +2616,7 @@ many elements are copied."
|
|||
|
||||
;;;; COUNT-IF, COUNT-IF-NOT, and COUNT
|
||||
|
||||
(eval-when-compile-toplevel
|
||||
|
||||
(sb!xc:defmacro vector-count-if (notp from-end-p predicate sequence
|
||||
(defmacro vector-count-if (notp from-end-p predicate sequence
|
||||
&key two-arg-predicate)
|
||||
(let ((next-index (if from-end-p '(1- index) '(1+ index)))
|
||||
(pred (if two-arg-predicate
|
||||
|
|
@ -2666,7 +2636,7 @@ many elements are copied."
|
|||
`(,(if notp 'unless 'when) ,pred
|
||||
(setq count (1+ count))))))))
|
||||
|
||||
(sb!xc:defmacro list-count-if (notp from-end-p predicate sequence
|
||||
(defmacro list-count-if (notp from-end-p predicate sequence
|
||||
&key two-arg-predicate)
|
||||
(let ((pred (if two-arg-predicate
|
||||
`(funcall ,predicate ,two-arg-predicate (apply-key key (pop sequence)))
|
||||
|
|
@ -2687,9 +2657,6 @@ many elements are copied."
|
|||
`(,(if notp 'unless 'when) ,pred
|
||||
(setq count (1+ count))))))))
|
||||
|
||||
|
||||
) ; EVAL-WHEN
|
||||
|
||||
(define-sequence-traverser count-if
|
||||
(pred sequence &rest args &key from-end start end key)
|
||||
"Return the number of elements in SEQUENCE satisfying PRED(el)."
|
||||
|
|
@ -2757,9 +2724,7 @@ many elements are copied."
|
|||
|
||||
;;;; MISMATCH
|
||||
|
||||
(eval-when-compile-toplevel
|
||||
|
||||
(sb!xc:defmacro match-vars (&rest body)
|
||||
(defmacro match-vars (&rest body)
|
||||
`(let ((inc (if from-end -1 1))
|
||||
(start1 (if from-end (1- (the fixnum end1)) start1))
|
||||
(start2 (if from-end (1- (the fixnum end2)) start2))
|
||||
|
|
@ -2768,7 +2733,7 @@ many elements are copied."
|
|||
(declare (fixnum inc start1 start2 end1 end2))
|
||||
,@body))
|
||||
|
||||
(sb!xc:defmacro matchify-list ((sequence start length end) &body body)
|
||||
(defmacro matchify-list ((sequence start length end) &body body)
|
||||
(declare (ignore end)) ;; ### Should END be used below?
|
||||
`(let ((,sequence (if from-end
|
||||
(nthcdr (- (the fixnum ,length) (the fixnum ,start) 1)
|
||||
|
|
@ -2777,11 +2742,7 @@ many elements are copied."
|
|||
(declare (type list ,sequence))
|
||||
,@body))
|
||||
|
||||
) ; EVAL-WHEN
|
||||
|
||||
(eval-when-compile-toplevel
|
||||
|
||||
(sb!xc:defmacro if-mismatch (elt1 elt2)
|
||||
(defmacro if-mismatch (elt1 elt2)
|
||||
`(cond ((= (the fixnum index1) (the fixnum end1))
|
||||
(return (if (= (the fixnum index2) (the fixnum end2))
|
||||
nil
|
||||
|
|
@ -2797,28 +2758,28 @@ many elements are copied."
|
|||
(apply-key key ,elt2)))
|
||||
(return (if from-end (1+ (the fixnum index1)) index1))))))
|
||||
|
||||
(sb!xc:defmacro mumble-mumble-mismatch ()
|
||||
(defmacro mumble-mumble-mismatch ()
|
||||
`(do ((index1 start1 (+ index1 (the fixnum inc)))
|
||||
(index2 start2 (+ index2 (the fixnum inc))))
|
||||
(())
|
||||
(declare (fixnum index1 index2))
|
||||
(if-mismatch (aref sequence1 index1) (aref sequence2 index2))))
|
||||
|
||||
(sb!xc:defmacro mumble-list-mismatch ()
|
||||
(defmacro mumble-list-mismatch ()
|
||||
`(do ((index1 start1 (+ index1 (the fixnum inc)))
|
||||
(index2 start2 (+ index2 (the fixnum inc))))
|
||||
(())
|
||||
(declare (fixnum index1 index2))
|
||||
(if-mismatch (aref sequence1 index1) (pop sequence2))))
|
||||
|
||||
(sb!xc:defmacro list-mumble-mismatch ()
|
||||
(defmacro list-mumble-mismatch ()
|
||||
`(do ((index1 start1 (+ index1 (the fixnum inc)))
|
||||
(index2 start2 (+ index2 (the fixnum inc))))
|
||||
(())
|
||||
(declare (fixnum index1 index2))
|
||||
(if-mismatch (pop sequence1) (aref sequence2 index2))))
|
||||
|
||||
(sb!xc:defmacro list-list-mismatch ()
|
||||
(defmacro list-list-mismatch ()
|
||||
`(do ((sequence1 sequence1)
|
||||
(sequence2 sequence2)
|
||||
(index1 start1 (+ index1 (the fixnum inc)))
|
||||
|
|
@ -2827,8 +2788,6 @@ many elements are copied."
|
|||
(declare (fixnum index1 index2))
|
||||
(if-mismatch (pop sequence1) (pop sequence2))))
|
||||
|
||||
) ; EVAL-WHEN
|
||||
|
||||
(define-sequence-traverser mismatch
|
||||
(sequence1 sequence2 &rest args &key from-end test test-not
|
||||
start1 end1 start2 end2 key)
|
||||
|
|
@ -2886,10 +2845,8 @@ many elements are copied."
|
|||
|
||||
;;; search comparison functions
|
||||
|
||||
(eval-when-compile-toplevel
|
||||
|
||||
;;; Compare two elements and return if they don't match.
|
||||
(sb!xc:defmacro compare-elements (elt1 elt2)
|
||||
(defmacro compare-elements (elt1 elt2)
|
||||
`(if test-not
|
||||
(if (funcall test-not (apply-key key ,elt1) (apply-key key ,elt2))
|
||||
(return nil)
|
||||
|
|
@ -2898,7 +2855,7 @@ many elements are copied."
|
|||
(return nil)
|
||||
t)))
|
||||
|
||||
(sb!xc:defmacro search-compare-list-list (main sub)
|
||||
(defmacro search-compare-list-list (main sub)
|
||||
`(do ((main ,main (cdr main))
|
||||
(jndex start1 (1+ jndex))
|
||||
(sub (nthcdr start1 ,sub) (cdr sub)))
|
||||
|
|
@ -2907,13 +2864,13 @@ many elements are copied."
|
|||
(declare (type (integer 0) jndex))
|
||||
(compare-elements (car sub) (car main))))
|
||||
|
||||
(sb!xc:defmacro search-compare-list-vector (main sub)
|
||||
(defmacro search-compare-list-vector (main sub)
|
||||
`(do ((main ,main (cdr main))
|
||||
(index start1 (1+ index)))
|
||||
((or (endp main) (= index end1)) t)
|
||||
(compare-elements (aref ,sub index) (car main))))
|
||||
|
||||
(sb!xc:defmacro search-compare-vector-list (main sub index)
|
||||
(defmacro search-compare-vector-list (main sub index)
|
||||
`(do ((sub (nthcdr start1 ,sub) (cdr sub))
|
||||
(jndex start1 (1+ jndex))
|
||||
(index ,index (1+ index)))
|
||||
|
|
@ -2921,13 +2878,13 @@ many elements are copied."
|
|||
(declare (type (integer 0) jndex))
|
||||
(compare-elements (car sub) (aref ,main index))))
|
||||
|
||||
(sb!xc:defmacro search-compare-vector-vector (main sub index)
|
||||
(defmacro search-compare-vector-vector (main sub index)
|
||||
`(do ((index ,index (1+ index))
|
||||
(sub-index start1 (1+ sub-index)))
|
||||
((= sub-index end1) t)
|
||||
(compare-elements (aref ,sub sub-index) (aref ,main index))))
|
||||
|
||||
(sb!xc:defmacro search-compare (main-type main sub index)
|
||||
(defmacro search-compare (main-type main sub index)
|
||||
(if (eq main-type 'list)
|
||||
`(seq-dispatch ,sub
|
||||
(search-compare-list-list ,main ,sub)
|
||||
|
|
@ -2938,14 +2895,10 @@ many elements are copied."
|
|||
(search-compare-vector-list ,main ,sub ,index)
|
||||
(search-compare-vector-vector ,main ,sub ,index)
|
||||
(return-from search (apply #'sb!sequence:search sequence1 sequence2 args)))))
|
||||
|
||||
) ; EVAL-WHEN
|
||||
|
||||
;;;; SEARCH
|
||||
|
||||
(eval-when-compile-toplevel
|
||||
|
||||
(sb!xc:defmacro list-search (main sub)
|
||||
(defmacro list-search (main sub)
|
||||
`(do ((main (nthcdr start2 ,main) (cdr main))
|
||||
(index2 start2 (1+ index2))
|
||||
(terminus (- end2 (the (integer 0) (- end1 start1))))
|
||||
|
|
@ -2957,7 +2910,7 @@ many elements are copied."
|
|||
(setq last-match index2)
|
||||
(return index2)))))
|
||||
|
||||
(sb!xc:defmacro vector-search (main sub)
|
||||
(defmacro vector-search (main sub)
|
||||
`(do ((index2 start2 (1+ index2))
|
||||
(terminus (- end2 (the (integer 0) (- end1 start1))))
|
||||
(last-match ()))
|
||||
|
|
@ -2968,8 +2921,6 @@ many elements are copied."
|
|||
(setq last-match index2)
|
||||
(return index2)))))
|
||||
|
||||
) ; EVAL-WHEN
|
||||
|
||||
(define-sequence-traverser search
|
||||
(sequence1 sequence2 &rest args &key
|
||||
from-end test test-not start1 end1 start2 end2 key)
|
||||
|
|
|
|||
|
|
@ -12,8 +12,7 @@
|
|||
|
||||
(defvar *current-internal-error-context*)
|
||||
|
||||
(eval-when-compile-toplevel
|
||||
(sb!xc:defmacro with-pinned-context-code-object
|
||||
(defmacro with-pinned-context-code-object
|
||||
((&optional (context '*current-internal-error-context*))
|
||||
&body body)
|
||||
(declare (ignorable context))
|
||||
|
|
@ -22,7 +21,7 @@
|
|||
#!-(or x86 x86-64)
|
||||
`(with-pinned-objects ((without-gcing
|
||||
(sb!di::code-object-from-context ,context)))
|
||||
,@body)))
|
||||
,@body))
|
||||
|
||||
;;;; OS-CONTEXT-T
|
||||
|
||||
|
|
|
|||
Loading…
Reference in a new issue