From: Chris Hanson Date: Tue, 13 Dec 1988 13:02:45 +0000 (+0000) Subject: * Change `discriminate-items' to guarantee that the order of the X-Git-Tag: 20090517-FFI~12360 X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=b4d55f185a8c022f201a2c5c345c05d8492c176f;p=mit-scheme.git * Change `discriminate-items' to guarantee that the order of the results is the same as the order of the argument. * Update multiple value stuff. --- diff --git a/v7/src/compiler/base/utils.scm b/v7/src/compiler/base/utils.scm index 9969a7ece..f622fb42c 100644 --- a/v7/src/compiler/base/utils.scm +++ b/v7/src/compiler/base/utils.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/base/utils.scm,v 4.8 1988/12/06 18:54:25 jinx Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/base/utils.scm,v 4.9 1988/12/13 13:02:45 cph Exp $ Copyright (c) 1987, 1988 Massachusetts Institute of Technology @@ -60,7 +60,7 @@ MIT in each case. |# (define (discriminate-items items predicate) (let loop ((items items) (passed '()) (failed '())) (cond ((null? items) - (return-2 passed failed)) + (values (reverse! passed) (reverse! failed))) ((predicate (car items)) (loop (cdr items) (cons (car items) passed) failed)) (else @@ -97,7 +97,7 @@ MIT in each case. |# (define (all-eq? items) (if (null? items) - (error "ALL-EQ? undefined for empty set")) + (error "ALL-EQ?: undefined for empty set")) (or (null? (cdr items)) (for-all? (cdr items) (let ((item (car items))) @@ -106,12 +106,12 @@ MIT in each case. |# (define (all-eq-map? items map) (if (null? items) - (error "ALL-EQ-MAP? undefined for empty set")) + (error "ALL-EQ-MAP?: undefined for empty set")) (let ((item (map (car items)))) (if (or (null? (cdr items)) (for-all? (cdr items) (lambda (item*) (eq? item (map item*))))) - (return-2 true item) - (return-2 false false)))) + (values true item) + (values false false)))) (define (eq-set-union* set sets) (let loop ((set set) (sets sets) (accum '()))