Implement FIND-UNIQUE-MATCHING-ITEM and FIND-UNIQUE-NON-MATCHING-ITEM.

diff --git a/v7/src/runtime/list.scm b/v7/src/runtime/list.scm
index 7867e17d9c57e8ee22b4252f15984611afcd55b4..c7593a602c3ccd0cd8ed988600711b5ec87c79e4 100644 (file)
--- a/v7/src/runtime/list.scm
+++ b/v7/src/runtime/list.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: list.scm,v 14.49 2005/04/28 04:33:36 cph Exp $
+$Id: list.scm,v 14.50 2005/12/23 04:15:38 cph Exp $
 
 Copyright 1986,1987,1988,1989,1990,1991 Massachusetts Institute of Technology
 Copyright 1992,1993,1994,1995,1996,2000 Massachusetts Institute of Technology
@@ -691,6 +691,32 @@ USA.
              (error:not-list items 'FIND-MATCHING-ITEM))
          #f))))
 
+(define (find-unique-matching-item items predicate)
+  (let loop ((items* items))
+    (if (pair? items*)
+       (if (predicate (car items*))
+           (if (there-exists? (cdr items*) predicate)
+               #f
+               (car items*))
+           (loop (cdr items*)))
+       (begin
+         (if (not (null? items*))
+             (error:not-list items 'FIND-UNIQUE-MATCHING-ITEM))
+         #f))))
+
+(define (find-unique-non-matching-item items predicate)
+  (let loop ((items* items))
+    (if (pair? items*)
+       (if (predicate (car items*))
+           (loop (cdr items*))
+           (if (for-all? (cdr items*) predicate)
+               (car items*)
+               #f))
+       (begin
+         (if (not (null? items*))
+             (error:not-list items 'FIND-UNIQUE-NON-MATCHING-ITEM))
+         #f))))
+\f
 (define (count-matching-items items predicate)
   (do ((items* items (cdr items*))
        (n 0 (if (predicate (car items*)) (+ n 1) n)))

diff --git a/v7/src/runtime/runtime.pkg b/v7/src/runtime/runtime.pkg
index d27a093b563d22954b12cae2986426ac5a591ba7..b1a743cfbc7a8cd9540ee9ed7735831247da617c 100644 (file)
--- a/v7/src/runtime/runtime.pkg
+++ b/v7/src/runtime/runtime.pkg
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: runtime.pkg,v 14.569 2005/12/18 00:20:43 cph Exp $
+$Id: runtime.pkg,v 14.570 2005/12/23 04:15:45 cph Exp $
 
 Copyright 1988,1989,1990,1991,1992,1993 Massachusetts Institute of Technology
 Copyright 1994,1995,1996,1997,1998,1999 Massachusetts Institute of Technology
@@ -2164,6 +2164,8 @@ USA.
          fifth
          find-matching-item
          find-non-matching-item
+         find-unique-matching-item
+         find-unique-non-matching-item
          first
          fold-left
          fold-right