Checkin of current prose so I can switch to trunk and fix a bug.
svn: r18389
This commit is contained in:
parent
3f0f5373dd
commit
5dd72c23c8
|
@ -806,7 +806,7 @@ Using this form in conjunction with trait operators such as
|
||||||
@; Set up uses of contract forms below
|
@; Set up uses of contract forms below
|
||||||
@(class-eval '(require scheme/contract))
|
@(class-eval '(require scheme/contract))
|
||||||
|
|
||||||
@section{Contracts}
|
@section{Class Contracts}
|
||||||
|
|
||||||
As classes are values, they can flow across contract boundaries, and we
|
As classes are values, they can flow across contract boundaries, and we
|
||||||
may wish to protect parts of a given class with contracts. For this,
|
may wish to protect parts of a given class with contracts. For this,
|
||||||
|
@ -878,6 +878,119 @@ on both @scheme[size] and @scheme[eat] are enforced:
|
||||||
(define giant (new (class object% (super-new) (field [size 'large]))))
|
(define giant (new (class object% (super-new) (field [size 'large]))))
|
||||||
(send bob eat giant)]
|
(send bob eat giant)]
|
||||||
|
|
||||||
|
There are two important caveats for these contracts, which we will
|
||||||
|
call @deftech{external class contracts}. First, external method contracts
|
||||||
|
are only enforced when the target of dynamic dispatch is the method
|
||||||
|
implementation of the contracted class, which lies within the contract
|
||||||
|
boundary. Overriding that implementation, and thus changing the target
|
||||||
|
of dynamic dispatch, will mean that the contract is no longer enforced
|
||||||
|
for clients, since accessing the method no longer crosses the contract
|
||||||
|
boundary. Unlike external method contracts, external field contracts
|
||||||
|
are always enforced for clients of subclasses, since fields cannot be
|
||||||
|
overridden or shadowed.
|
||||||
|
|
||||||
|
Second, these contracts do not restrict subclasses of @scheme[animal%]
|
||||||
|
in any way. Fields and methods that are inherited and used by subclasses
|
||||||
|
are not checked by these contracts, and uses of the superclass's methods
|
||||||
|
via @scheme[super] are also unchecked. The following example illustrates
|
||||||
|
both caveats:
|
||||||
|
|
||||||
|
@def+int[
|
||||||
|
#:eval class-eval
|
||||||
|
(define large-animal%
|
||||||
|
(class animal%
|
||||||
|
(super-new)
|
||||||
|
(inherit-field size)
|
||||||
|
(set! size 'large)
|
||||||
|
(define/override (eat food)
|
||||||
|
(display "Nom nom nom") (newline))))
|
||||||
|
(define elephant (new large-animal%))
|
||||||
|
(send elephant eat (new object%))
|
||||||
|
(get-field size elephant)]
|
||||||
|
|
||||||
|
Notice that retrieving the @scheme[size] field from the object
|
||||||
|
@scheme[elephant] blames @scheme[animal%] for the contract violation.
|
||||||
|
This blame is correct, but unfair to the @scheme[animal%] class,
|
||||||
|
as we have not yet provided it with a method for protecting itself from
|
||||||
|
subclasses. To this end we add @deftech{internal class contracts}, which
|
||||||
|
provide directives to subclasses for how they may access and override
|
||||||
|
features of the superclass. We separate external and internal class
|
||||||
|
contracts to allow for weaker contracts within the class hierarchy, where
|
||||||
|
invariants may be broken internally by subclasses but should be enforced
|
||||||
|
for external uses via instantiated objects.
|
||||||
|
|
||||||
|
As a simple example of what kinds of protection are available, we provide
|
||||||
|
an example aimed at the @scheme[animal%] class that uses all the applicable
|
||||||
|
forms:
|
||||||
|
|
||||||
|
@schemeblock[
|
||||||
|
(class/c (field [size positive/c])
|
||||||
|
(inherit-field [size positive/c])
|
||||||
|
[eat (->m edible/c void?)]
|
||||||
|
(inherit [eat (->m edible/c void?)])
|
||||||
|
(super [eat (->m edible/c void?)])
|
||||||
|
(override [eat (->m edible/c void?)]))]
|
||||||
|
|
||||||
|
This class contract not only ensures that objects of class @scheme[animal%]
|
||||||
|
are protected as before, but also ensure that subclasses of @scheme[animal%]
|
||||||
|
only store appropriate values within the @scheme[size] field and use
|
||||||
|
the implementation of @scheme[size] from @scheme[animal%] appropriately.
|
||||||
|
These contract forms only affect uses within the class hierarchy, so the
|
||||||
|
@scheme[override] form does not automatically enter subclasses into
|
||||||
|
obligations when objects of those classes are used. Instead, such contracts
|
||||||
|
are only checked when uses of the method within the superclass dynamically
|
||||||
|
dispatch to the subclass's implementation. The following example shows
|
||||||
|
this difference:
|
||||||
|
|
||||||
|
@schemeblock[
|
||||||
|
(define/contract glutton%
|
||||||
|
(class/c (override [eat (->m edible/c void?)]))
|
||||||
|
(class animal%
|
||||||
|
(super-new)
|
||||||
|
(inherit eat)
|
||||||
|
(define (gulp food-list)
|
||||||
|
(for ([f food-list])
|
||||||
|
(eat f)))))
|
||||||
|
(define sloppy-eater%
|
||||||
|
(class glutton%
|
||||||
|
(super-new)
|
||||||
|
(define/override (eat f)
|
||||||
|
(let ([food-size (get-field size f)])
|
||||||
|
(set! size (/ food-size 2))
|
||||||
|
(set-field! size f (/ food-size 2))
|
||||||
|
f))))]
|
||||||
|
|
||||||
|
@interaction-eval[
|
||||||
|
#:eval class-eval
|
||||||
|
(begin
|
||||||
|
(define/contract glutton%
|
||||||
|
(class/c (override [eat (->m edible/c void?)]))
|
||||||
|
(class animal%
|
||||||
|
(super-new)
|
||||||
|
(inherit eat)
|
||||||
|
(define/public (gulp food-list)
|
||||||
|
(for ([f food-list])
|
||||||
|
(eat f)))))
|
||||||
|
(define sloppy-eater%
|
||||||
|
(class glutton%
|
||||||
|
(super-new)
|
||||||
|
(inherit-field size)
|
||||||
|
(define/override (eat f)
|
||||||
|
(let ([food-size (get-field size f)])
|
||||||
|
(set! size (/ food-size 2))
|
||||||
|
(set-field! size f (/ food-size 2))
|
||||||
|
f)))))]
|
||||||
|
|
||||||
|
@interaction[
|
||||||
|
#:eval class-eval
|
||||||
|
(define pig (new sloppy-eater%))
|
||||||
|
(define slop1 (new animal%))
|
||||||
|
(define slop2 (new animal%))
|
||||||
|
(define slop3 (new animal%))
|
||||||
|
(send pig eat slop1)
|
||||||
|
(get-field size slop1)
|
||||||
|
(send pig gulp (list slop1 slop2 slop3))]
|
||||||
|
|
||||||
@; ----------------------------------------------------------------------
|
@; ----------------------------------------------------------------------
|
||||||
|
|
||||||
@close-eval[class-eval]
|
@close-eval[class-eval]
|
||||||
|
|
Loading…
Reference in New Issue
Block a user