From 981b85baf2061d76033c6cc701cc001a48a3bedb Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Wed, 17 Nov 2004 04:20:57 +0000 Subject: [PATCH] Use package system to create upwards-compatibility links. --- v7/src/runtime/list.scm | 20 +++++++++++--------- v7/src/runtime/runtime.pkg | 11 ++++++----- 2 files changed, 17 insertions(+), 14 deletions(-) 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 -- 2.25.1