Since most readers will be familiar with a other object systems, we begin with an example use of MzScheme's object system to illustrate its particular style.
(define stack<%> (interface () push! pop! empty?))
(define stack%
(class* null (stack<%>) ()
(private
[stack null]) ; A private instance variable
(public
[name 'stack] ; A public instance variable
[push! (lambda (v)
(set! stack (cons v stack)))]
[pop! (lambda ()
(let ([v (car stack)])
(set! stack (cdr stack))
v))]
[empty? (lambda ()
(null? stack))]
[print-name (lambda ()
(display name) (newline))])))
(define named-stack%
(class stack% (stack-name)
(public
[name stack-name])
(sequence
(super-init))))
(define double-stack%
(class stack% ()
(inherit push!)
(public
[name 'double-stack]
[double-push! (lambda (v)
(push! v)
(push! v))])
(sequence (super-init))))
(define-values (make-safe-stack-class is-safe-stack?)
(let ([safe-stack<%> (interface (stack<%>))])
(values
(lambda (super%)
(class* super% (safe-stack<%>) ()
(inherit empty?)
(rename [std-pop! pop!])
(public
[name 'safe-stack]
[pop! (lambda ()
(if (empty?) #f (std-pop!)))])
(sequence (super-init))))
(lambda (obj)
(implementation? (object-class obj) safe-stack<%>)))))
(define safe-stack% (make-safe-stack-class stack%))
The interface stack<%>
describes the usual stack
implementation with push!, pop!, and
empty? methods. The class stack%
implements this interface in the usual way. Three classes
are derived from this basic implementation:
The creation of safe-stack% illustrates the use of classes as first-class values. Applying make-safe-stack-class to named-stack% or double-stack% -- indeed, any class with push, pop!, and empty? methods -- creates a ``safe'' version of the class. A stack object can be recognized as a safe stack by testing it with is-safe-stack?; this predicate returns #t only for instances of a class created with make-safe-stack-class (because only those classes implement the safe-stack<%> interface).
In each of the example classes, the instance variable name contains the name of the class. The name declarations in named-stack%, double-stack%, and safe-stack% override the declaration in stack%. Thus, when the print-name method of an object from double-stack% is invoked, the name printed to the screen is ``double-stack''.
While all of named-stack%, double-stack%, and safe-stack% inherit the push! method of stack%, it is declared with inherit only in double-stack%; this is because new declarations in named-stack% and safe-stack% do not need to refer to push!, so the inheritance does not need to be declared. Similarly, only safe-stack% needs to declare (inherit empty?).
The safe-stack% class overrides pop! to extend the implementation of pop!. The new definition of pop! must access the original pop! method that is defined in stack%. The rename declaration binds a new name, std-pop! to the original pop!. Then, std-pop! is used in the overriding pop!. Variables declared with rename cannot be overridden, so std-pop! will always refer to the superclass's pop!.
The make-object procedure creates an object from a class; additional arguments to make-object are passed on as initialization arguments. Here are some object creations using the classes defined above:
(define stack (make-object stack%))
(define fred (make-object named-stack% 'Fred))
(define joe (make-object named-stack% 'Joe))
(define double-stack (make-object double-stack%))
(define safe-stack (make-object safe-stack%))
Note that an extra argument is given to make-object for the named-stack% class because named-stack% requires one initialization argument (the stack's name).
The ivar and send forms are used to access the instance variables of an object. The ivar form looks up a variable by name. The send form uses ivar to extract a variable's value, which should be a procedure; it then applies the procedure to arguments. For example, here is a simple expression that uses the objects created above:
((ivar stack push!) fred) ; or (send stack push! fred)
(send stack push! double-stack)
(let loop ()
(if (not (send stack empty?))
(begin
(send (send stack pop!) print-name)
(loop))))
This loop displays 'double-stack and 'Fred to the standard output port.