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

* Make define/contract have an implicit begin

Browse Source 
* Change with-contract's implicit begin into begin-with-definitions

svn: r11650
This commit is contained in:
Stevie Strickland 2008-09-11 20:38:09 +00:00
parent eb676359c9
commit 1621335290
1 changed files with 9 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -23,7 +23,8 @@ improve method arity mismatch contract violation error messages?
(for-syntax syntax/define) (for-syntax syntax/define)
scheme/promise scheme/promise
scheme/stxparam scheme/stxparam
scheme/stxparam-exptime) scheme/stxparam-exptime
mzlib/etc)
(require "contract-arrow.ss" (require "contract-arrow.ss"
"contract-guts.ss" "contract-guts.ss"
@ -56,14 +57,14 @@ improve method arity mismatch contract violation error messages?
;; it to the result of `expr'. These variables may not be set!'d. ;; it to the result of `expr'. These variables may not be set!'d.
(define-syntax (define/contract define-stx) (define-syntax (define/contract define-stx)
(syntax-case define-stx () (syntax-case define-stx ()
[(_ name contract-expr expr) [(_ name contract-expr expr0 expr ...)
(identifier? (syntax name)) (identifier? (syntax name))
#'(with-contract name #'(with-contract name
([name contract-expr]) ([name contract-expr])
(define name expr))] (define name expr0 expr ...))]
[(_ name+arg-list contract body) [(_ name+arg-list contract body0 body ...)
(let-values ([(name lam-expr) (let-values ([(name lam-expr)
(normalize-definition (datum->syntax #'stx (list 'define #'name+arg-list #'body)) (normalize-definition (datum->syntax #'stx (list* 'define #'name+arg-list #'body0 #'(body ...)))
#'lambda #f #t)]) #'lambda #f #t)])
#`(define/contract #,name contract #,lam-expr))] #`(define/contract #,name contract #,lam-expr))]
[(_ name contract-expr expr) [(_ name contract-expr expr)
@ -142,8 +143,9 @@ improve method arity mismatch contract violation error messages?
(begin (begin
(define-values (id ...) (define-values (id ...)
(syntax-parameterize ([current-contract-region (quote blame)]) (syntax-parameterize ([current-contract-region (quote blame)])
(begin-with-definitions
body0 body ... body0 body ...
(values name ...))) (values name ...))))
(define contract-id contract-expr) ... (define contract-id contract-expr) ...
(define-syntax name (define-syntax name
(make-with-contract-transformer (make-with-contract-transformer