From 2b7121ca814dba88eaac2d469c5c8798b388a2e9 Mon Sep 17 00:00:00 2001 From: Stevie Strickland Date: Mon, 1 Mar 2010 23:47:31 +0000 Subject: [PATCH] Maintain source locations appropriately. svn: r18422 original commit: f37f81cdb29924555c894164ff482b3619a90af8 --- collects/mzlib/unit.ss | 13 +++++++------ 1 file changed, 7 insertions(+), 6 deletions(-) diff --git a/collects/mzlib/unit.ss b/collects/mzlib/unit.ss index d13d748..fb654f6 100644 --- a/collects/mzlib/unit.ss +++ b/collects/mzlib/unit.ss @@ -9,6 +9,7 @@ syntax/parse syntax/struct syntax/stx + unstable/location "private/unit-contract-syntax.ss" "private/unit-compiletime.ss" "private/unit-syntax.ss")) @@ -483,7 +484,7 @@ (if (pair? v/c) (contract (let-syntax #,renamings ctc-stx) (car v/c) (cdr v/c) (current-contract-region) - (quote #,var) (quote-syntax #,var)) + (quote #,var) (quote-srcloc #,var)) (error 'unit "contracted import ~a used before definition" (quote #,(syntax->datum var)))))))) (quasisyntax/loc (error-syntax) @@ -749,7 +750,7 @@ (current-contract-region) 'cant-happen (quote #,id) - (quote-syntax #,id)) + (quote-srcloc #,id)) (set-box! #,export-loc (cons #,tmp (current-contract-region))))) (quasisyntax/loc defn-or-expr @@ -826,7 +827,7 @@ #`(let ([old-v/c (#,vref)]) (contract ctc-stx (car old-v/c) (cdr old-v/c) (current-contract-region) - (quote #,var) (quote-syntax #,var))) + (quote #,var) (quote-srcloc #,var))) #`(#,vref)) (current-contract-region))) (if ctc @@ -834,7 +835,7 @@ (let ([old-v/c (#,vref)]) (contract ctc-stx (car old-v/c) (cdr old-v/c) (current-contract-region) - (quote #,var) (quote-syntax #,var)))) + (quote #,var) (quote-srcloc #,var)))) vref))))) (car target-sig) (cadddr target-sig))) @@ -1305,7 +1306,7 @@ #`(let ([v/c (#,tb)]) (contract ctc-stx (car v/c) (cdr v/c) (current-contract-region) - (quote #,v) (quote-syntax #,v)))) + (quote #,v) (quote-srcloc #,v)))) #`(#,tb))) tbs (iota (length (car os))) @@ -1508,7 +1509,7 @@ (export (export-tagged-sig-id [e.x e.c] ...) ...))))]) (values (syntax/loc stx - (contract unit-contract new-unit '(unit name) (current-contract-region) (quote name) (quote-syntax name))) + (contract unit-contract new-unit '(unit name) (current-contract-region) (quote name) (quote-srcloc name))) isigs esigs deps))))] [(ic:import-clause/contract ec:export-clause/contract . body) (build-unit/contract