From e30a57b5a70b594ce245d121fee687b2ff4b1aa9 Mon Sep 17 00:00:00 2001 From: Eli Barzilay Date: Sun, 16 Mar 2008 15:28:42 +0000 Subject: [PATCH] receive -> let-values svn: r8989 --- collects/srfi/1/filter.ss | 11 ++++--- collects/srfi/1/fold.ss | 59 ++++++++++++++++++------------------- collects/srfi/1/lset.ss | 7 ++--- collects/srfi/1/misc.ss | 47 +++++++++++++++-------------- collects/srfi/1/search.ss | 29 +++++++++--------- collects/srfi/1/selector.ss | 7 ++--- collects/srfi/1/util.ss | 29 +++++++++--------- 7 files changed, 91 insertions(+), 98 deletions(-) diff --git a/collects/srfi/1/filter.ss b/collects/srfi/1/filter.ss index 07eb93cf5d..0da7c0bd98 100644 --- a/collects/srfi/1/filter.ss +++ b/collects/srfi/1/filter.ss @@ -36,8 +36,7 @@ (require mzlib/etc srfi/optional - "predicate.ss" - srfi/8/receive) + "predicate.ss") (provide filter partition @@ -115,10 +114,10 @@ (if (null-list? lis) (values lis lis) ; Use NOT-PAIR? to handle dotted lists. (let ((elt (car lis)) (tail (cdr lis))) - (receive (in out) (recur tail) - (if (pred elt) - (values (if (pair? out) (cons elt in) lis) out) - (values in (if (pair? in) (cons elt out) lis)))))))) + (let-values ([(in out) (recur tail)]) + (if (pred elt) + (values (if (pair? out) (cons elt in) lis) out) + (values in (if (pair? in) (cons elt out) lis)))))))) ;; This implementation of PARTITION! ;; - doesn't cons, and uses no stack; diff --git a/collects/srfi/1/fold.ss b/collects/srfi/1/fold.ss index 8baa201e3f..3da042ec11 100644 --- a/collects/srfi/1/fold.ss +++ b/collects/srfi/1/fold.ss @@ -37,8 +37,7 @@ (require srfi/optional "predicate.ss" "selector.ss" - "util.ss" - srfi/8/receive) + "util.ss") (provide (rename my-map map) (rename my-for-each for-each) @@ -88,9 +87,9 @@ (check-arg procedure? kons 'fold) (if (pair? lists) (let lp ((lists (cons lis1 lists)) (ans knil)) ; N-ary case - (receive (cars+ans cdrs) (%cars+cdrs+ lists ans) - (if (null? cars+ans) ans ; Done. - (lp cdrs (apply kons cars+ans))))) + (let-values ([(cars+ans cdrs) (%cars+cdrs+ lists ans)]) + (if (null? cars+ans) ans ; Done. + (lp cdrs (apply kons cars+ans))))) (let lp ((lis lis1) (ans knil)) ; Fast path (if (null-list? lis) ans (lp (cdr lis) (kons (car lis) ans)))))) @@ -158,13 +157,13 @@ (define (really-append-map who appender f lis1 lists) (check-arg procedure? f 'who) (if (pair? lists) - (receive (cars cdrs) (%cars+cdrs (cons lis1 lists)) - (if (null? cars) '() - (let recur ((cars cars) (cdrs cdrs)) - (let ((vals (apply f cars))) - (receive (cars2 cdrs2) (%cars+cdrs cdrs) - (if (null? cars2) vals - (appender vals (recur cars2 cdrs2)))))))) + (let-values ([(cars cdrs) (%cars+cdrs (cons lis1 lists))]) + (if (null? cars) '() + (let recur ((cars cars) (cdrs cdrs)) + (let ((vals (apply f cars))) + (let-values ([(cars2 cdrs2) (%cars+cdrs cdrs)]) + (if (null? cars2) vals + (appender vals (recur cars2 cdrs2)))))))) ;; Fast path (if (null-list? lis1) '() (let recur ((elt (car lis1)) (rest (cdr lis1))) @@ -194,9 +193,9 @@ (if (pair? lists) (let lp ((lis1 lis1) (lists lists)) (if (not (null-list? lis1)) - (receive (heads tails) (%cars+cdrs/no-test lists) - (set-car! lis1 (apply f (car lis1) heads)) - (lp (cdr lis1) tails)))) + (let-values ([(heads tails) (%cars+cdrs/no-test lists)]) + (set-car! lis1 (apply f (car lis1) heads)) + (lp (cdr lis1) tails)))) ;; Fast path. (pair-for-each (lambda (pair) (set-car! pair (f (car pair)))) lis1)) lis1) @@ -206,11 +205,11 @@ (check-arg procedure? f 'filter-map) (if (pair? lists) (let recur ((lists (cons lis1 lists))) - (receive (cars cdrs) (%cars+cdrs lists) - (if (pair? cars) - (cond ((apply f cars) => (lambda (x) (cons x (recur cdrs)))) - (else (recur cdrs))) ; Tail call in this arm. - '()))) + (let-values ([(cars cdrs) (%cars+cdrs lists)]) + (if (pair? cars) + (cond ((apply f cars) => (lambda (x) (cons x (recur cdrs)))) + (else (recur cdrs))) ; Tail call in this arm. + '()))) ;; Fast path. (let recur ((lis lis1)) (if (null-list? lis) lis @@ -226,11 +225,11 @@ (check-arg procedure? f 'map-in-order) (if (pair? lists) (let recur ((lists (cons lis1 lists))) - (receive (cars cdrs) (%cars+cdrs lists) - (if (pair? cars) - (let ((x (apply f cars))) ; Do head first, - (cons x (recur cdrs))) ; then tail. - '()))) + (let-values ([(cars cdrs) (%cars+cdrs lists)]) + (if (pair? cars) + (let ((x (apply f cars))) ; Do head first, + (cons x (recur cdrs))) ; then tail. + '()))) ;; Fast path. (let recur ((lis lis1)) (if (null-list? lis) lis @@ -250,11 +249,11 @@ (check-arg procedure? f for-each) (if (pair? lists) (let recur ((lists (cons lis1 lists))) - (receive (cars cdrs) (%cars+cdrs lists) - (if (pair? cars) - (begin - (apply f cars) ; Do head first, - (recur cdrs))))) ; then tail. + (let-values ([(cars cdrs) (%cars+cdrs lists)]) + (if (pair? cars) + (begin + (apply f cars) ; Do head first, + (recur cdrs))))) ; then tail. ;; Fast path. (let recur ((lis lis1)) (if (not (null-list? lis)) diff --git a/collects/srfi/1/lset.ss b/collects/srfi/1/lset.ss index 32ad141591..5510ffe6b2 100644 --- a/collects/srfi/1/lset.ss +++ b/collects/srfi/1/lset.ss @@ -40,8 +40,7 @@ (rename "search.ss" s:member member) "delete.ss" "predicate.ss" - "filter.ss" - srfi/8/receive) + "filter.ss") (provide lset<= lset= @@ -178,7 +177,7 @@ ;; built in. ;; Compute a-b and a^b, then compute b-(a^b) and ;; cons it onto the front of a-b. - (receive (a-b a-int-b) (lset-diff+intersection = a b) + (let-values ([(a-b a-int-b) (lset-diff+intersection = a b)]) (cond ((null? a-b) (lset-difference = b a)) ((null? a-int-b) (append b a)) (else (fold (lambda (xb ans) @@ -199,7 +198,7 @@ ;; built in. ;; Compute a-b and a^b, then compute b-(a^b) and ;; cons it onto the front of a-b. - (receive (a-b a-int-b) (lset-diff+intersection! = a b) + (let-values ([(a-b a-int-b) (lset-diff+intersection! = a b)]) (cond ((null? a-b) (lset-difference! = b a)) ((null? a-int-b) (append! b a)) (else (pair-fold diff --git a/collects/srfi/1/misc.ss b/collects/srfi/1/misc.ss index 1d258844c0..ae829ae5aa 100644 --- a/collects/srfi/1/misc.ss +++ b/collects/srfi/1/misc.ss @@ -39,8 +39,7 @@ "selector.ss" "util.ss" (only "fold.ss" reduce-right) - (rename "fold.ss" srfi-1:map map) - srfi/8/receive) + (rename "fold.ss" srfi-1:map map)) (provide length+ concatenate @@ -65,10 +64,10 @@ ;; N-ary case (let lp ((list1 list1) (lists lists) (i 0)) (if (null-list? list1) i - (receive (as ds) (%cars+cdrs lists) - (if (null? as) i - (lp (cdr list1) ds - (if (apply pred (car list1) as) (+ i 1) i)))))) + (let-values ([(as ds) (%cars+cdrs lists)]) + (if (null? as) i + (lp (cdr list1) ds + (if (apply pred (car list1) as) (+ i 1) i)))))) ;; Fast path (let lp ((lis list1) (i 0)) (if (null-list? lis) i @@ -98,39 +97,39 @@ (let recur ((lis lis)) (if (null-list? lis) (values lis lis) ; Use NOT-PAIR? to handle (let ((elt (car lis))) ; dotted lists. - (receive (a b) (recur (cdr lis)) - (values (cons (car elt) a) - (cons (cadr elt) b))))))) + (let-values ([(a b) (recur (cdr lis))]) + (values (cons (car elt) a) + (cons (cadr elt) b))))))) (define (unzip3 lis) (let recur ((lis lis)) (if (null-list? lis) (values lis lis lis) (let ((elt (car lis))) - (receive (a b c) (recur (cdr lis)) - (values (cons (car elt) a) - (cons (cadr elt) b) - (cons (caddr elt) c))))))) + (let-values ([(a b c) (recur (cdr lis))]) + (values (cons (car elt) a) + (cons (cadr elt) b) + (cons (caddr elt) c))))))) (define (unzip4 lis) (let recur ((lis lis)) (if (null-list? lis) (values lis lis lis lis) (let ((elt (car lis))) - (receive (a b c d) (recur (cdr lis)) - (values (cons (car elt) a) - (cons (cadr elt) b) - (cons (caddr elt) c) - (cons (cadddr elt) d))))))) + (let-values ([(a b c d) (recur (cdr lis))]) + (values (cons (car elt) a) + (cons (cadr elt) b) + (cons (caddr elt) c) + (cons (cadddr elt) d))))))) (define (unzip5 lis) (let recur ((lis lis)) (if (null-list? lis) (values lis lis lis lis lis) (let ((elt (car lis))) - (receive (a b c d e) (recur (cdr lis)) - (values (cons (car elt) a) - (cons (cadr elt) b) - (cons (caddr elt) c) - (cons (cadddr elt) d) - (cons (car (cddddr elt)) e))))))) + (let-values ([(a b c d e) (recur (cdr lis))]) + (values (cons (car elt) a) + (cons (cadr elt) b) + (cons (caddr elt) c) + (cons (cadddr elt) d) + (cons (car (cddddr elt)) e))))))) ;; append! append-reverse append-reverse! concatenate concatenate! ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; diff --git a/collects/srfi/1/search.ss b/collects/srfi/1/search.ss index 25e6ff6e6a..5fdc0a2c42 100644 --- a/collects/srfi/1/search.ss +++ b/collects/srfi/1/search.ss @@ -37,8 +37,7 @@ (require mzlib/etc srfi/optional "predicate.ss" - "util.ss" - srfi/8/receive) + "util.ss") (provide (rename my-member member) find @@ -107,8 +106,8 @@ (if (null-list? lis) (values '() '()) (let ((x (car lis))) (if (pred x) - (receive (prefix suffix) (recur (cdr lis)) - (values (cons x prefix) suffix)) + (let-values ([(prefix suffix) (recur (cdr lis))]) + (values (cons x prefix) suffix)) (values '() lis)))))) #; @@ -131,13 +130,13 @@ (check-arg procedure? pred 'any) (if (pair? lists) ;; N-ary case - (receive (heads tails) (%cars+cdrs (cons lis1 lists)) + (let-values ([(heads tails) (%cars+cdrs (cons lis1 lists))]) (and (pair? heads) (let lp ((heads heads) (tails tails)) - (receive (next-heads next-tails) (%cars+cdrs tails) - (if (pair? next-heads) - (or (apply pred heads) (lp next-heads next-tails)) - (apply pred heads)))))) ; Last PRED app is tail call. + (let-values ([(next-heads next-tails) (%cars+cdrs tails)]) + (if (pair? next-heads) + (or (apply pred heads) (lp next-heads next-tails)) + (apply pred heads)))))) ; Last PRED app is tail call. ;; Fast path (and (not (null-list? lis1)) (let lp ((head (car lis1)) (tail (cdr lis1))) @@ -155,13 +154,13 @@ (check-arg procedure? pred 'every) (if (pair? lists) ;; N-ary case - (receive (heads tails) (%cars+cdrs (cons lis1 lists)) + (let-values ([(heads tails) (%cars+cdrs (cons lis1 lists))]) (or (not (pair? heads)) (let lp ((heads heads) (tails tails)) - (receive (next-heads next-tails) (%cars+cdrs tails) - (if (pair? next-heads) - (and (apply pred heads) (lp next-heads next-tails)) - (apply pred heads)))))) ; Last PRED app is tail call. + (let-values ([(next-heads next-tails) (%cars+cdrs tails)]) + (if (pair? next-heads) + (and (apply pred heads) (lp next-heads next-tails)) + (apply pred heads)))))) ; Last PRED app is tail call. ;; Fast path (or (null-list? lis1) (let lp ((head (car lis1)) (tail (cdr lis1))) @@ -174,7 +173,7 @@ (if (pair? lists) ;; N-ary case (let lp ((lists (cons lis1 lists)) (n 0)) - (receive (heads tails) (%cars+cdrs lists) + (let-values ([(heads tails) (%cars+cdrs lists)]) (and (pair? heads) (if (apply pred heads) n (lp tails (+ n 1)))))) diff --git a/collects/srfi/1/selector.ss b/collects/srfi/1/selector.ss index 3e57b06980..9c261c6aec 100644 --- a/collects/srfi/1/selector.ss +++ b/collects/srfi/1/selector.ss @@ -34,8 +34,7 @@ #lang mzscheme -(require srfi/optional - srfi/8/receive) +(require srfi/optional) (provide first second third fourth @@ -120,8 +119,8 @@ (check-arg integer? k 'split-at) (let recur ((lis x) (k k)) (if (zero? k) (values '() lis) - (receive (prefix suffix) (recur (cdr lis) (- k 1)) - (values (cons (car lis) prefix) suffix))))) + (let-values ([(prefix suffix) (recur (cdr lis) (- k 1))]) + (values (cons (car lis) prefix) suffix))))) #; (define (split-at! x k) diff --git a/collects/srfi/1/util.ss b/collects/srfi/1/util.ss index 704a30f871..3ce028295b 100644 --- a/collects/srfi/1/util.ss +++ b/collects/srfi/1/util.ss @@ -36,8 +36,7 @@ (require srfi/optional "predicate.ss" - "selector.ss" - srfi/8/receive) + "selector.ss") (provide %cdrs %cars+ @@ -88,11 +87,11 @@ (lambda (abort) (let recur ((lists lists)) (if (pair? lists) - (receive (list other-lists) (car+cdr lists) + (let-values ([(list other-lists) (car+cdr lists)]) (if (null-list? list) (abort '() '()) ; LIST is empty -- bail out - (receive (a d) (car+cdr list) - (receive (cars cdrs) (recur other-lists) - (values (cons a cars) (cons d cdrs)))))) + (let-values ([(a d) (car+cdr list)] + [(cars cdrs) (recur other-lists)]) + (values (cons a cars) (cons d cdrs))))) (values '() '())))))) ;; Like %CARS+CDRS, but we pass in a final elt tacked onto the end of the @@ -102,21 +101,21 @@ (lambda (abort) (let recur ((lists lists)) (if (pair? lists) - (receive (list other-lists) (car+cdr lists) - (if (null-list? list) (abort '() '()) ; LIST is empty -- bail out - (receive (a d) (car+cdr list) - (receive (cars cdrs) (recur other-lists) - (values (cons a cars) (cons d cdrs)))))) + (let-values ([(list other-lists) (car+cdr lists)]) + (if (null-list? list) (abort '() '()) ; LIST is empty -- bail out + (let-values ([(a d) (car+cdr list)] + [(cars cdrs) (recur other-lists)]) + (values (cons a cars) (cons d cdrs))))) (values (list cars-final) '())))))) ;; Like %CARS+CDRS, but blow up if any list is empty. (define (%cars+cdrs/no-test lists) (let recur ((lists lists)) (if (pair? lists) - (receive (list other-lists) (car+cdr lists) - (receive (a d) (car+cdr list) - (receive (cars cdrs) (recur other-lists) - (values (cons a cars) (cons d cdrs))))) + (let*-values ([(list other-lists) (car+cdr lists)] + [(a d) (car+cdr list)] + [(cars cdrs) (recur other-lists)]) + (values (cons a cars) (cons d cdrs))) (values '() '())))) ;;; util.ss ends here