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

remove some old name-management code from contracts made obsolete by chaperones

Browse Source 
closes PR 11222
This commit is contained in:
Robby Findler 2015-03-09 21:19:04 -05:00
parent 332b380ca2
commit 33d653113d
3 changed files with 3 additions and 40 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
racket/collects/racket/contract/base.rkt
View File

@ -26,10 +26,6 @@
check-procedure
check-procedure/more
contracted-function?
contracted-function-proc
contracted-function-ctc
make-contracted-function
contract-key
;; these two are provided for-syntax

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

@ -28,11 +28,6 @@
procedure-accepts-and-more?
check-procedure
check-procedure/more
contracted-function?
contracted-function-proc
contracted-function-ctc
contracted-function-blame
make-contracted-function
matches-arity-exactly?
keywords-match
bad-number-of-results
@ -54,11 +49,6 @@
(list id)
null))
(define-struct contracted-function (proc ctc blame)
#:property prop:procedure 0
#:property prop:contracted 1
#:property prop:blame 2)
(define contract-key (gensym 'contract-key))
(define-for-syntax (check-tail-contract rng-ctcs rng-checkers call-gen)

29
racket/collects/racket/contract/private/base.rkt
View File

@ -64,35 +64,12 @@
;; name, we'll just put something stupid here
;; instead of changing the library around.
(or pos "false")
(if cvfp #f neg)
#t))
(define new-val
(cond
[cvfp (((cvfp blame) v) neg)]
[else (((contract-projection c) blame) v)]))
(cond
[(and (not (parameter? new-val)) ;; when PR 11221 is fixed, remove this line
(procedure? new-val)
(object-name v)
(not (eq? (object-name v) (object-name new-val))))
(define vs-name (object-name v))
(cond
[(contracted-function? new-val)
;; when PR11222 is fixed, change these things:
;; - eliminate this cond case
;; - remove the require of arrow.rkt above
;; - change (struct-out contracted-function)
;; in arrow.rkt to make-contracted-function
(make-contracted-function
(procedure-rename (contracted-function-proc new-val) vs-name)
(contracted-function-ctc new-val)
(if cvfp
(blame-add-missing-party blame neg)
blame))]
[else
(procedure-rename new-val vs-name)])]
[else new-val])))
[cvfp (((cvfp blame) v) neg)]
[else (((contract-projection c) blame) v)])))
(define-syntax (invariant-assertion stx)
(syntax-case stx ()