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

Minor reformatting, indentation fixes, brackets fixes, etc.

Browse Source
This commit is contained in:
Eli Barzilay 2011-09-08 05:43:47 -04:00
parent 7a00fbddc7
commit 29019a42ae
1 changed files with 475 additions and 482 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

65
collects/racket/private/for.rkt
View File

@ -313,7 +313,6 @@
(raise-syntax-error #f (raise-syntax-error #f
"illegal outside of a loop or comprehension binding" stx)) "illegal outside of a loop or comprehension binding" stx))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; streams & sequences ;; streams & sequences
@ -402,8 +401,7 @@
v)))) v))))
(define (unsafe-stream-first v) (define (unsafe-stream-first v)
(cond (cond [(pair? v) (car v)]
[(pair? v) (car v)]
[else ((unsafe-vector-ref (stream-ref v) 1) v)])) [else ((unsafe-vector-ref (stream-ref v) 1) v)]))
(define (stream-first v) (define (stream-first v)
@ -415,8 +413,7 @@
v))) v)))
(define (unsafe-stream-rest v) (define (unsafe-stream-rest v)
(cond (cond [(pair? v) (cdr v)]
[(pair? v) (cdr v)]
[else (let ([r ((unsafe-vector-ref (stream-ref v) 2) v)]) [else (let ([r ((unsafe-vector-ref (stream-ref v) 2) v)])
(unless (stream? r) (unless (stream? r)
(raise-mismatch-error 'stream-rest-guard (raise-mismatch-error 'stream-rest-guard
@ -778,8 +775,8 @@
;; start*, stop*, and step* are guaranteed to be exact integers ;; start*, stop*, and step* are guaranteed to be exact integers
([(v* start* stop* step*) ([(v* start* stop* step*)
(normalise-inputs (quote in-vector-name) type-name (normalise-inputs (quote in-vector-name) type-name
;; reverse-eta triggers JIT inlining of primitives, ;; reverse-eta triggers JIT inlining of
;; which is good for futures: ;; primitives, which is good for futures:
(lambda (x) (vector? x)) (lambda (x) (vector? x))
(lambda (x) (unsafe-vector-length x)) (lambda (x) (unsafe-vector-length x))
vec-expr start stop step)]) vec-expr start stop step)])
@ -810,7 +807,6 @@
[_ #f]))) [_ #f])))
in-vector-like) in-vector-like)
(define-:vector-like-gen :vector-gen unsafe-vector-ref) (define-:vector-like-gen :vector-gen unsafe-vector-ref)
(define-in-vector-like in-vector (define-in-vector-like in-vector
@ -825,7 +821,6 @@
#'in-vector #'in-vector
#'unsafe-vector-ref)) #'unsafe-vector-ref))
(define-:vector-like-gen :string-gen string-ref) (define-:vector-like-gen :string-gen string-ref)
(define-in-vector-like in-string (define-in-vector-like in-string
@ -840,7 +835,6 @@
#'in-string #'in-string
#'string-ref)) #'string-ref))
(define-:vector-like-gen :bytes-gen unsafe-bytes-ref) (define-:vector-like-gen :bytes-gen unsafe-bytes-ref)
(define-in-vector-like in-bytes (define-in-vector-like in-bytes
@ -855,10 +849,8 @@
#'in-bytes #'in-bytes
#'bytes-ref)) #'bytes-ref))
;; ------------------------------------------------------------------------ ;; ------------------------------------------------------------------------
(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))
(unless (and (procedure? pred) (unless (and (procedure? pred)
@ -1102,7 +1094,6 @@
(raise (exn:fail:contract "sequence has no more values" (raise (exn:fail:contract "sequence has no more values"
(current-continuation-marks)))) (current-continuation-marks))))
(define (sequence-generate g) (define (sequence-generate g)
(unless (sequence? g) (unless (sequence? g)
(raise-type-error 'sequence-generate "sequence" g)) (raise-type-error 'sequence-generate "sequence" g))
@ -1219,7 +1210,9 @@
(let-values (inner-binding ... ...) (let-values (inner-binding ... ...)
(if (and pre-guard ...) (if (and pre-guard ...)
(let-values ([(fold-var ...) (let-values ([(fold-var ...)
(for/foldX/derived [orig-stx nested? #f ()] ([fold-var fold-var] ...) rest expr1 . body)]) (for/foldX/derived [orig-stx nested? #f ()]
([fold-var fold-var] ...)
rest expr1 . body)])
(if (and post-guard ...) (if (and post-guard ...)
(for-loop fold-var ... loop-arg ... ...) (for-loop fold-var ... loop-arg ... ...)
(values* fold-var ...))) (values* fold-var ...)))
@ -1297,7 +1290,8 @@
(syntax-case stx () (syntax-case stx ()
;; When there's a bindings clause... ;; When there's a bindings clause...
[(_ (bind ...) expr1 expr ...) [(_ (bind ...) expr1 expr ...)
(with-syntax ([(bind ...) (let loop ([bs (syntax->list #'(bind ...))]) (with-syntax ([(bind ...)
(let loop ([bs (syntax->list #'(bind ...))])
(if (null? bs) (if (null? bs)
null null
(syntax-case (car bs) () (syntax-case (car bs) ()
@ -1311,12 +1305,13 @@
null null
(cons (cadr bs) (loop (cddr bs)))))] (cons (cadr bs) (loop (cddr bs)))))]
[_ [_
;; a syntax error; let the /derived form handle it, and ;; a syntax error; let the /derived form
;; no need to wrap any more: ;; handle it, and no need to wrap any more:
bs])))]) bs])))])
(quasisyntax/loc stx (quasisyntax/loc stx
#,(wrap (quasisyntax/loc stx #,(wrap (quasisyntax/loc stx
(derived-id #,stx fold-bind (bind ...) #,(combine #'(let () expr1 expr ...)))))))] (derived-id #,stx fold-bind (bind ...)
#,(combine #'(let () expr1 expr ...)))))))]
;; Let `derived-id' complain about the missing bindings and body expression: ;; Let `derived-id' complain about the missing bindings and body expression:
[(_ . rest) [(_ . rest)
#`(derived-id #,stx fold-bind . rest)]))) #`(derived-id #,stx fold-bind . rest)])))
@ -1355,41 +1350,39 @@
(define-syntax (for/vector stx) (define-syntax (for/vector stx)
(syntax-case stx () (syntax-case stx ()
((for/vector (for-clause ...) body ...) [(for/vector (for-clause ...) body ...)
(syntax/loc stx (syntax/loc stx
(list->vector (list->vector
(for/list (for-clause ...) body ...)))) (for/list (for-clause ...) body ...)))]
((for/vector #:length length-expr (for-clause ...) body ...) [(for/vector #:length length-expr (for-clause ...) body ...)
(syntax/loc stx (syntax/loc stx
(let ((len length-expr)) (let ([len length-expr])
(unless (exact-nonnegative-integer? len) (unless (exact-nonnegative-integer? len)
(raise-type-error 'for/vector "exact nonnegative integer" len)) (raise-type-error 'for/vector "exact nonnegative integer" len))
(let ((v (make-vector len))) (let ([v (make-vector len)])
(for/fold ((i 0)) (for/fold ([i 0])
(for-clause ... (for-clause ... #:when (< i len))
#:when (< i len))
(vector-set! v i (begin body ...)) (vector-set! v i (begin body ...))
(add1 i)) (add1 i))
v)))))) v)))]))
(define-syntax (for*/vector stx) (define-syntax (for*/vector stx)
(syntax-case stx () (syntax-case stx ()
((for*/vector (for-clause ...) body ...) [(for*/vector (for-clause ...) body ...)
(syntax/loc stx (syntax/loc stx
(list->vector (list->vector
(for*/list (for-clause ...) body ...)))) (for*/list (for-clause ...) body ...)))]
((for*/vector #:length length-expr (for-clause ...) body ...) [(for*/vector #:length length-expr (for-clause ...) body ...)
(syntax/loc stx (syntax/loc stx
(let ((len length-expr)) (let ([len length-expr])
(unless (exact-nonnegative-integer? len) (unless (exact-nonnegative-integer? len)
(raise-type-error 'for*/vector "exact nonnegative integer" len)) (raise-type-error 'for*/vector "exact nonnegative integer" len))
(let ((v (make-vector len))) (let ([v (make-vector len)])
(for*/fold ((i 0)) (for*/fold ([i 0])
(for-clause ... (for-clause ... #:when (< i len))
#:when (< i len))
(vector-set! v i (begin body ...)) (vector-set! v i (begin body ...))
(add1 i)) (add1 i))
v)))))) v)))]))
(define-for-syntax (do-for/lists for/fold-id stx) (define-for-syntax (do-for/lists for/fold-id stx)
(syntax-case stx () (syntax-case stx ()