diff --git a/collects/drscheme/private/tools.ss b/collects/drscheme/private/tools.ss index 433150ac3f..c8c49f9300 100644 --- a/collects/drscheme/private/tools.ss +++ b/collects/drscheme/private/tools.ss @@ -4,7 +4,6 @@ scheme/list scheme/runtime-path scheme/contract - unstable/location setup/getinfo mred framework @@ -328,7 +327,7 @@ 'drscheme tool-name (quote name) - (quote-srcloc name))])) + (quote-syntax name))])) name ctc) body)] diff --git a/collects/mzlib/private/contract-define.ss b/collects/mzlib/private/contract-define.ss index 9cd106fa94..cf76531378 100644 --- a/collects/mzlib/private/contract-define.ss +++ b/collects/mzlib/private/contract-define.ss @@ -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 diff --git a/collects/mzlib/unit.ss b/collects/mzlib/unit.ss index 2ada199136..dec63d26fa 100644 --- a/collects/mzlib/unit.ss +++ b/collects/mzlib/unit.ss @@ -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 diff --git a/collects/scheme/contract/private/base.ss b/collects/scheme/contract/private/base.ss index 643cef2bcc..b1bf9dcdb8 100644 --- a/collects/scheme/contract/private/base.ss +++ b/collects/scheme/contract/private/base.ss @@ -56,9 +56,9 @@ improve method arity mismatch contract violation error messages? v))) (define (check-srcloc! f-name v-name v args) - (unless (srcloc? v) + (unless (source-location? v) (error f-name - "expected ~a to be a srcloc structure, got: ~e; all arguments: ~e" + "expected ~a to be a source location, got: ~e; all arguments: ~e" v-name v args)) (check-sexp! f-name (format "source file of ~a" v-name) diff --git a/collects/scheme/contract/private/provide.ss b/collects/scheme/contract/private/provide.ss index 540310ee08..aa30d49080 100644 --- a/collects/scheme/contract/private/provide.ss +++ b/collects/scheme/contract/private/provide.ss @@ -46,7 +46,7 @@ pos-module-source (quote-module-path) 'id - (quote-srcloc id))))))]) + (quote-syntax id))))))]) (when key (hash-set! saved-id-table key lifted-id)) ;; Expand to a use of the lifted expression: @@ -662,7 +662,7 @@ (syntax-local-lift-module-end-declaration #`(begin (unless extra-test - (contract contract-id id pos-module-source 'ignored 'id (quote-srcloc id))) + (contract contract-id id pos-module-source 'ignored 'id (quote-syntax id))) (void))) (syntax (code id-rename))))))])) diff --git a/collects/scheme/contract/regions.ss b/collects/scheme/contract/regions.ss index 68edea0844..758e2ca916 100644 --- a/collects/scheme/contract/regions.ss +++ b/collects/scheme/contract/regions.ss @@ -11,7 +11,6 @@ syntax/kerncase (prefix-in a: "private/helpers.ss")) scheme/splicing - unstable/location "private/arrow.ss" "private/base.ss" "private/guts.ss") @@ -314,7 +313,7 @@ '(struct name) 'cant-happen (quote #,av-id) - (quote-srcloc #,av-id)))))] + (quote-syntax #,av-id)))))] ;; a list of variables, one for each super field [(super-fields ...) (generate-temporaries super-fields)] ;; the contract for a super field is any/c becuase the @@ -346,7 +345,7 @@ guard (current-contract-region) blame-id (quote maker) - (quote-srcloc maker))))))))))] + (quote-syntax maker))))))))))] [(_ name . bad-fields) (identifier? #'name) (syntax-error "expected a list of field name/contract pairs" @@ -385,7 +384,7 @@ #,neg-blame-id #,pos-blame-id (quote #,id) - (quote-srcloc #,id))))] + (quote-syntax #,id))))] [(f arg ...) (quasisyntax/loc stx ((contract #,contract-stx @@ -393,7 +392,7 @@ #,pos-blame-id #,neg-blame-id (quote #,id) - (quote-srcloc #,id)) + (quote-syntax #,id)) arg ...))] [ident (identifier? (syntax ident)) @@ -403,7 +402,7 @@ #,pos-blame-id #,neg-blame-id (quote #,id) - (quote-srcloc #,id)))])))) + (quote-syntax #,id)))])))) (define-for-syntax (check-and-split-with-contracts args) (let loop ([args args] @@ -551,7 +550,7 @@ blame-id 'cant-happen (quote free-var) - (quote-srcloc free-var)) + (quote-syntax free-var)) ... (values))) (define-syntaxes (free-var-id ...) @@ -569,7 +568,7 @@ blame-stx 'cant-happen (quote marked-p) - (quote-srcloc marked-p)) + (quote-syntax marked-p)) ... (values))) (define-syntaxes (p ...) diff --git a/collects/syntax/private/stxparse/lib.ss b/collects/syntax/private/stxparse/lib.ss index 8714e1f9bb..0513e79599 100644 --- a/collects/syntax/private/stxparse/lib.ss +++ b/collects/syntax/private/stxparse/lib.ss @@ -6,7 +6,6 @@ syntax/kerncase scheme/struct-info unstable/srcloc - unstable/location (for-syntax scheme/base syntax/kerncase "rep.ss" @@ -115,7 +114,7 @@ (quote #,(source-location->string #'x "<>")) ' #f - (quote-srcloc x)))) + (quote-syntax x)))) ;; Literal sets diff --git a/collects/typed-scheme/utils/require-contract.ss b/collects/typed-scheme/utils/require-contract.ss index 8d71a4d1ec..f1d9737f2c 100644 --- a/collects/typed-scheme/utils/require-contract.ss +++ b/collects/typed-scheme/utils/require-contract.ss @@ -1,7 +1,6 @@ #lang scheme/base (require scheme/contract - unstable/location (for-syntax scheme/base syntax/kerncase syntax/parse @@ -46,7 +45,7 @@ '(interface for #,(syntax->datum #'nm)) 'never-happen (quote nm) - (quote-srcloc nm))))] + (quote-syntax nm))))] [(require/contract (orig-nm:renameable nm:id) cnt lib) #`(begin (require (only-in lib [orig-nm orig-nm.r])) (define-ignored nm @@ -55,4 +54,4 @@ '#,(syntax->datum #'nm) 'never-happen (quote nm) - (quote-srcloc nm))))])) + (quote-syntax nm))))]))