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

get a better name for certain contract error messages

Browse Source 
related to PR 13665
This commit is contained in:
Robby Findler 2013-04-06 14:07:48 -05:00
parent 8231db1961
commit 4632899b81
1 changed files with 7 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
collects/racket/contract/private/arrow.rkt
View File

@ -1593,7 +1593,8 @@ v4 todo:
(define-syntax (case-> stx)
(syntax-case stx ()
[(_ cases ...)
(begin
(let ()
(define name (syntax-local-infer-name stx))
(with-syntax ([(((dom-proj ...)
rst-proj
rng-proj
@ -1624,7 +1625,11 @@ v4 todo:
(λ (kwds kwd-args . args)
(raise-blame-error blame f "expected no keywords, got keyword ~a" (car kwds)))
(λ args
(apply (case-lambda [formals body] ...) args)))]
(apply #,(let ([case-lam (syntax/loc stx (case-lambda [formals body] ...))])
(if name
#`(let ([#,name #,case-lam]) #,name)
case-lam))
args)))]
[same-rngs (same-range-projections (list (list rng-proj-x ...) ...))])
(if same-rngs
(wrapper