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

fixed incorrect renaming (noticed by Stevie)

Browse Source
This commit is contained in:
Robby Findler 2010-09-23 09:21:14 -05:00
parent 3d16dd698a
commit 5b375780bd
1 changed files with 6 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -48,13 +48,11 @@ improve method arity mismatch contract violation error messages?
(((contract-projection c)
(make-blame loc name (contract-name c) pos neg usr #t))
v)])
(if (and name
(not (parameter? new-val)) ;; when PR 11221 is fixed, remove this line
(if (and (not (parameter? new-val)) ;; when PR 11221 is fixed, remove this line
(procedure? new-val)
(not (eq? name (object-name new-val))))
(let ([name (if (symbol? name)
name
(string->symbol (format "~a" name)))])
(object-name v)
(not (eq? (object-name v) (object-name new-val))))
(let ([vs-name (object-name v)])
(cond
[(contracted-function? new-val)
;; when PR11222 is fixed, change these things:
@ -63,10 +61,10 @@ improve method arity mismatch contract violation error messages?
;; - change (struct-out contracted-function)
;; in arrow.rkt to make-contracted-function
(make-contracted-function
(procedure-rename (contracted-function-proc new-val) name)
(procedure-rename (contracted-function-proc new-val) vs-name)
(contracted-function-ctc new-val))]
[else
(procedure-rename new-val name)]))
(procedure-rename new-val vs-name)]))
new-val))))
(define-syntax (recursive-contract stx)