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

source locations for 'for' loops in stack traces

Browse Source 
svn: r16545
This commit is contained in:
Matthew Flatt 2009-11-04 19:17:31 +00:00
parent f14f541ac4
commit 4edc044cb6
1 changed files with 14 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -746,20 +746,21 @@
pre-guard pre-guard
post-guard post-guard
[loop-arg ...]) ...) (reverse (syntax->list #'binds))]) [loop-arg ...]) ...) (reverse (syntax->list #'binds))])
#'(let-values (outer-binding ... ...) #`(let-values (outer-binding ... ...)
outer-check ... outer-check ...
(let for-loop ([fold-var fold-init] ... #,(syntax/loc #'orig-stx
loop-binding ... ...) (let for-loop ([fold-var fold-init] ...
(if (and pos-guard ...) loop-binding ... ...)
(let-values (inner-binding ... ...) (if (and pos-guard ...)
(if (and pre-guard ...) (let-values (inner-binding ... ...)
(let-values ([(fold-var ...) (if (and pre-guard ...)
(for/foldX/derived [orig-stx nested? #f ()] ([fold-var fold-var] ...) rest expr1 . body)]) (let-values ([(fold-var ...)
(if (and post-guard ...) (for/foldX/derived [orig-stx nested? #f ()] ([fold-var fold-var] ...) rest expr1 . body)])
(for-loop fold-var ... loop-arg ... ...) (if (and post-guard ...)
(values* fold-var ...))) (for-loop fold-var ... loop-arg ... ...)
(values* fold-var ...))) (values* fold-var ...)))
(values* fold-var ...)))))] (values* fold-var ...)))
(values* fold-var ...))))))]
;; Bad body cases: ;; Bad body cases:
[(_ [orig-stx . _] fold-bind ()) [(_ [orig-stx . _] fold-bind ())
(raise-syntax-error (raise-syntax-error