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

Revert "Attempt at adding ->im; will be reverted."

Browse Source 
This reverts commit 3d987bf1fda9039fee9efafe21f9f78a0ef4feca.
This commit is contained in:
Vincent St-Amour 2016-03-30 16:46:57 -05:00
parent 7c458d10d7
commit 5c10eb13eb
4 changed files with 7 additions and 111 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
pkgs/racket-doc/scribblings/reference/class.scrbl
View File

@ -2071,28 +2071,16 @@ domain, where the first (implicit) argument is contracted with
@racket[any/c]. This contract is useful for writing simpler method
contracts when no properties of @racket[this] need to be checked.}
@deftogether[[
@defform[(->im maybe-chaperone
(mandatory-dependent-dom ...)
(optional-dependent-dom ...)
dependent-rest
pre-cond
dep-range
post-condition)]
@defform[(->dm (mandatory-dependent-dom ...)
(optional-dependent-dom ...)
dependent-rest
pre-cond
dep-range)]
]]{
Similar to @racket[->i] and @racket[->d], except that the mandatory domain of the resulting contract
dep-range)]{
Similar to @racket[->d], except that the mandatory domain of the resulting contract
contains one more element than the stated domain, where the first (implicit) argument is contracted
with @racket[any/c]. In addition, @racket[this] is appropriately bound in the body of the contract.
This contract is useful for writing simpler method contracts when no properties
of @racket[this] need to be checked.
@history[#:changed "6.4.0.15" @elem{Added @racket[->im].}]
}
of @racket[this] need to be checked.}
@defform/subs[
#:literals (field)

89
pkgs/racket-test/tests/racket/contract/class.rkt
View File

@ -1847,7 +1847,7 @@
'neg))
(test/pos-blame
'->dm-first-order-2
'->dm-first-order-1
'(contract (class/c [pop (->dm () () #:pre-cond (not (send this empty?)) [_ number?])]
[push (->dm ([arg number?]) () [_ void?] #:post-cond (not (send this empty?)))]
[empty? (->m boolean?)])
@ -1917,92 +1917,7 @@
'neg)]
[o (new stack%)])
(send o pop)))
(test/spec-passed
'->im-first-order-1
'(contract (class/c [pop (->im () #:pre () (not (send this empty?)) [_ number?])]
[push (->im ([arg number?]) [_ void?] #:post () (not (send this empty?)))]
[empty? (->m boolean?)])
(class object% (super-new)
(define stack null)
(define/public (empty?) (null? stack))
(define/public (push v) (set! stack (cons v stack)))
(define/public (pop) (let ([res (car stack)]) (set! stack (cdr stack)) res)))
'pos
'neg))
(test/pos-blame
'->im-first-order-2
'(contract (class/c [pop (->im () #:pre () (not (send this empty?)) [_ number?])]
[push (->im ([arg number?]) [_ void?] #:post () (not (send this empty?)))]
[empty? (->m boolean?)])
(class object% (super-new)
(define stack null)
(define/public (empty?) (null? stack))
(define/public (push v) (set! stack (cons v stack)))
(define/public (pop v) (let ([res (car stack)]) (set! stack (cdr stack)) res)))
'pos
'neg))
(test/spec-passed
'->im-higher-order-1
'(let* ([stack% (contract (class/c
[pop (->im () #:pre () (not (send this empty?)) [_ number?])]
[push (->im ([arg number?]) [_ void?]
#:post () (not (send this empty?)))]
[empty? (->m boolean?)])
(class object% (super-new)
(define stack null)
(define/public (empty?) (null? stack))
(define/public (push v) (set! stack (cons v stack)))
(define/public (pop)
(let ([res (car stack)]) (set! stack (cdr stack)) res)))
'pos
'neg)]
[o (new stack%)])
(send o push 4)
(send o empty?)
(send o pop)))
(test/pos-blame
'->im-higher-order-2
'(let* ([stack% (contract (class/c
[pop (->im () #:pre () (not (send this empty?)) [_ number?])]
[push (->im ([arg number?]) [_ void?]
#:post () (not (send this empty?)))]
[empty? (->m boolean?)])
(class object% (super-new)
(define stack null)
(define/public (empty?) (null? stack))
(define/public (push v) (void))
(define/public (pop)
(define res (car stack))
(set! stack (cdr stack))
res))
'pos
'neg)]
[o (new stack%)])
(send o push 4)
(send o empty?)
(send o pop)))
(test/neg-blame
'->im-higher-order-3
'(let* ([stack% (contract
(class/c
[pop (->im () #:pre () (not (send this empty?)) [_ number?])]
[push (->im ([arg number?]) [_ void?] #:post () (not (send this empty?)))]
[empty? (->m boolean?)])
(class object% (super-new)
(define stack null)
(define/public (empty?) (null? stack))
(define/public (push v) (set! stack (cons v stack)))
(define/public (pop) (let ([res (car stack)]) (set! stack (cdr stack)) res)))
'pos
'neg)]
[o (new stack%)])
(send o pop)))
(test/spec-passed
'case->m-first-order-1
'(contract (class/c [m (case->m (-> number? number?) (-> number? number? number?))])

9
racket/collects/racket/private/class-c-old.rkt
View File

@ -10,12 +10,11 @@
"../contract/combinator.rkt"
(only-in "../contract/private/arrow-val-first.rkt" ->-internal ->*-internal)
(only-in "../contract/private/case-arrow.rkt" case->-internal)
(only-in "../contract/private/arr-i.rkt" ->i-internal)
(only-in "../contract/private/arr-d.rkt" ->d-internal))
(provide make-class/c class/c-late-neg-proj
blame-add-method-context blame-add-field-context blame-add-init-context
class/c ->m ->*m ->im ->dm case->m object/c instanceof/c
class/c ->m ->*m ->dm case->m object/c instanceof/c
make-wrapper-object
check-object-contract
(for-syntax parse-class/c-specs)
@ -45,12 +44,6 @@
(case->-internal (syntax/loc stx (case->m . args))
#|method?|# #t)]))
(define-syntax (->im stx)
(syntax-case stx ()
[(_ . args)
(->i-internal (syntax/loc stx (->im . args))
#|method?|# #t)]))
(define-syntax (->dm stx)
(syntax-case stx ()
[(_ . args)

2
racket/collects/racket/private/class-internal.rkt
View File

@ -64,7 +64,7 @@
method-in-interface? interface->method-names class->interface class-info
(struct-out exn:fail:object)
make-primitive-class
class/c ->m ->*m ->im ->dm case->m object/c instanceof/c
class/c ->m ->*m ->dm case->m object/c instanceof/c
dynamic-object/c
class-seal class-unseal