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

possible fix to PR 9204

Browse Source 
svn: r7587
This commit is contained in:
Robby Findler 2007-10-29 02:28:30 +00:00
parent 697957e60a
commit 3724e47d0c
1 changed files with 46 additions and 44 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
collects/mzlib/private/contract.ss
View File

@ -14,8 +14,7 @@ improve method arity mismatch contract violation error messages?
(require-for-syntax mzscheme
"contract-opt-guts.ss"
(lib "list.ss")
(lib "etc.ss"))
(lib "list.ss"))
(require "contract-arrow.ss"
"contract-guts.ss"
@ -639,7 +638,10 @@ improve method arity mismatch contract violation error messages?
;; builds a begin expression for the entire contract and provide
;; the first syntax object is used for source locations
(define code-for-one-id/new-name
(opt-lambda (stx id ctrct user-rename-id [mangle-for-maker? #f])
(case-lambda
[(stx id ctrct user-rename-id)
(code-for-one-id/new-name stx id ctrct user-rename-id #f)]
[(stx id ctrct user-rename-id mangle-for-maker?)
(let ([no-need-to-check-ctrct? (a:known-good-contract? ctrct)])
(with-syntax ([id-rename ((if mangle-for-maker?
a:mangle-id-for-maker
@ -663,24 +665,24 @@ improve method arity mismatch contract violation error messages?
(with-syntax ([code
(quasisyntax/loc stx
(begin
(provide (rename id-rename external-name))
(define pos-module-source (module-source-as-symbol #'pos-stx))
#,@(if no-need-to-check-ctrct?
(list)
(list #'(define contract-id (verify-contract ctrct))))
(define-syntax id-rename
(make-provide/contract-transformer (quote-syntax contract-id)
(quote-syntax id)
(quote-syntax pos-module-source)))))])
(quote-syntax pos-module-source)))
(provide (rename id-rename external-name))))])
(syntax-local-lift-module-end-declaration
#'(begin
(-contract contract-id id pos-module-source 'ignored #'id)
(void)))
(syntax (code id-rename)))))))
(syntax (code id-rename)))))]))
(with-syntax ([(bodies ...) (code-for-each-clause (syntax->list (syntax (p/c-ele ...))))])
(syntax