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

Add this%, which is the class counterpart of the object reference "this".

Browse Source 
svn: r17359
This commit is contained in:
Stevie Strickland 2009-12-19 20:56:40 +00:00
parent b7efdd59a5
commit fb85388288
4 changed files with 88 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
collects/scheme/private/class-internal.ss
View File

@ -61,7 +61,7 @@
public-final override-final augment-final
field init init-field init-rest
rename-super rename-inner inherit inherit/super inherit/inner inherit-field
this super inner
this this% super inner
super-make-object super-instantiate super-new
inspect))
@ -170,6 +170,7 @@
(define/provide-context-keyword
[this this-param]
[this% this%-param]
[super super-param]
[inner inner-param]
[super-make-object super-make-object-param]
@ -229,6 +230,7 @@
(quote-syntax super)
(quote-syntax inner)
(quote-syntax this)
(quote-syntax this%)
(quote-syntax super-instantiate)
(quote-syntax super-make-object)
(quote-syntax super-new)
@ -1334,7 +1336,9 @@
(syntax-parameterize
([this-param (make-this-map (quote-syntax this-id)
(quote-syntax the-finder)
(quote the-obj))])
(quote the-obj))]
[this%-param (make-this%-map (quote-syntax (object-ref this))
(quote-syntax the-finder))])
(let-syntaxes
mappings
(syntax-parameterize

16
collects/scheme/private/classidmap.ss
View File

@ -45,6 +45,20 @@
stx)]
[id (find the-finder the-obj stx)])))))
(define (make-this%-map replace-stx the-finder)
(let ([set!-stx (datum->syntax the-finder 'set!)])
(make-set!-transformer
(λ (stx)
(syntax-case stx ()
[(set! id expr)
(free-identifier=? #'set! set!-stx)
(raise-syntax-error 'class "cannot mutate this% identifier" stx)]
[id
(identifier? #'id)
(quasisyntax/loc stx #,replace-stx)]
[(f . args)
(quasisyntax/loc stx (#,replace-stx . args))])))))
(define (make-field-map trace-flag the-finder the-obj the-binder the-binder-localized
field-accessor field-mutator field-pos/null)
(let ([set!-stx (datum->syntax the-finder 'set!)])
@ -356,7 +370,7 @@
finalize-call-event))))
(qstx (app method object . args)))))
(provide (protect-out make-this-map make-field-map make-method-map
(provide (protect-out make-this-map make-this%-map make-field-map make-method-map
make-direct-method-map
make-rename-super-map make-rename-inner-map
make-init-error-map make-init-redirect super-error-map

29
collects/scribblings/reference/class.scrbl
View File

@ -357,6 +357,7 @@ flattened for top-level and embedded definitions.
Within a @scheme[class*] form for instances of the new class,
@scheme[this] is bound to the object itself;
@scheme[this%] is bound to the class of the object;
@scheme[super-instantiate], @scheme[super-make-object], and
@scheme[super-new] are bound to forms to initialize fields in the
superclass (see @secref["objcreation"]); @scheme[super] is
@ -398,6 +399,34 @@ a syntax error.
(send (new table) describe-self)
]}
@defidform[this%]{
Within a @scheme[class*] form, @scheme[this%] refers to the class
of the current object (i.e., the object being initialized or whose
method was called). Use outside the body of a @scheme[class*] form is
a syntax error.
@defexamples[
#:eval class-eval
(define account%
(class object%
(super-new)
(init-field balance)
(define/public (add n)
(new this% [balance (+ n balance)]))))
(define savings%
(class account%
(super-new)
(inherit-field balance)
(define interest 0.04)
(define/public (add-interest)
(send this add (* interest balance)))))
(let* ([acct (new savings% [balance 500])]
[acct (send acct add 500)]
[acct (send acct add-interest)])
(printf "Current balance: ~a\n" (get-field balance acct)))
]}
@defclassforms[
[(inspect inspector-expr) ()]
[(init init-decl ...) ("clinitvars")]

38
collects/tests/mzscheme/object.ss
View File

@ -260,6 +260,7 @@
(class-keyword-test #'super)
(class-keyword-test #'inner)
(class-keyword-test #'this)
(class-keyword-test #'this%)
(class-keyword-test #'super-new)
(class-keyword-test #'super-make-object)
(class-keyword-test #'super-instantiate)
@ -821,6 +822,43 @@
(test 10 (class-field-accessor many-fields% a) om1)
(test 12 (class-field-accessor many-fields% b) om1))
;; ------------------------------------------------------------
;; Test this%
(let ()
(define base%
(class object%
(super-new)
(define/public (factory)
(new this%))))
(define derived%
(class base%
(super-new)
(init-field [f 4])
(define/public (double)
(set! f (* 2 f)))))
(let* ([factory-derived (send (new derived%) factory)])
(test 4 'factory-derived-f (get-field f factory-derived))
(send factory-derived double)
(test 8 'factory-derived-f-doubled (get-field f factory-derived))))
(let ()
(define account%
(class object%
(super-new)
(init-field balance)
(define/public (add n)
(new this% [balance (+ n balance)]))))
(define savings%
(class account%
(super-new)
(inherit-field balance)
(define interest 0.04)
(define/public (add-interest)
(send this add (* interest balance)))))
(let* ([acct (new savings% [balance 500])]
[acct (send acct add 500)]
[acct (send acct add-interest)])
(test 1040.0 'acct-balance (get-field balance acct))))
;; ------------------------------------------------------------
;; Test public*, define-public, etc.