From 5d478c9aa124c430c9e0d25b505b21eec9f0491d Mon Sep 17 00:00:00 2001 From: Stevie Strickland Date: Mon, 23 Feb 2009 22:05:09 +0000 Subject: [PATCH] Fixing some more inferred-name placements. svn: r13806 original commit: e727f4fd083b3728d9531486f26d2be42e2bd882 --- collects/mzlib/unit.ss | 21 +++++++++++++-------- 1 file changed, 13 insertions(+), 8 deletions(-) diff --git a/collects/mzlib/unit.ss b/collects/mzlib/unit.ss index 0b25cdc..64eed91 100644 --- a/collects/mzlib/unit.ss +++ b/collects/mzlib/unit.ss @@ -459,11 +459,12 @@ (define-for-syntax (make-import-unboxing var loc ctc) (if ctc - (quasisyntax/loc (error-syntax) - (quote-syntax (let ([v/c ((car #,loc))]) - (contract #,ctc (car v/c) (cdr v/c) - (current-contract-region) - #,(id->contract-src-info var))))) + (with-syntax ([ctc-stx (syntax-property ctc 'inferred-name var)]) + (quasisyntax/loc (error-syntax) + (quote-syntax (let ([v/c ((car #,loc))]) + (contract ctc-stx (car v/c) (cdr v/c) + (current-contract-region) + #,(id->contract-src-info var)))))) (quasisyntax/loc (error-syntax) (quote-syntax ((car #,loc)))))) @@ -1278,9 +1279,13 @@ (map (λ (tb i v c) #`(let ([v/c ((car #,tb))]) #,(if c - #`(contract (letrec-syntax #,rename-bindings #,c) (car v/c) (cdr v/c) - (current-contract-region) - #,(id->contract-src-info v)) + (with-syntax ([ctc-stx + (syntax-property + #`(letrec-syntax #,rename-bindings #,c) + 'inferred-name v)]) + #`(contract ctc-stx (car v/c) (cdr v/c) + (current-contract-region) + #,(id->contract-src-info v))) #'v/c))) tbs (iota (length (car os)))