From 6e86da95e60f9d2aaef92c73226c9f99f374c3ae Mon Sep 17 00:00:00 2001 From: Stevie Strickland Date: Thu, 15 Jan 2009 05:17:27 +0000 Subject: [PATCH] Actually make this used specifically for blame, not the unit name. We might end up collapsing this and what's introduced in with-contract. svn: r13140 --- collects/mzlib/unit.ss | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/collects/mzlib/unit.ss b/collects/mzlib/unit.ss index 6b2af64412..bc40664f8d 100644 --- a/collects/mzlib/unit.ss +++ b/collects/mzlib/unit.ss @@ -469,13 +469,13 @@ #,(syntax-span id)) #,(format "~s" (syntax-object->datum id)))) - (define-syntax-parameter current-unit-name-stx (lambda (stx) #'(#%variable-reference))) + (define-syntax-parameter current-unit-blame-stx (lambda (stx) #'(#%variable-reference))) (define-for-syntax (make-import-unboxing ext-var loc ctc) (if ctc (quasisyntax/loc (error-syntax) (quote-syntax (contract #,ctc (unbox #,loc) 'cant-happen - (current-unit-name-stx) + (current-unit-blame-stx) #,(id->contract-src-info ext-var)))) (quasisyntax/loc (error-syntax) (quote-syntax (unbox #,loc))))) @@ -556,7 +556,7 @@ (vector-immutable (cons 'export-name (vector-immutable export-key ...)) ...) (list (cons 'dept depr) ...) - (syntax-parameterize ([current-unit-name-stx (lambda (stx) #'(quote name))]) + (syntax-parameterize ([current-unit-blame-stx (lambda (stx) #'(quote (unit name)))]) (lambda () (let ([eloc (box undefined)] ... ...) (values @@ -695,7 +695,7 @@ (set-var-info-add-ctc! v (λ (e) - #`(contract #,(cdr (syntax-e ctc)) #,e (current-unit-name-stx) + #`(contract #,(cdr (syntax-e ctc)) #,e (current-unit-blame-stx) 'cant-happen #,(id->contract-src-info var))))))) (syntax->list (localify #'evars def-ctx)) (syntax->list #'elocs) @@ -1222,7 +1222,7 @@ (lambda (i iv c) (if c #`(contract #,c (unbox (vector-ref #,ov #,i)) - 'cant-happen (current-unit-name-stx) + 'cant-happen (current-unit-blame-stx) #,(id->contract-src-info iv)) #`(unbox (vector-ref #,ov #,i)))) (iota (length (car os)))