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

uncopy some code

Browse Source
This commit is contained in:
Robby Findler 2015-12-29 21:46:06 -06:00
parent 46ace3172f
commit a5b3d6b3d0
1 changed files with 16 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

36
racket/collects/racket/contract/private/arr-i.rkt
View File

@ -1088,30 +1088,24 @@ evaluted left-to-right.)
#`(f #,@argument-list))) #`(f #,@argument-list)))
(begin-encourage-inline (begin-encourage-inline
(define (un-dep/maybe-chaperone orig-ctc obj blame neg-party chaperone?)
(cond
[(and (procedure? orig-ctc)
(procedure-arity-includes? orig-ctc 1))
(if (orig-ctc obj)
obj
(raise-predicate-blame-error-failure blame obj neg-party
(object-name orig-ctc)))]
[else
(define ctc (if chaperone?
(coerce-chaperone-contract '->i orig-ctc)
(coerce-contract '->i orig-ctc)))
(((get/build-late-neg-projection ctc) blame) obj neg-party)]))
(define (un-dep/chaperone orig-ctc obj blame neg-party) (define (un-dep/chaperone orig-ctc obj blame neg-party)
(cond (un-dep/maybe-chaperone orig-ctc obj blame neg-party #t))
[(and (procedure? orig-ctc)
(procedure-arity-includes? orig-ctc 1))
(if (orig-ctc obj)
obj
(raise-predicate-blame-error-failure blame obj neg-party
(object-name orig-ctc)))]
[else
(define ctc (coerce-chaperone-contract '->i orig-ctc))
(((get/build-late-neg-projection ctc) blame) obj neg-party)])))
(begin-encourage-inline
(define (un-dep orig-ctc obj blame neg-party) (define (un-dep orig-ctc obj blame neg-party)
(cond (un-dep/maybe-chaperone orig-ctc obj blame neg-party #f)))
[(and (procedure? orig-ctc)
(procedure-arity-includes? orig-ctc 1))
(if (orig-ctc obj)
obj
(raise-predicate-blame-error-failure blame obj neg-party
(object-name orig-ctc)))]
[else
(define ctc (coerce-contract '->i orig-ctc))
(((get/build-late-neg-projection ctc) blame) obj neg-party)])))
(define-for-syntax (mk-used-indy-vars an-istx) (define-for-syntax (mk-used-indy-vars an-istx)
(let ([vars (make-free-identifier-mapping)]) (let ([vars (make-free-identifier-mapping)])