From 0acf9834f7d62748625c5c71693ada267dc48475 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Sat, 9 Jul 2011 16:51:08 -0600 Subject: [PATCH] make ISL `local' and `letrec' expand more the old way That is, force expansion to use a single `letrec', instead of a mixture of `let' and `letrec' that an internal-definition expansion would now use. --- collects/lang/private/teach.rkt | 28 +++++++++++++++------------- 1 file changed, 15 insertions(+), 13 deletions(-) diff --git a/collects/lang/private/teach.rkt b/collects/lang/private/teach.rkt index b01dccbc6c..8763277f0a 100644 --- a/collects/lang/private/teach.rkt +++ b/collects/lang/private/teach.rkt @@ -1750,13 +1750,14 @@ (stepper-syntax-property (quasisyntax/loc stx (let () - (define #,(gensym) 1) ; this ensures that the expansion of 'local' looks - ; roughly the same, even if the local has no defs. - mapping ... - stx-def ... - (define-values (tmp-id ...) def-expr) - ... - . exprs)) + (#%stratified-body + (define #,(gensym) 1) ; this ensures that the expansion of 'local' looks + ; roughly the same, even if the local has no defs. + mapping ... + stx-def ... + (define-values (tmp-id ...) def-expr) + ... + . exprs))) 'stepper-hint 'comes-from-local)))))))] [(_ def-non-seq . __) @@ -1805,12 +1806,13 @@ [(rhs-expr ...) (map allow-local-lambda (syntax->list (syntax (rhs-expr ...))))]) (quasisyntax/loc stx - (letrec-syntaxes+values ([(name) (make-undefined-check - (quote-syntax check-not-undefined) - (quote-syntax tmp-id))] - ...) - ([(tmp-id) rhs-expr] - ...) + (#%stratified-body + (define-syntaxes (name) (make-undefined-check + (quote-syntax check-not-undefined) + (quote-syntax tmp-id))) + ... + (define-values (tmp-id) rhs-expr) + ... expr)))] [_else (bad-let-form 'letrec stx stx)]))))