From 4aab5e4eabdfce6c58b70d59e897462e5b8a74d6 Mon Sep 17 00:00:00 2001 From: Eli Barzilay Date: Wed, 8 Apr 2009 00:02:57 +0000 Subject: [PATCH] use void for true predicates, makes things run faster svn: r14451 --- collects/scheme/private/for.ss | 111 ++++++++++++++------------------- 1 file changed, 47 insertions(+), 64 deletions(-) diff --git a/collects/scheme/private/for.ss b/collects/scheme/private/for.ss index b88259b4a9..bd37fdb102 100644 --- a/collects/scheme/private/for.ss +++ b/collects/scheme/private/for.ss @@ -358,8 +358,8 @@ (if (step . >= . 0) (lambda (x) (< x b)) (lambda (x) (> x b))) - (lambda (x) #t) - (lambda (x y) #t))))])) + void + void)))])) (define in-naturals (case-lambda @@ -371,20 +371,14 @@ (raise-type-error 'in-naturals "exact non-negative integer" n)) - (make-do-sequence (lambda () - (values values - add1 - n - (lambda (x) #t) - (lambda (x) #t) - (lambda (x y) #t))))])) + (make-do-sequence (lambda () (values values add1 n void void void)))])) (define (in-list l) ; (unless (list? l) (raise-type-error 'in-list "list" l)) (make-do-sequence (lambda () (:list-gen l)))) (define (:list-gen l) - (values car cdr l pair? (lambda (x) #t) (lambda (p x) #t))) + (values car cdr l pair? void void)) (define (check-ranges who start stop step) @@ -425,8 +419,8 @@ (if (> step 0) (lambda (i) (< i stop)) (lambda (i) (> i stop))) - (lambda (x) #t) - (lambda (x y) #t))) + void + void)) (define in-string (case-lambda @@ -440,13 +434,12 @@ (make-do-sequence (lambda () (:string-gen l start stop step))))])) (define (:string-gen v start stop step) - (values (lambda (i) - (string-ref v i)) + (values (lambda (i) (string-ref v i)) (if (= step 1) add1 (lambda (x) (+ x step))) start (lambda (i) (< i stop)) - (lambda (x) #t) - (lambda (x y) #t))) + void + void)) (define in-bytes (case-lambda @@ -460,36 +453,35 @@ (make-do-sequence (lambda () (:bytes-gen l start stop step))))])) (define (:bytes-gen v start stop step) - (values (lambda (i) - (bytes-ref v i)) + (values (lambda (i) (bytes-ref v i)) (if (= step 1) add1 (lambda (x) (+ x step))) start (lambda (i) (< i stop)) - (lambda (x) #t) - (lambda (x y) #t))) - + void + void)) + (define (in-input-port-bytes l) - (unless (input-port? l) (raise-type-error 'in-input-port-bytes "input-port" l)) + (unless (input-port? l) + (raise-type-error 'in-input-port-bytes "input-port" l)) (make-do-sequence (lambda () (:input-port-gen l)))) (define (:input-port-gen v) - (values (lambda (v) (read-byte v)) - (lambda (v) v) + (values read-byte + values v - (lambda (v) #t) + void (lambda (x) (not (eof-object? x))) - (lambda (x v) #t))) + void)) (define (in-input-port-chars v) - (unless (input-port? v) (raise-type-error 'in-input-port-chars "input-port" v)) - (make-do-sequence (lambda () - (values (lambda (v) (read-char v)) - (lambda (v) v) - v - (lambda (v) #t) - (lambda (x) (not (eof-object? x))) - (lambda (x v) #t))))) - + (unless (input-port? v) + (raise-type-error 'in-input-port-chars "input-port" v)) + (make-do-sequence + (lambda () + (values read-char values v void + (lambda (x) (not (eof-object? x))) + void)))) + (define in-lines (case-lambda [() (in-lines (current-input-port))] @@ -500,50 +492,41 @@ (raise-type-error 'in-lines "'linefeed, 'return, 'return-linefeed, 'any, or 'any-one)" mode)) (make-do-sequence (lambda () (values (lambda (v) (read-line v mode)) - (lambda (v) v) + values v - (lambda (v) #t) + void (lambda (x) (not (eof-object? x))) - (lambda (x v) #t))))])) - + void)))])) + (define (in-hash ht) (unless (hash? ht) (raise-type-error 'in-hash "hash" ht)) (make-do-sequence (lambda () (:hash-key+val-gen ht)))) (define (:hash-key+val-gen ht) (:hash-gen ht (lambda (ht pos) - (values - (hash-iterate-key ht pos) - (hash-iterate-value ht pos))) - (lambda (k v) #t) - (lambda (p k v) #t))) + (values (hash-iterate-key ht pos) + (hash-iterate-value ht pos))))) (define (in-hash-keys ht) (unless (hash? ht) (raise-type-error 'in-hash-keys "hash" ht)) - (make-do-sequence (lambda () (:hash-gen ht hash-iterate-key - (lambda (k) #t) - (lambda (p k) #t))))) + (make-do-sequence (lambda () (:hash-gen ht hash-iterate-key)))) (define (in-hash-values ht) (unless (hash? ht) (raise-type-error 'in-hash-values "hash" ht)) - (make-do-sequence (lambda () (:hash-gen ht hash-iterate-value - (lambda (v) #t) - (lambda (p v) #t))))) + (make-do-sequence (lambda () (:hash-gen ht hash-iterate-value)))) (define (in-hash-pairs ht) (unless (hash? ht) (raise-type-error 'in-hash-values "hash" ht)) - (make-do-sequence (lambda () (:hash-gen ht (lambda (ht pos) - (cons - (hash-iterate-key ht pos) - (hash-iterate-value ht pos))) - (lambda (k+v) #t) - (lambda (p k+v) #t))))) + (make-do-sequence (lambda () + (:hash-gen ht (lambda (ht pos) + (cons (hash-iterate-key ht pos) + (hash-iterate-value ht pos))))))) - (define (:hash-gen ht sel val-true pos+val-true) + (define (:hash-gen ht sel) (values (lambda (pos) (sel ht pos)) (lambda (pos) (hash-iterate-next ht pos)) (hash-iterate-first ht) (lambda (pos) pos) ; #f position means stop - val-true - pos+val-true)) + void + void)) (define (stop-before g pred) (unless (sequence? g) (raise-type-error 'stop-before "sequence" g)) @@ -601,8 +584,8 @@ (lambda (pos) #f) #t (lambda (pos) pos) - (lambda (val) #t) - (lambda (pos val) #t))))) + void + void)))) ;; ---------------------------------------- @@ -622,9 +605,9 @@ (seqs->m+g+r (cddr m+g+r)) m+g+r)) (seqs->m+g+r sequences) - (lambda (p) p) - (lambda _ #t) - (lambda _ #t))))) + values + void + void)))) (define (check-sequences who sequences) (for-each (lambda (g)