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
post-guard
[loop-arg ...]) ...) (reverse (syntax->list #'binds))])
#'(let-values (outer-binding ... ...)
#`(let-values (outer-binding ... ...)
outer-check ...
(let for-loop ([fold-var fold-init] ...
loop-binding ... ...)
(if (and pos-guard ...)
(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)])
(if (and post-guard ...)
(for-loop fold-var ... loop-arg ... ...)
(values* fold-var ...)))
(values* fold-var ...)))
(values* fold-var ...)))))]
#,(syntax/loc #'orig-stx
(let for-loop ([fold-var fold-init] ...
loop-binding ... ...)
(if (and pos-guard ...)
(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)])
(if (and post-guard ...)
(for-loop fold-var ... loop-arg ... ...)
(values* fold-var ...)))
(values* fold-var ...)))
(values* fold-var ...))))))]
;; Bad body cases:
[(_ [orig-stx . _] fold-bind ())
(raise-syntax-error