X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=contrib%2Fcode-extras.lisp;h=c81b365334d171de2621f09e18ebd059a2039a85;hb=260de2062fca170efdac3e42491d7d866c2d2e56;hp=fe1b7150114c4c0ef9abd0c4c7de4ffa36eea1e4;hpb=0dea4acb4216f9ee1182a6dc49483ec8d42babc5;p=sbcl.git

diff --git a/contrib/code-extras.lisp b/contrib/code-extras.lisp
index fe1b715..c81b365 100644
--- a/contrib/code-extras.lisp
+++ b/contrib/code-extras.lisp
@@ -9,139 +9,11 @@
 #+nil
 (defun replace (..)
   (cond ((and (typep seq1 'simple-vector)
-	      (typep seq2 'simple-vector))
-	 (%replace-vector-vector ..))
-	((and (typep seq1 'simple-string)
-	      (typep seq2 'simple-string))
-	 (%replace-vector-vector ..))
-	(t
-	 ..)))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;; POSITION/FIND stuff
-
-#+sb-xc-host
-(eval-when (:compile-toplevel :load-toplevel :execute)
-  ;; FIXME: Report seq.impure.lisp test failures to cmucl-imp@cons.org.
-  ;; FIXME: Add BUGS entry for the way that inline expansions offunctions
-  ;; like FIND cause compiler warnings when the system can't prove that
-  ;; NIL is never returned; and give (NEED (FIND ..)) workaround.
-  (error "need to fix FIXMEs"))
-  
-;;; logic to unravel :TEST, :TEST-NOT, and :KEY options in FIND,
-;;; POSITION-IF, etc.
-(declaim (inline effective-find-position-test effective-find-position-key))
-(defun 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-function 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-function test-not)))
-	(t #'eql)))
-(defun effective-find-position-key (key)
-  (if key
-      (%coerce-callable-to-function key)
-      #'identity))
-
-;;; shared guts of out-of-line FIND, POSITION, FIND-IF, and POSITION-IF
-(macrolet (;; shared logic for defining %FIND-POSITION and
-	   ;; %FIND-POSITION-IF in terms of various inlineable cases
-	   ;; of the expression defined in FROB and VECTOR*-FROB
-	   (frobs ()
-	     `(etypecase sequence-arg
-		(list (frob sequence-arg from-end))
-		(vector 
-		 (with-array-data ((sequence sequence-arg :offset-var offset)
-				   (start start)
-				   (end (or end (length sequence-arg))))
-		   (multiple-value-bind (f p)
-		       (macrolet ((frob2 () '(if from-end
-						 (frob sequence t)
-						 (frob sequence nil))))
-			 (typecase sequence
-			   (simple-vector (frob2))
-			   (simple-string (frob2))
-			   (t (vector*-frob sequence))))
-		     (declare (type (or index null) p))
-		     (values f (and p (the index (+ p offset))))))))))
-  (defun %find-position (item sequence-arg from-end start end key test)
-    (macrolet ((frob (sequence from-end)
-		 `(%find-position item ,sequence
-				  ,from-end start end key test))
-	       (vector*-frob (sequence)
-		 `(%find-position-vector-macro item ,sequence
-					       from-end start end key test)))
-      (frobs)))
-  (defun %find-position-if (predicate sequence-arg from-end start end key)
-    (macrolet ((frob (sequence from-end)
-		 `(%find-position-if predicate ,sequence
-				     ,from-end start end key))
-	       (vector*-frob (sequence)
-		 `(%find-position-if-vector-macro predicate ,sequence
-						  from-end start end key)))
-      (frobs))))
-
-;;; the user interface to FIND and POSITION: Get all our ducks in a row,
-;;; then call %FIND-POSITION
-(declaim (inline find position))
-(macrolet ((def-find-position (fun-name values-index)
-	     `(defun ,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))))))
-  (def-find-position find 0)
-  (def-find-position position 1))
-
-;;; the user interface to FIND-IF and POSITION-IF, entirely analogous
-;;; to the interface to FIND and POSITION
-(declaim (inline find-if position-if))
-(macrolet ((def-find-position-if (fun-name values-index)
-	     `(defun ,fun-name (predicate sequence
-				&key from-end (start 0) end key)
-		(nth-value
-		 ,values-index
-		 (%find-position-if (%coerce-callable-to-function predicate)
-				    sequence
-				    from-end
-				    start
-				    end
-				    (effective-find-position-key key))))))
-  
-  (def-find-position-if find-if 0)
-  (def-find-position-if position-if 1))
-
-;;; the deprecated functions FIND-IF-NOT and POSITION-IF-NOT
-(macrolet ((def-find-position-if-not (fun-name values-index)
-	     `(defun ,fun-name (predicate sequence
-				&key from-end (start 0) end key)
-		(nth-value
-		 ,values-index
-		 (%find-position-if (complement (%coerce-callable-to-function
-						 predicate))
-				    sequence
-				    from-end
-				    start
-				    end
-				    (effective-find-position-key key))))))
-  (def-find-position-if-not find-if-not 0)
-  (def-find-position-if-not position-if-not 1))
-;;; FIXME: Remove uses of these deprecated functions, and of :TEST-NOT too.
+              (typep seq2 'simple-vector))
+         (%replace-vector-vector ..))
+        ((and (typep seq1 'simple-string)
+              (typep seq2 'simple-string))
+         (%replace-vector-vector ..))
+        (t
+         ..)))