X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fseqtran.lisp;h=0e50c0fa1eed3b839392f8444fe9a97d93fecae3;hb=09d7974601df2aaaa820ca576026b9b4f03e6ab1;hp=660f804fcde86c6f5d64336cf66b408d5d9f797b;hpb=b062a0cffdc3e1706a67c487d2bc5e406c104893;p=sbcl.git

diff --git a/src/compiler/seqtran.lisp b/src/compiler/seqtran.lisp
index 660f804..0e50c0f 100644
--- a/src/compiler/seqtran.lisp
+++ b/src/compiler/seqtran.lisp
@@ -927,3 +927,80 @@
   (check-inlineability-of-find-position-if sequence from-end)
   '(%find-position-vector-macro item sequence
 				from-end start end key test))
+
+;;; logic to unravel :TEST, :TEST-NOT, and :KEY options in FIND,
+;;; POSITION-IF, etc.
+(define-source-transform effective-find-position-test (test test-not)
+  `(cond
+    ((and ,test ,test-not)
+     (error "can't specify both :TEST and :TEST-NOT"))
+    (,test (%coerce-callable-to-fun ,test))
+    (,test-not
+     ;; (Without DYNAMIC-EXTENT, this is potentially horribly
+     ;; inefficient, but since the TEST-NOT option is deprecated
+     ;; anyway, we don't care.)
+     (complement (%coerce-callable-to-fun ,test-not)))
+    (t #'eql)))
+(define-source-transform effective-find-position-key (key)
+  `(if ,key
+       (%coerce-callable-to-fun ,key)
+       #'identity))
+
+(macrolet ((define-find-position (fun-name values-index)
+	       `(define-source-transform ,fun-name (item sequence &key
+						    from-end (start 0) end
+						    key test test-not)
+		 `(nth-value ,,values-index
+		   (%find-position ,item ,sequence
+		    ,from-end ,start
+		    ,end
+		    (effective-find-position-key ,key)
+		    (effective-find-position-test ,test ,test-not))))))
+  (define-find-position find 0)
+  (define-find-position position 1))
+
+(macrolet ((define-find-position-if (fun-name values-index)
+	       `(define-source-transform ,fun-name (predicate sequence &key
+						    from-end (start 0)
+						    end key)
+		 `(nth-value
+		   ,,values-index
+		   (%find-position-if (%coerce-callable-to-fun ,predicate)
+		    ,sequence ,from-end
+		    ,start ,end
+		    (effective-find-position-key ,key))))))
+  (define-find-position-if find-if 0)
+  (define-find-position-if position-if 1))
+
+;;; the deprecated functions FIND-IF-NOT and POSITION-IF-NOT. We
+;;; didn't bother to worry about optimizing them, except note that on
+;;; Sat, Oct 06, 2001 at 04:22:38PM +0100, Christophe Rhodes wrote on
+;;; sbcl-devel
+;;;
+;;;     My understanding is that while the :test-not argument is
+;;;     deprecated in favour of :test (complement #'foo) because of
+;;;     semantic difficulties (what happens if both :test and :test-not
+;;;     are supplied, etc) the -if-not variants, while officially
+;;;     deprecated, would be undeprecated were X3J13 actually to produce
+;;;     a revised standard, as there are perfectly legitimate idiomatic
+;;;     reasons for allowing the -if-not versions equal status,
+;;;     particularly remove-if-not (== filter).
+;;;
+;;;     This is only an informal understanding, I grant you, but
+;;;     perhaps it's worth optimizing the -if-not versions in the same
+;;;     way as the others?
+;;;
+;;; FIXME: Maybe remove uses of these deprecated functions (and
+;;; definitely of :TEST-NOT) within the implementation of SBCL.
+(macrolet ((define-find-position-if-not (fun-name values-index)
+	       `(define-source-transform ,fun-name (predicate sequence &key
+						    from-end (start 0)
+						    end key)
+		 `(nth-value
+		   ,,values-index
+		   (%find-position-if-not (%coerce-callable-to-fun ,predicate)
+		    ,sequence ,from-end
+		    ,start ,end
+		    (effective-find-position-key ,key))))))
+  (define-find-position-if-not find-if-not 0)
+  (define-find-position-if-not position-if-not 1))