From 4edc044cb60194fd152c5f7b8347df4eabb47b22 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Wed, 4 Nov 2009 19:17:31 +0000 Subject: [PATCH] source locations for 'for' loops in stack traces svn: r16545 --- collects/scheme/private/for.ss | 27 ++++++++++++++------------- 1 file changed, 14 insertions(+), 13 deletions(-) diff --git a/collects/scheme/private/for.ss b/collects/scheme/private/for.ss index 293ea76b21..f34104146e 100644 --- a/collects/scheme/private/for.ss +++ b/collects/scheme/private/for.ss @@ -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