Chapter 12. Classes and Objects

Almost every modern programming language has an object-oriented extension or variant available. Some languages, such as SmallTalk and Ruby are “pure” OO languages in that everything in the language is an object29. Other languages such as Perl and this PScheme implementation add OO features to what is essentially a procedural core.

Every object implementation has its peculiarities. There are a lot of trade-offs and choices to be made. Most of these differences come down to issues of visibility of object components from other parts of a program: should the fields of an object be visible at all outside of that object? Should an object be able to see the fields in an object it inherits from? Should an object of a particular class be able to see fields of another object of the same class? Should certain methods of an object be hidden from the outside world? from its descendants?

The implementation discussed here makes choices in order to leverage existing code. Those choices result in a particular OO “style”. I've also decided, somewhat perversely, to be as different from the Perl 5 object implementation as possible within the constraints imposed, in order to give the reader a sense of the different choices that are available.

12.1. Features of this implementation

Rather than listing the features up front, let's start off with some examples of the extension in action, showing its syntax etc. We can pick up the semantics as we go along.

First of all a new special form called make-class creates a new class. It returns that new class as its value. The syntax of make-class is:

(make-class ‹parent-expression› (‹field› ...) ‹method› ...)

[download]

‹parent-expression› is an expression evaluating to another class. Each ‹field› is a symbol naming one of the object's fields. Each ‹method› has the form:

(‹name› (‹arg› ...) ‹body›)

[download]

where ‹name› is the name of the method, the ‹arg›s are the arguments, and ‹body› is the body, much like lambda expressions. Also, somewhat like lambda expressions, but not identically, method bodies capture the lexical environment current when the class is created.

The system provides a pre-built root class to act as a starting point for any class hierachy. That class is bound to the symbol root.

So here is how we might create a crude “bank account” class:

(define Account
    (make-class
        root
        (balance)
        (init (amount) (set! balance amount))
        (deposit (amount) (set! balance (+ balance amount)))
        (withdraw (amount) (set! balance (- balance amount)))
        (balance () balance)
        (clone () (class balance))))

[download]

make-class returns the new class, and we bind that to the symbol Account with define.

Our new Account descends directly from the root class. It has a single balance field, and five methods called init, deposit, withdraw, balance and clone. Note that there is no conflict between the field called balance and the method of the same name: methods exist in a separate namespace.

The init method is special. It will get called whenever a new object is created. It should normally assign values to the object's fields, since they initially all have a value of zero.

We'll come back to that clone method in a bit.

Creating instances of Account simply involves invoking the Account class with whatever arguments its init method takes. It will return an object of class Account, suitably initialised:

(define my-account (Account 20))

[download]

This creates an object of class Account with an initial balance of 20, since init assigns the argument 20 to the balance field. define binds the new object to the symbol my-account.

This starts to explain that mysterious clone method. All methods have access to a special variable called class, that refers to the class of the object; this has some parallels with the Perl __PACKAGE__ identifier. So clone need only call (class balance) to create a copy of the current object.

To call a method on an object you invoke the object, with the method name as the first argument and arguments to the method itself as the remaining arguments:

(my-account deposit 10)

[download]

The deposit method takes the argument 10 and adds it to the existing balance.

12.1.1. Inheritance

Classes and objects wouldn't be much fun without inheritance, so here's an example of a derived class:

(define InterestAccount
    (make-class
        Account
        (rate)
        (init (interest amount)
            (begin (super init amount)
                   (set! rate interest)))
        (accumulate ()
            (this deposit (* (this balance) rate)))))

[download]

Note a few things in particular.

The InterestAccount class can be used as follows:

> (define my-account (InterestAccount 20 2))
my-account
> (my-account deposit 10)
30
> (my-account balance)
30
> (my-account accumulate)
90
> (my-account balance)
90

[download]

Quite a nice rate of interest that is.

12.1.2. Class Variables and Methods

Although there is no direct support for class variables and methods, the fact that classes, and hence methods, capture the current environment allows us to fake them. Here's a variant on the Account class that keeps track of the total amount of money in all account objects:

