suzanne.soy/compatibility
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Updated quote-syntax to quote-srcloc in mzlib unit contracts.

Browse Source 
svn: r17735

original commit: 5606c590bd78a12c057b62ef43e496a76b0581c5
This commit is contained in:
Carl Eastlund 2010-01-19 04:57:33 +00:00
parent 9747444199
commit 76fba4d47e
1 changed files with 7 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
collects/mzlib/unit.ss
View File

@ -16,6 +16,7 @@
(require mzlib/etc (require mzlib/etc
scheme/contract/base scheme/contract/base
scheme/stxparam scheme/stxparam
unstable/location
"private/unit-contract.ss" "private/unit-contract.ss"
"private/unit-keywords.ss" "private/unit-keywords.ss"
"private/unit-runtime.ss" "private/unit-runtime.ss"
@ -482,7 +483,7 @@
(if (pair? v/c) (if (pair? v/c)
(contract (let-syntax #,renamings ctc-stx) (car v/c) (cdr v/c) (contract (let-syntax #,renamings ctc-stx) (car v/c) (cdr v/c)
(current-contract-region) (current-contract-region)
(quote #,var) (quote-syntax #,var)) (quote #,var) (quote-srcloc #,var))
(error 'unit "contracted import ~a used before definition" (error 'unit "contracted import ~a used before definition"
(quote #,(syntax->datum var)))))))) (quote #,(syntax->datum var))))))))
(quasisyntax/loc (error-syntax) (quasisyntax/loc (error-syntax)
@ -748,7 +749,7 @@
(current-contract-region) (current-contract-region)
'cant-happen 'cant-happen
(quote #,id) (quote #,id)
(quote-syntax #,id)) (quote-srcloc #,id))
(set-box! #,export-loc (set-box! #,export-loc
(cons #,tmp (current-contract-region))))) (cons #,tmp (current-contract-region)))))
(quasisyntax/loc defn-or-expr (quasisyntax/loc defn-or-expr
@ -825,7 +826,7 @@
#`(let ([old-v/c (#,vref)]) #`(let ([old-v/c (#,vref)])
(contract ctc-stx (car old-v/c) (contract ctc-stx (car old-v/c)
(cdr old-v/c) (current-contract-region) (cdr old-v/c) (current-contract-region)
(quote #,var) (quote-syntax #,var))) (quote #,var) (quote-srcloc #,var)))
#`(#,vref)) #`(#,vref))
(current-contract-region))) (current-contract-region)))
(if ctc (if ctc
@ -833,7 +834,7 @@
(let ([old-v/c (#,vref)]) (let ([old-v/c (#,vref)])
(contract ctc-stx (car old-v/c) (contract ctc-stx (car old-v/c)
(cdr old-v/c) (current-contract-region) (cdr old-v/c) (current-contract-region)
(quote #,var) (quote-syntax #,var)))) (quote #,var) (quote-srcloc #,var))))
vref))))) vref)))))
(car target-sig) (car target-sig)
(cadddr target-sig))) (cadddr target-sig)))
@ -1304,7 +1305,7 @@
#`(let ([v/c (#,tb)]) #`(let ([v/c (#,tb)])
(contract ctc-stx (car v/c) (cdr v/c) (contract ctc-stx (car v/c) (cdr v/c)
(current-contract-region) (current-contract-region)
(quote #,v) (quote-syntax #,v)))) (quote #,v) (quote-srcloc #,v))))
#`(#,tb))) #`(#,tb)))
tbs tbs
(iota (length (car os))) (iota (length (car os)))
@ -1507,7 +1508,7 @@
(export (export-tagged-sig-id [e.x e.c] ...) ...))))]) (export (export-tagged-sig-id [e.x e.c] ...) ...))))])
(values (values
(syntax/loc stx (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))))] isigs esigs deps))))]
[(ic:import-clause/contract ec:export-clause/contract . body) [(ic:import-clause/contract ec:export-clause/contract . body)
(build-unit/contract (build-unit/contract