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

There might be a simpler way of writing this, but my kung macro isn't yet

Browse Source 
up to par if so.

svn: r11649
This commit is contained in:
Stevie Strickland 2008-09-11 17:49:29 +00:00
parent 16399b7827
commit eb676359c9
1 changed files with 8 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -20,9 +20,10 @@ improve method arity mismatch contract violation error messages?
(for-syntax "contract-opt-guts.ss") (for-syntax "contract-opt-guts.ss")
(for-syntax scheme/struct-info) (for-syntax scheme/struct-info)
(for-syntax scheme/list) (for-syntax scheme/list)
(for-syntax syntax/define)
scheme/promise
scheme/stxparam scheme/stxparam
scheme/stxparam-exptime scheme/stxparam-exptime)
scheme/promise)
(require "contract-arrow.ss" (require "contract-arrow.ss"
"contract-guts.ss" "contract-guts.ss"
@ -60,10 +61,11 @@ improve method arity mismatch contract violation error messages?
#'(with-contract name #'(with-contract name
([name contract-expr]) ([name contract-expr])
(define name expr))] (define name expr))]
[(_ (name arg ...) contract body) [(_ name+arg-list contract body)
(identifier? (syntax name)) (let-values ([(name lam-expr)
#'(define/contract name contract (normalize-definition (datum->syntax #'stx (list 'define #'name+arg-list #'body))
(lambda (arg ...) body))] #'lambda #f #t)])
#`(define/contract #,name contract #,lam-expr))]
[(_ name contract-expr expr) [(_ name contract-expr expr)
(raise-syntax-error 'define/contract "expected identifier in first position" (raise-syntax-error 'define/contract "expected identifier in first position"
define-stx define-stx