(define Account
    (let ((total 0))
        (make-class
            root
            (balance)
            (set-balance (op amount)
                (begin (set! balance (op balance amount))
                       (set! total (op total amount))))
            (init (amount) (this set-balance + amount))
            (deposit (amount) (this set-balance + amount))
            (withdraw (amount) (this set-balance - amount))
            (balance () balance)
            (total () total))))

[download]

The let binds total to an initial value of 0 then evaluates the make-class construct in this new environment. The newly created class captures that environment. That new class is then returned by the let expression and bound to Account.

Every instance of Account will share the lexically scoped variable total. Rather than change each of init, deposit and withdraw to individually maintain both the value of total and balance, a new method set-balance has been added. It takes an operation op (+ or -) and an amount and applies the operation with the amount separately to both the balance and the total. The init, deposit and withdraw methods have been modified to use this new method, and another new method, total, provides read-only access to the value of total.

12.1.3. super Calls

We're not quite finished with the details. There's one last wrinkle to deal with reguarding that super object mentioned earlier. Although on the surface it may appear to behave just like any other object, a call to a method on the super object cannot just be a simple method invocation. If it was, then this in the called method would be the object referred to by super in the calling method. Instead the this in the called method should continue to refer to the this that was current before the super call. To make that clear, consider a rather contrived example:

