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