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

Have arg-dep-ctcs return the contract directly

Browse Source
This commit is contained in:
shhyou 2018-08-28 13:27:27 -05:00 committed by Robby Findler
parent 37c9169874
commit 1ad4d82691
1 changed files with 10 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -716,7 +716,8 @@ evaluted left-to-right.)
an-arg/res an-arg/res
wrapper-arg wrapper-arg
(if (arg/res-vars an-arg/res) (if (arg/res-vars an-arg/res)
#`(#,contract-identifier #`(#,(if is-chaperone-contract? #'un-dep/chaperone #'un-dep)
#,contract-identifier
#,wrapper-arg #,wrapper-arg
#,(build-blame-identifier #t swapped-blame? (arg/res-var an-arg/res)) #,(build-blame-identifier #t swapped-blame? (arg/res-var an-arg/res))
neg-party neg-party
@ -753,7 +754,8 @@ evaluted left-to-right.)
neg-party neg-party
#f)] #f)]
[(arg/res-vars an-arg/res) [(arg/res-vars an-arg/res)
#`(#,contract-identifier #`(#,(if is-chaperone-contract? #'un-dep/chaperone #'un-dep)
#,contract-identifier
#,wrapper-arg #,wrapper-arg
#,(build-blame-identifier #f swapped-blame? (arg/res-var an-arg/res)) #,(build-blame-identifier #f swapped-blame? (arg/res-var an-arg/res))
neg-party neg-party
@ -1255,13 +1257,10 @@ evaluted left-to-right.)
'racket/contract:contract-on-boundary 'racket/contract:contract-on-boundary
(gensym '->i-indy-boundary))) (gensym '->i-indy-boundary)))
#`(λ (#,@orig-vars) #`(λ (#,@orig-vars)
(define the-contract #,ctc-stx)
#,@(arg/res-vars arg) ;; needed for check syntax arrows #,@(arg/res-vars arg) ;; needed for check syntax arrows
(λ (val blame neg-party indy-blame?) ;; this used to use opt/direct, but
;; this used to use opt/direct, but ;; opt/direct duplicates code (bad!)
;; opt/direct duplicates code (bad!) #,ctc-stx)))
(#,(if is-chaperone-contract? #'un-dep/chaperone #'un-dep)
the-contract val blame neg-party indy-blame?)))))
;; then the non-dependent argument contracts that are themselves depended on ;; then the non-dependent argument contracts that are themselves depended on
(list #,@(filter values (list #,@(filter values
(map (λ (arg/res indy-id) (map (λ (arg/res indy-id)
@ -1295,16 +1294,10 @@ evaluted left-to-right.)
#,@(arg/res-vars arg) ;; needed for check syntax arrows #,@(arg/res-vars arg) ;; needed for check syntax arrows
(opt/c #,arg-stx)) (opt/c #,arg-stx))
#`(λ (#,@orig-vars) #`(λ (#,@orig-vars)
(define the-contract #,arg-stx)
#,@(arg/res-vars arg) ;; needed for check syntax arrows #,@(arg/res-vars arg) ;; needed for check syntax arrows
(λ (val blame neg-party indy-blame?) ;; this used to use opt/direct, but
;; this used to use opt/direct, but ;; opt/direct duplicates code (bad!)
;; opt/direct duplicates code (bad!) #,arg-stx))))
(#,(if is-chaperone-contract?
#'un-dep/chaperone
#'un-dep)
the-contract val blame neg-party
indy-blame?))))))
#''()) #''())
#,(if (istx-ress an-istx) #,(if (istx-ress an-istx)
#`(list #,@(filter values #`(list #,@(filter values