> (define cat
>    (make-class
>        root
>        ()
>        (poke () (this respond))
>        (respond () 'purr)
>    ))
cat
> (define lion
>    (make-class
>        cat
>        ()
>        (poke () (super poke))
>        (respond () 'roar)
>    ))
lion
> (define leo (lion))
leo
> (leo poke)
roar

[download]

12.1.4. Feature Summary

Here's a summary, then, of the main features of our implementation

12.2. Implementation

So how do we go about implementing this extension? Well, to be frank, in a fairly ad hoc way. It should be obvious that PScheme objects have a lot in common with environments, namely that they store the values of variables. Our existing environment implementation can easilly be pressed in to service as a PScheme object. In fact in this implementation objects are environments, or rather, chains of environments linked via a super field where each individual environment represents an instance of the equivalent class in the class hierachy.

We need only add a couple of methods to our existing environment implementation to get all we need.

Of course we need an object to represent PScheme classes, but that is just going to contain the parent PScheme class, the fields and methods of the class, and the environment that was current at the point of its creation. That nascent PScheme Class package will need an Apply() method that will create PScheme objects on demand, passing any arguments to that object's nearest init method.

That is pretty much all we need to do. Methods can act just like closures but will extend the environment representing the object when they are called. There are a few fiddly details around method invocation on a super object, but we'll deal with that later.

12.2.1. Class Creation with make-class

Starting from the top, the special form (make-class ‹parent-expr› (‹field›...) ‹method›...) is simple to implement, it just returns an instance of that yet to be described PScm::Class object. Hopefully it's not too counterintuitive that PScheme classes are in fact Perl objects. Here's the implementation of make-class in a new PScm::SpecialForm::MakeClass package:

178 package PScm::SpecialForm::MakeClass;
179 
180 use base qw(PScm::SpecialForm);
181 
182 sub Apply {
183     my ($self, $form, $env) = @_;
184 
185     my $parent_expr = $form->first;
186     my $fields = $form->rest->first;
187     my $methods = $form->rest->rest;
188     my $parent_class = $parent_expr->Eval($env);
189     return PScm::Class->new($parent_class,
190                             $fields,
191                             $methods,
192                             $env);
193 }
194 
195 1;

As is usual for a special form it just has an Apply() method. On Line 185 that unpacks the parent expression, fields and methods from the argument $form, and on Line 188 it evaluates the parent expression in the current environment to get an actual parent class (PScm::Class) object. Finally on Line 189 it returns a new instance of PScm::Class capturing those values and the current environment.

The new() method in PScm::Class doesn't do anything too clever either, On Line 10 it declares a hashref $rh_methods, and then on Line 11 it calls a helper static method _populate_methods_hash() which will chop up the PScheme methods into names, arguments and bodies, storing each pair of args and body in the hash keyed on the PScheme method name. Then starting on Line 13 it returns a new instance containing that hash along with the parent PScheme class, fields and current environment:

  7 sub new {
  8     my ($class, $parent, $fields, $methods, $env) = @_;
  9 
 10     my $rh_methods = {};
 11     $class->_populate_methods_hash($rh_methods, $methods);
 12 
 13     return bless {
 14         parent  => $parent,
 15         fields  => [$fields->value],
 16         methods => $rh_methods,
 17         env     => $env,
 18     }, $class;
 19 }

Here's _populate_methods_hash():

 21 sub _populate_methods_hash {
 22     my ($class, $rh_methods, $methods) = @_;
 23     if ($methods->is_pair) {
 24         my $method = $methods->first;
 25         my ($name, $args, $body) = $method->value;
 26         $rh_methods->{ $name->value } =
 27                 { args => $args, body => $body };
 28         $class->_populate_methods_hash($rh_methods, $methods->rest);
 29     }
 30 }

That's it for make-class. Following our previous course, we next need to look at PScheme object creation, which occurs when a PScheme class is invoked with arguments intended for its init method: (‹class› ‹arg›...).

12.2.2. Object Creation

It's probably worth stepping back at this stage to clarify how our environments will be arranged into objects. As I've already mentioned each PScheme object (environment) extends the environment that was captured by its class. Furthermore each PScheme object (environment) has a super field referring to the anonymous PScheme object created by its parent PScheme class.

That means we end up with a situation something like Figure 12.1

Figure 12.1. Notional object structure
figure

Although this figure does not tell the whole story, it at least emphasizes that a PScheme object consists of a number of environment frames, one for each class in the equivalent PScheme class hierachy, but those environment frames are connected not by a direct parent/child relationship but via an ordinary variable in each frame called super. The environment frames representing each object extend the environment that their respective classes captured. This is implied, but not shown, by the unterminated arrows in the figure.

So we were about to take a look at how PScheme classes create PScheme objects. Classes create objects when they are invoked as (‹class› ‹arg›...). To make anything invokeable we just need give it an Apply() method, and here's the one for PScm::Class:

 32 sub Apply {
 33     my ($self, $form, $env) = @_;
 34 
 35     my $new_object = $self->make_instance();
 36     $new_object->call_method($new_object, "init", $form, $env);
 37     return $new_object;
 38 }

On Line 35 it calls a make_instance() method to create a new PScheme object (really a PScm::Env). Then on Line 36 it calls the PScm init method of the new object. This is done using a call_method() method of PScm::Env. This takes the PScheme object on which the method is being invoked ($new_object, which will be passed to the PScheme method as this), the name of the PScheme method ("init"), and the arguments to the method itself ($form and $env.) We'll look at call_method() later.

The make_instance() method of PScm::Class must recurse down to the root of the PScheme class hierachy, creating a chain of anonymous PScheme objects on the way back up, each linked to its parent by a super field. Here it is:

 40 sub make_instance {
 41     my ($self) = @_;
 42 
 43     my $parent_instance = $self->{parent}->make_instance();
 44 
 45     return $self->{env}->ExtendUnevaluated(
 46         new PScm::Expr::List(
 47             PScm::Expr::Symbol->new("class"), # $self
 48             PScm::Expr::Symbol->new("super"), # $parent_instance
 49             @{ $self->{fields} },             # 0...
 50         ),
 51         new PScm::Expr::List(
 52             $self,                                                 # "class"
 53             PScm::Env::Super->new(super => $parent_instance),      # "super"
 54             ((PScm::Expr::Number->new(0)) x @{ $self->{fields} }), # field...
 55         )
 56     );
 57 }

The first thing it does, on Line 43 is to call its parent PScheme class' make_instance() method to get an instance of its parent class. Then starting on Line 45 the rest of the method extends the environment that the PScm::Class object captured when it was created, with appropriate bindings from class to $self, super to the $parent_instance and from each of the PScheme classes fields to initial values of zero. It is this new environment that is returned by make_instance().

If you were reading the above code carefully, you'd have noticed that the super field does not link directly to the parent instance, but via a derivative of PScm::Env called PScm::Env::Super. This is so that the super object can have a separate Apply() method. That gives the lie to our simple picture of environments-as-objects in Figure 12.1. In fact the true situation is shown in Figure 12.2.

Figure 12.2. Real object structure
figure

To keep things simple this figure only shows an object whose immediate parent is root. You can see that the PScheme object is joined to its parent via a PScm::Env::Super object bound to its super field, and that the PScm::Env::Super object also has a super field providing the link to the real parent. Additionally each PScheme object has a class binding referring to the PScheme class that created it. That is a PScm::Class for all but the root object, which has no super binding and has a class binding that refers to a PScm::Class::Root object. PScm::Class::Root is a derivative of PScm::Class, and it is a PScm::Class::Root instance that will be bound to root in the initial environment.

That conveniently brings us back round to the make_instance() method, and how that recursive call to the parent PScheme class' make_instance() is terminated. That happens when it hits the make_instance() method of the PScm::Class::Root package, shown next.

 70 package PScm::Class::Root;
 71 
 72 use base qw(PScm::Class);
 73 
 74 sub new {
 75     my ($class, $env) = @_;
 76 
 77     return bless {
 78         parent  => 0,
 79         fields  => [],
 80         methods => {},
 81         env     => $env,
 82     }, $class;
 83 }
 84 
 85 sub make_instance {
 86     my ($self) = @_;
 87 
 88     return $self->{env}
 89       ->ExtendUnevaluated(
 90           new PScm::Expr::Symbol("class"),
 91           $self
 92       );
 93 }
 94 
 95 1;

The new() method on Lines 74–83 is just meant to be easy to call from the repl where the root class will be initialised. It creates a PScheme class with no parent, no fields, no methods, and whatever env is passed in31.

The make_instance() method on Lines 85–93 is not recursive, it just extends the captured environment with a binding of class to $self (the PScm::Class::Root object,) returning the result. Note that it takes advantage of the fact that ExtendUnevaluated() can cope with a single symbol and value as well as lists of the same.

12.2.3. init Method Invocation

So far we've looked at how PScheme classes are created and how they in turn create PScheme objects. Next we're going to look at how PScheme methods are invoked, starting with the init method.

If you remember, the PScheme init method is called by PScm::Class::Apply() when creating a new object, by calling call_method() on the instance $new_object returned by PScm::Class::make_instance(). Since $new_object is a PScm::Env, call_method() must be a method of PScm::Env, and here it is.

168 sub call_method {
169     my ($self, $this, $method_name, $args, $env) = @_;
170 
171     if (my $method = $self->_lookup_method($method_name)) {
172         return $method->ApplyMethod($this, $args, $env);
173     }
174 }

call_method() is passed both the “real” perl object $self and the object representing PScheme's idea of the current object, $this, that the PScheme method is being invoked on. Normally these are one and the same. Additionally it is passed the method name, arguments and another environment in which the arguments are to be evaluated if a method is found. On Line 171 it uses _lookup_method() (discussed next) to find the method, and if found then on Line 172 it invokes the PScheme method by calling its ApplyMethod() and returns the result. If no method can be found it returns undef, and since in the case of PScm::Class' Apply() the result of calling init is discarded anyway, it is not fatal if an init method is not found.

_lookup_method() employs a simple strategy to locate a method. First it checks in the current PScheme object's class, and if it can't find the method there, it recurses to its super object. That leads to the equally simple definition below.

136 sub _lookup_method {
137     my ($self, $method_name) = @_;
138 
139     return $self->_lookup_method_here($method_name)
140       || $self->_lookup_method_in_super($method_name);
141 }

So _lookup_method() breaks down into two simpler methods: _lookup_method_here() and _lookup_method_in_super(), which it tries in turn. _lookup_method_here() is similarily simple.

143 sub _lookup_method_here {
144     my ($self, $method_name) = @_;
145 
146     if (exists $self->{bindings}{class}) {
147         return $self->{bindings}{class}
148           ->get_method($method_name, $self);
149     }
150 }

It checks to see if the current object has a class binding, and if so it calls get_method() on the class, returning the result. get_method() will return undef if it can't find the method in the class, and _lookup_method_here() returns undef if there is no class binding.

_lookup_method_in_super() is equally simple.

152 sub _lookup_method_in_super {
153     my ($self, $method_name) = @_;
154 
155     if (exists $self->{bindings}{super}) {
156         return $self->{bindings}{super}
157           ->_lookup_method($method_name);
158     }
159 }

It checks to see if the current PScheme object has a super, and if so it calls _lookup_method() on it. Otherwise it returns undef.

Since _lookup_method(), _lookup_method_here() and _lookup_method_in_super() are all methods of PScm::Env, they are all available to PScm::Env::Super where they work without modification: super objects have a super field but no class field.

Going back to _lookup_method_here(), if that found a class binding, it called get_method() on the PScheme class, passing it the method name to look for, and perhaps less obviously, $self as well. Here's what get_method() back in PScm::Class does with those arguments.

 59 sub get_method {
 60     my ($self, $method_name, $object) = @_;
 61 
 62     if (exists $self->{methods}{$method_name}) {
 63         return PScm::Closure::Method->new(
 64             $self->{methods}{$method_name}{args},
 65             $self->{methods}{$method_name}{body}, $object);
 66     }
 67 }

On Line 62 it looks in its methods subhash for a key matching the string $method_name. If it finds one it knows it has found the method and returns a new instance of PScm::Closure::Method, a closure just like a lambda expression, containing the relevant method args and method body from the subhash, and most importantly capturing the environment $object. Reasoning backwards, this is correct, $object (the $self from _lookup_method_here()) is the environment in which the method was found, (via class) and that is the environment that the method should extend when it executes, so that the method body can “see” the fields of the object.

I'd just like to emphasize a point here, the object $object passed to get_method() is not necessarily the same as the this that will be passed to the method when it executes. That would only be true if the method was found in the first PScheme object that _lookup_method() looked in.

There's very little left to cover now. We just need to take a look at PScm::Closure::Method. This is a subclass of PScm::Closure, as you can see.

 67 package PScm::Closure::Method;
 68 
 69 use base qw(PScm::Closure);
 70 
 71 sub new {
 72     my ($class, $args, $body, $env) = @_;
 73 
 74     bless {
 75         args => PScm::Expr::List->Cons(
 76             PScm::Expr::Symbol->new("this"), $args
 77         ),
 78         body => $body,
 79         env  => $env,
 80     }, $class;
 81 }
 82 
 83 sub ApplyMethod {
 84     my ($self, $this, $form, $env) = @_;
 85     my $evaluated_args = $form->map_eval($env);
 86     return $self->_apply(PScm::Expr::List->Cons($this, $evaluated_args));
 87 }
 88 
 89 1;

The new() method on Lines 71–81 is the one we just saw being called by get_method(). What differentiates it from the normal PScm::Closure::Function new() method is that on Line 75 it prepends the symbol this to the argument list as it constructs the closure. That “implicit” argument will be supplied by ApplyMethod() which you can also see in this package.

The defining feature of a closure is that it captures an environment when it is created and extends it when it is executed. These method closures are no different, but the environment that they capture is the object in whose class the method was found. Hence method bodies can see the fields of the object as normal variables: they are normal variables.

ApplyMethod() also behaves pretty much like the normal closure's Apply(), but it differs in having an extra $this argument. On Line 85 it calls map_eval() on the argument $form with the current environment to get a list of evaluated arguments, just as the normal closure's Apply() does. But then on Line 86 it prepends $this (the PScheme this) to those actual arguments when calling the generic PScm::Closure _apply() method. This ties in with the new() method having supplied an extra symbol this to the list of formal arguments.

We've now covered everything to do with PScheme object creation and initialisation in PScheme. Along the way we've seen, by following the process of calling an object's init method, most of the machinery behind method invocation. There are only two remaining details to fill in.

12.2.4. General Method Invocation

The first of those is normal PScheme method invocation. That is done by invoking the object with the method name and arguments, for example:

(my-account deposit 10)

[download]

Since objects (environments) are now directly invokeable, they too must have an Apply() method, shown here:

176 sub Apply {
177     my ($self, $form, $env) = @_;
178 
179     my ($method_symbol, $args) = ($form->first, $form->rest);
180     my $res =
181       $self->call_method($self, $method_symbol->value, $args, $env);
182 
183     if (defined $res) {
184         return $res;
185     } else {
186         die "method ", $method_symbol->value, " not found\n";
187     }
188 }

On Line 179 it splits the argument $form into a method name (a symbol) and a list of arguments to the method. Then on Line 181 it attempts to call the method, and collects the result. Now the result will only be undefined if a method could not be found, in which case an exception is raised. Otherwise the result is returned.

12.2.5. super Method Invocation

The only remaining piece is invocation of a PScheme method on a super object. super is bound to a PScm::Env::Super instance, which in turn has a super binding referring to the next object in the chain. Here's PScm::Env::Super:

191 package PScm::Env::Super;
192 
193 use base qw(PScm::Env);
194 
195 sub Apply {
196     my ($self, $form, $env) = @_;
197 
198     my ($method, $args) = ($form->first, $form->rest);
199     my $this = $env->LookUp(PScm::Expr::Symbol->new("this"));
200     my $res  =
201       $self->call_method($this, $method->value, $args, $env);
202 
203     if (defined $res) {
204         return $res;
205     } else {
206         die "method ", $method->value, " not found in super\n";
207     }
208 }
209 
210 1;

If you compare the Apply() method here with the one in PScm::Env above, you can see they differ in that on Line 199 the Apply() looks up this in the current environment. Then on Line 201 it passes $this instead of $self to call_method(). The upshot of that is the variable $this will be the one that gets bound to the implicit this argument to the PScheme method when it is invoked.

12.2.6. Wiring it up

And finally, we just need to see how the new object code is wired into the repl. Here's ReadEvalPrint() for version 0.0.9 of our interpreter.

 32 sub ReadEvalPrint {
 33     my ($infh, $outfh) = @_;
 34 
 35     $outfh ||= new FileHandle(">-");
 36     my $reader      = new PScm::Read($infh);
 37     my $initial_env = new PScm::Env(
 38         let          => new PScm::SpecialForm::Let(),
 39         '*'          => new PScm::Primitive::Multiply(),
 40         '-'          => new PScm::Primitive::Subtract(),
 41         '+'          => new PScm::Primitive::Add(),
 42         if           => new PScm::SpecialForm::If(),
 43         lambda       => new PScm::SpecialForm::Lambda(),
 44         list         => new PScm::Primitive::List(),
 45         car          => new PScm::Primitive::Car(),
 46         cdr          => new PScm::Primitive::Cdr(),
 47         cons         => new PScm::Primitive::Cons(),
 48         letrec       => new PScm::SpecialForm::LetRec(),
 49         'let*'       => new PScm::SpecialForm::LetStar(),
 50         eval         => new PScm::SpecialForm::Eval(),
 51         macro        => new PScm::SpecialForm::Macro(),
 52         quote        => new PScm::SpecialForm::Quote(),
 53         'set!'       => new PScm::SpecialForm::Set(),
 54         begin        => new PScm::SpecialForm::Begin(),
 55         define       => new PScm::SpecialForm::Define(),
 56         'make-class' => new PScm::SpecialForm::MakeClass(),
 57     );
 58 
 59     $initial_env->Define(
 60         PScm::Expr::Symbol->new("root"),
 61         PScm::Class::Root->new($initial_env)
 62     );
 63 
 64     while (defined(my $expr = $reader->Read)) {
 65         my $result = $expr->Eval($initial_env);
 66         $result->Print($outfh);
 67     }
 68 }

The changes are in bold. On Line 41 I finally caved in and added primitive addition as a builtin. I leave it to the reader to do the same. On Line 56 you can see the additional binding of make-class to a PScm::SpecialForm::MakeClass object, and on Line 59 we attach a new PScm::Class::Root to the symbol root in the initial environment. That needs to be done using Define() because we need to pass the value of $initial_env to the new() method of PScm::Class::Root

12.3. Summary and Variations

This object extension added new methods to PScm::Env to allow environments to behave as operators within the language. It added new classes PScm::SpecialForm::MakeClass to implement the make-class special form, PScm::Class and PScm::Class::Root to host our PScheme class code, PScm::Env::Super to provide an alternative Apply() method for super method invocation, and PScm::Closure::Method for the modified closure behaviour of PScheme methods. To summarise:

Listing 22. PScm/Class.pm
  1 package PScm::Class;
  2 
  3 use strict;
  4 use warnings;
  5 use base qw(PScm);
  6 
  7 sub new {
  8     my ($class, $parent, $fields, $methods, $env) = @_;
  9 
 10     my $rh_methods = {};
 11     $class->_populate_methods_hash($rh_methods, $methods);
 12 
 13     return bless {
 14         parent  => $parent,
 15         fields  => [$fields->value],
 16         methods => $rh_methods,
 17         env     => $env,
 18     }, $class;
 19 }
 20 
 21 sub _populate_methods_hash {
 22     my ($class, $rh_methods, $methods) = @_;
 23     if ($methods->is_pair) {
 24         my $method = $methods->first;
 25         my ($name, $args, $body) = $method->value;
 26         $rh_methods->{ $name->value } =
 27                 { args => $args, body => $body };
 28         $class->_populate_methods_hash($rh_methods, $methods->rest);
 29     }
 30 }
 31 
 32 sub Apply {
 33     my ($self, $form, $env) = @_;
 34 
 35     my $new_object = $self->make_instance();
 36     $new_object->call_method($new_object, "init", $form, $env);
 37     return $new_object;
 38 }
 39 
 40 sub make_instance {
 41     my ($self) = @_;
 42 
 43     my $parent_instance = $self->{parent}->make_instance();
 44 
 45     return $self->{env}->ExtendUnevaluated(
 46         new PScm::Expr::List(
 47             PScm::Expr::Symbol->new("class"), # $self
 48             PScm::Expr::Symbol->new("super"), # $parent_instance
 49             @{ $self->{fields} },             # 0...
 50         ),
 51         new PScm::Expr::List(
 52             $self,                                                 # "class"
 53             PScm::Env::Super->new(super => $parent_instance),      # "super"
 54             ((PScm::Expr::Number->new(0)) x @{ $self->{fields} }), # field...
 55         )
 56     );
 57 }
 58 
 59 sub get_method {
 60     my ($self, $method_name, $object) = @_;
 61 
 62     if (exists $self->{methods}{$method_name}) {
 63         return PScm::Closure::Method->new(
 64             $self->{methods}{$method_name}{args},
 65             $self->{methods}{$method_name}{body}, $object);
 66     }
 67 }
 68 
 69 ##########################
 70 package PScm::Class::Root;
 71 
 72 use base qw(PScm::Class);
 73 
 74 sub new {
 75     my ($class, $env) = @_;
 76 
 77     return bless {
 78         parent  => 0,
 79         fields  => [],
 80         methods => {},
 81         env     => $env,
 82     }, $class;
 83 }
 84 
 85 sub make_instance {
 86     my ($self) = @_;
 87 
 88     return $self->{env}
 89       ->ExtendUnevaluated(
 90           new PScm::Expr::Symbol("class"),
 91           $self
 92       );
 93 }
 94 
 95 1;

Since the new PScm::Class has a file to itself there's a full listing in Listing 22.

To recap, let's consider our original example classes: Account and InterestAccount

Figure 12.3. Example classes and objects
figure

Figure 12.3 shows the situation after the creation of the Account and InterestAccount classes, and the my-account instance of an InterestAccount that was discussed in the examples in Section 12.1.

You can see that the my-account object is really just a PScm::Env and its parent env is the global environment (implied by the unterninated heavy arrows.) The my-account object's parent environment is the global environment because that is the environment that the InterestAccount class was created in. If the InterestAccount class had captured a different environment, then that would have been the one that instances of that class extended.

Note the three bindings in the my-account object. The rate variable is the one supplied by the class definition, the other two, super and class are automatically provided by the implementation when new objects are created.

The super variable refers to a PScm::Env::Super object, derived from PScm::Env, which in turn has a super variable, and differs from PScm::Env only in its Apply() method, which arranges to forward the current value of this (rather than the super object itself) to the called method.

The class variable refers to a PScm::Class object which contains field (variable) names, method names along with their definitions, the environment that was current at the time of the creation of the PScm::Class, and a parent field pointing at the parent PScheme class.

12.4. Tests

Listing 23. t/PScm_OO.t
  1 use strict;
  2 use warnings;
  3 use Test::More;
  4 use lib 't/lib';
  5 use PScm::Test tests => 6;
  6 
  7 BEGIN { use_ok('PScm') }
  8 
  9 
 10 eval_ok(<<EOF, "account", 'classes');
 11 (define account
 12     (make-class root (amount)
 13            (init (x) (set! amount x))
 14     ))
 15 EOF
 16 
 17 eval_ok(<<EOF, <<EOR, 'objects');
 18 (define account
 19     (make-class
 20            root
 21            (balance)
 22            (init (x) (set! balance x))
 23            (balance () balance)
 24            (withdraw (x) (set! balance (- balance x)))
 25     ))
 26 (define myaccount (account 10))
 27 (myaccount balance)
 28 (myaccount withdraw 2)
 29 (myaccount balance)
 30 EOF
 31 account
 32 myaccount
 33 10
 34 8
 35 8
 36 EOR
 37 
 38 eval_ok(<<EOF, <<EOR, 'inheritance');
 39 (define account
 40     (make-class
 41            root
 42            (balance)
 43            (init (x) (set! balance x))
 44            (balance () balance)
 45            (withdraw (x) (set! balance (- balance x)))
 46            (deposit (x) (set! balance (+ balance x)))
 47     ))
 48 (define interest-account
 49     (make-class
 50            account
 51            (rate)
 52            (init (x r)
 53                 (begin
 54                     (super init x)
 55                     (set! rate r)))
 56            (accumulate ()
 57                 (this deposit (* (this balance) rate)))
 58     ))
 59 (define myaccount (interest-account 10 2))
 60 (myaccount balance)
 61 (myaccount withdraw 2)
 62 (myaccount balance)
 63 (myaccount accumulate)
 64 (myaccount balance)
 65 EOF
 66 account
 67 interest-account
 68 myaccount
 69 10
 70 8
 71 8
 72 24
 73 24
 74 EOR
 75 
 76 eval_ok(<<EOF, <<EOR, 'class variables');
 77 (define counter-class
 78     (let ((count 0))
 79         (make-class
 80             root
 81             ()
 82             (init () (set! count (+ count 1)))
 83             (count () count)
 84         )))
 85 (define o1 (counter-class))
 86 (o1 count)
 87 (let ((o2 (counter-class))
 88       (o3 (counter-class)))
 89      (o1 count))
 90 EOF
 91 counter-class
 92 o1
 93 1
 94 3
 95 EOR
 96 
 97 eval_ok(<<EOF, <<EOR, 'super calls');
 98 (define c1
 99    (make-class
100        root
101        ()
102        (ma () (this mb))
103        (mb () 0)
104    ))
105 (define c2
106    (make-class
107        c1
108        ()
109        (ma () (super ma))
110        (mb () 1)
111    ))
112 ((c2) ma)
113 EOF
114 c1
115 c2
116 1
117 EOR
118 
119 # vim: ft=perl

Tests for our OO extension are in Listing 23.

The first test exercizes the creation of a class. The second test creates a class (our account class from the examples above) then creates an object from it and calls a couple of its methods. The third test uses the interest-account example that we've looked at to test inheritance. The fourth test demonstrates that lexical variables outside of a class are visible to its methods and can therefore be used as class variables. Finally, the fifth test uses an abstract form of that “leo” example to demonstrate that method calls on a super object persist the current value of this.

Full source code for this version of the interpreter is available at
http://billhails.net/Book/releases/PScm-0.0.9.tgz
Last updated Sun Mar 14 10:43:08 2010 UST
29

If you don't know SmallTalk, you might be surprised at how far that statement goes. Not only are the simple numeric and string data types objects, but arrays, hashes (called Dictionaries), booleans, code blocks, exceptions and even classes are objects in SmallTalk. Furthermore even the simplest operations such as addition are methods: adding 2 + 2 involves sending the object 2 the message + with argument 2, and conditional expressions like if are implemented by sending a boolean object representing the condition a message ifTrue with argument the code block to execute if the condition is true. See [sttl] if you want more information.

30

We could have chosen the name self instead, to make the examples easier for perl programmers to read, but the perl under the hood might start to get ugly.

31

It's actually redundant for that root environment to have a class binding or a parent environment, since the root class currently has no methods. However if we did want to extend the implementation to add generic methods to the root class then all the pieces we need are in place, so we can accept that redundancy for now.