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

create the blame+neg-party pair only once, not once for the domain

Browse Source 
and once for the range
This commit is contained in:
Robby Findler 2015-08-23 23:14:31 -05:00
parent 49c4d9272f
commit b7f500fc26
1 changed files with 29 additions and 27 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
racket/collects/racket/contract/private/arrow-val-first.rkt
View File

@ -252,12 +252,13 @@
(define let-values-clause (define let-values-clause
#`[#,(reverse args-vars) #`[#,(reverse args-vars)
(with-continuation-mark contract-continuation-mark-key (with-continuation-mark contract-continuation-mark-key
(cons blame neg-party) blame+neg-party
(values #,@(reverse args-expressions)))]) (values #,@(reverse args-expressions)))])
(define the-clause (define the-clause
(if rngs (if rngs
#`[#,the-args #`[#,the-args
(let ([blame+neg-party (cons blame neg-party)])
pre-check ... pre-check ...
(define-values (failed res-x ...) (define-values (failed res-x ...)
(call-with-values (call-with-values
@ -270,7 +271,7 @@
(values args #,@(map (λ (x) #'#f) (values args #,@(map (λ (x) #'#f)
(syntax->list #'(res-x ...))))]))) (syntax->list #'(res-x ...))))])))
(with-continuation-mark contract-continuation-mark-key (with-continuation-mark contract-continuation-mark-key
(cons blame neg-party) blame+neg-party
(cond (cond
[failed [failed
(wrong-number-of-results-blame (wrong-number-of-results-blame
@ -281,11 +282,12 @@
#'(res-x ...))))] #'(res-x ...))))]
[else [else
post-check ... post-check ...
(values ((rb res-x) neg-party) ...)]))] (values ((rb res-x) neg-party) ...)])))]
#`[#,the-args #`[#,the-args
pre-check ... pre-check ...
(let ([blame+neg-party (cons blame neg-party)])
(let-values (#,let-values-clause) (let-values (#,let-values-clause)
#,full-call)])) #,full-call))]))
(cons the-clause (cons the-clause
(cond (cond
[(null? optional-args) '()] [(null? optional-args) '()]