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

some reformatting

Browse Source 
svn: r15592
This commit is contained in:
Eli Barzilay 2009-07-28 05:05:17 +00:00
parent 07503f5c35
commit af5614455a
1 changed files with 24 additions and 23 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -650,7 +650,7 @@
post-cont?s post-cont?s
poses poses
vals)))))))) vals))))))))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; running sequences outside of a loop: ;; running sequences outside of a loop:
@ -709,10 +709,10 @@
[sequence-next (lambda () (next))]) [sequence-next (lambda () (next))])
(values sequence-more? (values sequence-more?
sequence-next))))))) sequence-next)))))))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; core `for/fold' syntax ;; core `for/fold' syntax
(define-syntax values* (define-syntax values*
(syntax-rules () (syntax-rules ()
[(_ x) x] [(_ x) x]
@ -721,11 +721,13 @@
(define-syntax (for/foldX/derived stx) (define-syntax (for/foldX/derived stx)
(syntax-case stx () (syntax-case stx ()
;; Done case (no more clauses, and no generated clauses to emit): ;; Done case (no more clauses, and no generated clauses to emit):
[(_ [orig-stx nested? emit? ()] ([fold-var fold-init] ...) () expr1 expr ...) [(_ [orig-stx nested? emit? ()] ([fold-var fold-init] ...) ()
expr1 expr ...)
#`(let ([fold-var fold-init] ...) (let () expr1 expr ...))] #`(let ([fold-var fold-init] ...) (let () expr1 expr ...))]
;; Switch-to-emit case (no more clauses to generate): ;; Switch-to-emit case (no more clauses to generate):
[(_ [orig-stx nested? #f binds] ([fold-var fold-init] ...) () . body) [(_ [orig-stx nested? #f binds] ([fold-var fold-init] ...) () . body)
#`(for/foldX/derived [orig-stx nested? #t binds] ([fold-var fold-init] ...) () . body)] #`(for/foldX/derived [orig-stx nested? #t binds]
([fold-var fold-init] ...) () . body)]
;; Emit case: ;; Emit case:
[(_ [orig-stx nested? #t binds] ([fold-var fold-init] ...) rest expr1 . body) [(_ [orig-stx nested? #t binds] ([fold-var fold-init] ...) rest expr1 . body)
(with-syntax ([(([outer-binding ...] (with-syntax ([(([outer-binding ...]
@ -753,38 +755,37 @@
;; Bad body cases: ;; Bad body cases:
[(_ [orig-stx . _] fold-bind ()) [(_ [orig-stx . _] fold-bind ())
(raise-syntax-error (raise-syntax-error
#f #f "missing body expression after sequence bindings" #'orig-stx)]
"missing body expression after sequence bindings"
#'orig-stx)]
[(_ [orig-stx . _] fold-bind () . rest) [(_ [orig-stx . _] fold-bind () . rest)
(raise-syntax-error (raise-syntax-error
#f #f "bad syntax (illegal use of `.') after sequence bindings" #'orig-stx)]
"bad syntax (illegal use of `.') after sequence bindings"
#'orig-stx)]
;; Guard case, no pending emits: ;; Guard case, no pending emits:
[(_ [orig-stx nested? #f ()] ([fold-var fold-init] ...) (#:when expr . rest) . body) [(_ [orig-stx nested? #f ()] ([fold-var fold-init] ...) (#:when expr . rest) . body)
#'(let ([fold-var fold-init] ...) #'(let ([fold-var fold-init] ...)
(if expr (if expr
(for/foldX/derived [orig-stx nested? #f ()] ([fold-var fold-var] ...) rest . body) (for/foldX/derived [orig-stx nested? #f ()]
(values* fold-var ...)))] ([fold-var fold-var] ...) rest . body)
(values* fold-var ...)))]
;; Guard case, pending emits need to be flushed first ;; Guard case, pending emits need to be flushed first
[(frm [orig-stx nested? #f binds] ([fold-var fold-init] ...) (#:when expr . rest) . body) [(frm [orig-stx nested? #f binds] ([fold-var fold-init] ...)
#'(frm [orig-stx nested? #t binds] ([fold-var fold-init] ...) (#:when expr . rest) . body)] (#:when expr . rest) . body)
#'(frm [orig-stx nested? #t binds] ([fold-var fold-init] ...)
(#:when expr . rest) . body)]
;; Convert single-value form to multi-value form: ;; Convert single-value form to multi-value form:
[(_ [orig-stx nested? #f binds] fold-bind ([id rhs] . rest) . body) [(_ [orig-stx nested? #f binds] fold-bind ([id rhs] . rest) . body)
(identifier? #'id) (identifier? #'id)
#'(for/foldX/derived [orig-stx nested? #f binds] fold-bind ([(id) rhs] . rest) . body)] #'(for/foldX/derived [orig-stx nested? #f binds] fold-bind
([(id) rhs] . rest) . body)]
;; If we get here in single-value mode, then it's a bad clause: ;; If we get here in single-value mode, then it's a bad clause:
[(_ [orig-stx #f #f nested? #f binds] fold-bind (clause . rest) . body) [(_ [orig-stx #f #f nested? #f binds] fold-bind (clause . rest) . body)
(raise-syntax-error (raise-syntax-error
#f #f "bad sequence binding clause" #'orig-stx #'clause)]
"bad sequence binding clause" ;; Expand one multi-value clause, and push it into the results to emit:
#'orig-stx [(frm [orig-stx nested? #f binds] ([fold-var fold-init] ...)
#'clause)] (clause . rest) . body)
;; Expand one multi-value clause, and push it into the results to emit:
[(frm [orig-stx nested? #f binds] ([fold-var fold-init] ...) (clause . rest) . body)
(with-syntax ([bind (expand-clause #'orig-stx #'clause)]) (with-syntax ([bind (expand-clause #'orig-stx #'clause)])
#`(frm [orig-stx nested? nested? (bind . binds)] ([fold-var fold-init] ...) rest . body))] #`(frm [orig-stx nested? nested? (bind . binds)]
([fold-var fold-init] ...) rest . body))]
[(_ [orig-stx . _] . _) [(_ [orig-stx . _] . _)
(raise-syntax-error #f "bad syntax" #'orig-stx)])) (raise-syntax-error #f "bad syntax" #'orig-stx)]))