From: Chris Hanson <org/chris-hanson/cph>
Date: Wed, 17 Nov 2004 04:20:57 +0000 (+0000)
Subject: Use package system to create upwards-compatibility links.
X-Git-Tag: 20090517-FFI~1480
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=981b85baf2061d76033c6cc701cc001a48a3bedb;p=mit-scheme.git

Use package system to create upwards-compatibility links.
---

diff --git a/v7/src/runtime/list.scm b/v7/src/runtime/list.scm
index dddb93d0a..9f42becda 100644
--- a/v7/src/runtime/list.scm
+++ b/v7/src/runtime/list.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: list.scm,v 14.38 2004/01/09 21:12:16 cph Exp $
+$Id: list.scm,v 14.39 2004/11/17 04:20:46 cph Exp $
 
 Copyright 1986,1987,1988,1989,1990,1991 Massachusetts Institute of Technology
 Copyright 1992,1993,1994,1995,1996,2000 Massachusetts Institute of Technology
@@ -743,14 +743,16 @@ USA.
 	      (error:wrong-type-argument items "list" 'FIND-MATCHING-ITEM))
 	  #f))))
 
-(define list-transform-positive keep-matching-items)
-(define list-transform-negative delete-matching-items)
-(define list-search-positive find-matching-item)
-
-(define (list-search-negative items predicate)
-  (find-matching-item items
-    (lambda (item)
-      (not (predicate item)))))
+(define (find-non-matching-item items predicate)
+  (let loop ((items* items))
+    (if (pair? items*)
+	(if (predicate (car items*))
+	    (loop (cdr items*))
+	    (car items*))
+	(begin
+	  (if (not (null? items*))
+	      (error:wrong-type-argument items "list" 'FIND-MATCHING-ITEM))
+	  #f))))
 
 (define (delete-matching-items! items predicate)
   (letrec
diff --git a/v7/src/runtime/runtime.pkg b/v7/src/runtime/runtime.pkg
index f0ca2893a..b755d6445 100644
--- a/v7/src/runtime/runtime.pkg
+++ b/v7/src/runtime/runtime.pkg
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: runtime.pkg,v 14.507 2004/11/04 03:00:38 cph Exp $
+$Id: runtime.pkg,v 14.508 2004/11/17 04:20:57 cph Exp $
 
 Copyright 1988,1989,1990,1991,1992,1993 Massachusetts Institute of Technology
 Copyright 1994,1995,1996,1997,1998,1999 Massachusetts Institute of Technology
@@ -2043,6 +2043,10 @@ USA.
   (files "list")
   (parent (runtime))
   (export ()
+	  (list-search-negative find-non-matching-item)
+	  (list-search-positive find-matching-item)
+	  (list-transform-negative delete-matching-items)
+	  (list-transform-positive keep-matching-items)
 	  add-member-procedure
 	  alist-copy
 	  alist?
@@ -2110,6 +2114,7 @@ USA.
 	  except-last-pair!
 	  fifth
 	  find-matching-item
+	  find-non-matching-item
 	  first
 	  fold-left
 	  fold-right
@@ -2134,11 +2139,7 @@ USA.
 	  list-of-type?
 	  list-of-type?->length
 	  list-ref
-	  list-search-negative
-	  list-search-positive
 	  list-tail
-	  list-transform-negative
-	  list-transform-positive
 	  list?
 	  list?->length
 	  make-circular-list