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

Replaced uses of quote-srcloc with quote-syntax.

Browse Source 
svn: r17757

original commit: 7f58c26709c9a97623f50ec812727daa080b155b
This commit is contained in:
Carl Eastlund 2010-01-19 23:25:07 +00:00
parent e600445407
commit 02ce7aabdb
2 changed files with 9 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
collects/mzlib/private/contract-define.ss
View File

@ -5,8 +5,7 @@
(require (for-syntax scheme/base
unstable/srcloc
(prefix-in a: scheme/contract/private/helpers))
(only-in scheme/contract contract)
unstable/location)
(only-in scheme/contract contract))
;; First, we have the old define/contract implementation, which
;; is still used in mzlib/contract.
@ -30,7 +29,7 @@
(syntax->datum (quote-syntax f))
neg-blame-str
(quote f)
(quote-srcloc f))
(quote-syntax f))
arg
...))]
[ident
@ -41,7 +40,7 @@
(syntax->datum (quote-syntax ident))
neg-blame-str
(quote ident)
(quote-srcloc ident)))])))))
(quote-syntax ident)))])))))
;; (define/contract id contract expr)
;; defines `id' with `contract'; initially binding

13
collects/mzlib/unit.ss
View File

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