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

Remove the introducer, which isn't being used anyway.

Browse Source 
svn: r11692
This commit is contained in:
Stevie Strickland 2008-09-12 18:13:20 +00:00
parent a4c6d310df
commit 3b44bca1d5
1 changed files with 17 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

35
collects/scheme/private/contract.ss
View File

@ -185,12 +185,11 @@ improve method arity mismatch contract violation error messages?
(car args))]))) (car args))])))
(define-syntax (with-contract stx) (define-syntax (with-contract stx)
(let ([introducer (make-syntax-introducer)]) (syntax-case stx ()
(syntax-case stx () [(_ blame (arg ...) body0 body ...)
[(_ blame (arg ...) body0 body ...) (identifier? (syntax blame))
(identifier? (syntax blame)) (let-values ([(unprotected protected protections)
(let-values ([(unprotected protected protections) (check-and-split-with-contract-args (syntax->list #'(arg ...)))])
(check-and-split-with-contract-args (syntax->list #'(arg ...)))])
(with-syntax ([((protected-id id contract-id) ...) (with-syntax ([((protected-id id contract-id) ...)
(map (lambda (n) (map (lambda (n)
(list n (list n
@ -212,18 +211,18 @@ improve method arity mismatch contract violation error messages?
(quote-syntax contract-id) (quote-syntax contract-id)
(quote-syntax id) (quote-syntax id)
(quote-syntax (quote blame)))) ...))))] (quote-syntax (quote blame)))) ...))))]
[(_ blame (arg ...) body0 body ...) [(_ blame (arg ...) body0 body ...)
(raise-syntax-error 'with-contract (raise-syntax-error 'with-contract
"expected identifier" "expected identifier"
#'blame)] #'blame)]
[(_ blame (arg ...)) [(_ blame (arg ...))
(raise-syntax-error 'with-contract (raise-syntax-error 'with-contract
"empty body" "empty body"
stx)] stx)]
[(_ blame bad-args body0 body ...) [(_ blame bad-args body0 body ...)
(raise-syntax-error 'with-contract (raise-syntax-error 'with-contract
"expected list of identifier and/or (identifier contract)" "expected list of identifier and/or (identifier contract)"
#'bad-args)]))) #'bad-args)]))
; ;
; ;