suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

use void for true predicates, makes things run faster

Browse Source 
svn: r14451
This commit is contained in:
Eli Barzilay 2009-04-08 00:02:57 +00:00
parent e29ebde466
commit 4aab5e4eab
1 changed files with 47 additions and 64 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

111
collects/scheme/private/for.ss
View File

@ -358,8 +358,8 @@
(if (step . >= . 0) (if (step . >= . 0)
(lambda (x) (< x b)) (lambda (x) (< x b))
(lambda (x) (> x b))) (lambda (x) (> x b)))
(lambda (x) #t) void
(lambda (x y) #t))))])) void)))]))
(define in-naturals (define in-naturals
(case-lambda (case-lambda
@ -371,20 +371,14 @@
(raise-type-error 'in-naturals (raise-type-error 'in-naturals
"exact non-negative integer" "exact non-negative integer"
n)) n))
(make-do-sequence (lambda () (make-do-sequence (lambda () (values values add1 n void void void)))]))
(values values
add1
n
(lambda (x) #t)
(lambda (x) #t)
(lambda (x y) #t))))]))
(define (in-list l) (define (in-list l)
; (unless (list? l) (raise-type-error 'in-list "list" l)) ; (unless (list? l) (raise-type-error 'in-list "list" l))
(make-do-sequence (lambda () (:list-gen l)))) (make-do-sequence (lambda () (:list-gen l))))
(define (: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) (define (check-ranges who start stop step)
@ -425,8 +419,8 @@
(if (> step 0) (if (> step 0)
(lambda (i) (< i stop)) (lambda (i) (< i stop))
(lambda (i) (> i stop))) (lambda (i) (> i stop)))
(lambda (x) #t) void
(lambda (x y) #t))) void))
(define in-string (define in-string
(case-lambda (case-lambda
@ -440,13 +434,12 @@
(make-do-sequence (lambda () (:string-gen l start stop step))))])) (make-do-sequence (lambda () (:string-gen l start stop step))))]))
(define (:string-gen v start stop step) (define (:string-gen v start stop step)
(values (lambda (i) (values (lambda (i) (string-ref v i))
(string-ref v i))
(if (= step 1) add1 (lambda (x) (+ x step))) (if (= step 1) add1 (lambda (x) (+ x step)))
start start
(lambda (i) (< i stop)) (lambda (i) (< i stop))
(lambda (x) #t) void
(lambda (x y) #t))) void))
(define in-bytes (define in-bytes
(case-lambda (case-lambda
@ -460,36 +453,35 @@
(make-do-sequence (lambda () (:bytes-gen l start stop step))))])) (make-do-sequence (lambda () (:bytes-gen l start stop step))))]))
(define (:bytes-gen v start stop step) (define (:bytes-gen v start stop step)
(values (lambda (i) (values (lambda (i) (bytes-ref v i))
(bytes-ref v i))
(if (= step 1) add1 (lambda (x) (+ x step))) (if (= step 1) add1 (lambda (x) (+ x step)))
start start
(lambda (i) (< i stop)) (lambda (i) (< i stop))
(lambda (x) #t) void
(lambda (x y) #t))) void))
(define (in-input-port-bytes l) (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)))) (make-do-sequence (lambda () (:input-port-gen l))))
(define (:input-port-gen v) (define (:input-port-gen v)
(values (lambda (v) (read-byte v)) (values read-byte
(lambda (v) v) values
v v
(lambda (v) #t) void
(lambda (x) (not (eof-object? x))) (lambda (x) (not (eof-object? x)))
(lambda (x v) #t))) void))
(define (in-input-port-chars v) (define (in-input-port-chars v)
(unless (input-port? v) (raise-type-error 'in-input-port-chars "input-port" v)) (unless (input-port? v)
(make-do-sequence (lambda () (raise-type-error 'in-input-port-chars "input-port" v))
(values (lambda (v) (read-char v)) (make-do-sequence
(lambda (v) v) (lambda ()
v (values read-char values v void
(lambda (v) #t) (lambda (x) (not (eof-object? x)))
(lambda (x) (not (eof-object? x))) void))))
(lambda (x v) #t)))))
(define in-lines (define in-lines
(case-lambda (case-lambda
[() (in-lines (current-input-port))] [() (in-lines (current-input-port))]
@ -500,50 +492,41 @@
(raise-type-error 'in-lines "'linefeed, 'return, 'return-linefeed, 'any, or 'any-one)" mode)) (raise-type-error 'in-lines "'linefeed, 'return, 'return-linefeed, 'any, or 'any-one)" mode))
(make-do-sequence (lambda () (make-do-sequence (lambda ()
(values (lambda (v) (read-line v mode)) (values (lambda (v) (read-line v mode))
(lambda (v) v) values
v v
(lambda (v) #t) void
(lambda (x) (not (eof-object? x))) (lambda (x) (not (eof-object? x)))
(lambda (x v) #t))))])) void)))]))
(define (in-hash ht) (define (in-hash ht)
(unless (hash? ht) (raise-type-error 'in-hash "hash" ht)) (unless (hash? ht) (raise-type-error 'in-hash "hash" ht))
(make-do-sequence (lambda () (:hash-key+val-gen ht)))) (make-do-sequence (lambda () (:hash-key+val-gen ht))))
(define (:hash-key+val-gen ht) (define (:hash-key+val-gen ht)
(:hash-gen ht (lambda (ht pos) (:hash-gen ht (lambda (ht pos)
(values (values (hash-iterate-key ht pos)
(hash-iterate-key ht pos) (hash-iterate-value ht pos)))))
(hash-iterate-value ht pos)))
(lambda (k v) #t)
(lambda (p k v) #t)))
(define (in-hash-keys ht) (define (in-hash-keys ht)
(unless (hash? ht) (raise-type-error 'in-hash-keys "hash" ht)) (unless (hash? ht) (raise-type-error 'in-hash-keys "hash" ht))
(make-do-sequence (lambda () (:hash-gen ht hash-iterate-key (make-do-sequence (lambda () (:hash-gen ht hash-iterate-key))))
(lambda (k) #t)
(lambda (p k) #t)))))
(define (in-hash-values ht) (define (in-hash-values ht)
(unless (hash? ht) (raise-type-error 'in-hash-values "hash" ht)) (unless (hash? ht) (raise-type-error 'in-hash-values "hash" ht))
(make-do-sequence (lambda () (:hash-gen ht hash-iterate-value (make-do-sequence (lambda () (:hash-gen ht hash-iterate-value))))
(lambda (v) #t)
(lambda (p v) #t)))))
(define (in-hash-pairs ht) (define (in-hash-pairs ht)
(unless (hash? ht) (raise-type-error 'in-hash-values "hash" ht)) (unless (hash? ht) (raise-type-error 'in-hash-values "hash" ht))
(make-do-sequence (lambda () (:hash-gen ht (lambda (ht pos) (make-do-sequence (lambda ()
(cons (:hash-gen ht (lambda (ht pos)
(hash-iterate-key ht pos) (cons (hash-iterate-key ht pos)
(hash-iterate-value ht pos))) (hash-iterate-value ht pos)))))))
(lambda (k+v) #t)
(lambda (p k+v) #t)))))
(define (:hash-gen ht sel val-true pos+val-true) (define (:hash-gen ht sel)
(values (lambda (pos) (sel ht pos)) (values (lambda (pos) (sel ht pos))
(lambda (pos) (hash-iterate-next ht pos)) (lambda (pos) (hash-iterate-next ht pos))
(hash-iterate-first ht) (hash-iterate-first ht)
(lambda (pos) pos) ; #f position means stop (lambda (pos) pos) ; #f position means stop
val-true void
pos+val-true)) void))
(define (stop-before g pred) (define (stop-before g pred)
(unless (sequence? g) (raise-type-error 'stop-before "sequence" g)) (unless (sequence? g) (raise-type-error 'stop-before "sequence" g))
@ -601,8 +584,8 @@
(lambda (pos) #f) (lambda (pos) #f)
#t #t
(lambda (pos) pos) (lambda (pos) pos)
(lambda (val) #t) void
(lambda (pos val) #t))))) void))))
;; ---------------------------------------- ;; ----------------------------------------
@ -622,9 +605,9 @@
(seqs->m+g+r (cddr m+g+r)) (seqs->m+g+r (cddr m+g+r))
m+g+r)) m+g+r))
(seqs->m+g+r sequences) (seqs->m+g+r sequences)
(lambda (p) p) values
(lambda _ #t) void
(lambda _ #t))))) void))))
(define (check-sequences who sequences) (define (check-sequences who sequences)
(for-each (lambda (g) (for-each (lambda (g)