Rosetta Code: Object Oriented Programming Examples

Before we return to the "Web Application Programming" tutorial, let's take a look at the Rosetta Code tasks about Object Oriented Programming, which covers a number of typical tasks and concepts of object-oriented programming.

For the general concept of OOP in PicoLisp, read here:

The Rosetta Code has 18 tasks in total related to Object Oriented Programming. All of them have a PicoLisp solution. You can find them under this link.

We will quickly go through the examples in alphabetic order.

Abstract Type

In OOP, abstract types are types that cannot be instantiated directly. Nevertheless they serve as superclasses for concrete implementations.

In PicoLisp, there is no formal difference between abstract and concrete classes. However, there is a naming convention that abstract classes should start with a lower-case character after the +: This tells the programmer that this class has not enough methods defined to survive on its own.

(class +abstractClass)

(dm someMethod> () 
   (foo)
   (bar) )

Active Object

In object-oriented programming an object is active when its state depends on clock. Usually an active object encapsulates a task that updates the object's state. To the outer world the object looks like a normal object with methods that can be called from outside. Implementation of such methods must have a certain synchronization mechanism with the encapsulated task in order to prevent object's state corruption.

This task is rather complex and too long to post it here. We might go through it in a separate post later. You can see the PicoLisp solution here.

Add a variable to a class instance at runtime

Demonstrate how to dynamically add variables to an object (a class instance) at runtime.

In general, all instance variables in PicoLisp are dynamically created at runtime. We can put a new variable using the put function:

: (setq MyObject (new '(+MyClass)))       # Create some object
-> $385605941

: (put MyObject 'newvar '(some value))    # Set variable
-> (some value)
: (show MyObject)                         # Show the object
$385605941 (+MyClass)
   newvar (some value)
-> $385605941

Break OO Privacy

Show how to access private or protected members of a class in an object-oriented language from outside an instance of the class, without calling non-private or non-protected members of the class as a proxy. The intent is to show how a debugger, serializer, or other meta-programming tool might access information that is barred by normal access methods.

This is realized in PicoLisp using transient symbols. Since we haven't covered the difference between internal, transient and external symbols yet, let's skip this task. If you're interested, check the solution here.

Call an object method

Show how to call a static or class method, and an instance method of a class.

Easy one, we know this already:

(foo> MyClass)
(foo> MyObject)

Classes

Create a basic class with a method, a constructor, an instance variable and how to instantiate it.

Easy one too!

(class +Rectangle)
# dx dy

(dm area> ()  # Define a a method that calculates the rectangle's area
   (* (: dx) (: dy)) )

(println  # Create a rectangle, and print its area
   (area> (new '(+Rectangle) 'dx 3 'dy 4)) )

Constrained genericity

Say a type is called "eatable" if you can call the function eat on it. Write a generic type FoodBox which contains a collection of objects of a type given as parameter, but can only be instantiated on eatable types. The FoodBox shall not use the function eat in any way.

First we define a class +Eatable with the method eat:

(class +Eatable)

(dm eat> ()
   (prinl "I'm eatable") )

Then we define the class +FoodBox. We can place properties into the FoodBox using set>, but only, if this property (object) has the method eat>.

(class +FoodBox)
# obj

(dm set> (Obj)
   (unless (method 'eat> Obj)                # Check if the object is eatable
      (quit "Object is not eatable" Obj) )
   (=: obj Obj) )                            # If so, set the object

Let's try to place an eatable object inside, and a non-eatable (random) object too. The latter one will return an error.

(let (Box (new '(+FoodBox))  Eat (new '(+Eatable))  NoEat (new '(+Bla)))
   (set> Box Eat)       # Works
   (set> Box NoEat) )   # Gives an error

Delegates

A delegate is a helper object used by another object. The delegator may send the delegate certain messages, and provide a default implementation when there is no delegate or the delegate does not respond to a message.

First, we define a class Delegator with a method operation> and a property delegate. If delegate is defined, the method delegate calls the method thing in the delegate object, otherwise it returns "default implementation".

(class +Delegator)
# delegate

(dm operation> ()
   (if (: delegate)
      (thing> @)
      "default implementation" ) )

Next, we define the class +Delegate with a message thing>.

(class +Delegate)
# thing

(dm T (Msg)
   (=: thing Msg) )

(dm thing> ()
   (: thing) )

Now let's test it:

(let A (new '(+Delegator))
   # Without a delegate
   (println (operation> A))

returns "Default Implementation",

   # With delegate that does not implement 'thing>'
   (put A 'delegate (new '(+Delegate)))
   (println (operation> A))

returns NIL, and

# With delegate that implements 'thing>'
   (put A 'delegate (new '(+Delegate) "delegate implementation"))
   (println (operation> A)) )

returns the delegated message: "delegate implementation".

Inheritance/Multiple

Write two classes (or interfaces) Camera and MobilePhone, then write a class CameraPhone which is both a Camera and a MobilePhone.

 (class +Camera)
 (class +MobilePhone)
 (class +CameraPhone +Camera +MobilePhone)

Inheritance/Single

Show a tree of types which inherit from each other. The Tree should look like this:

                        Animal
                          /\
                         /  \
                        /    \
                      Dog    Cat
                      /\
                     /  \
                    /    \
                  Lab  Collie

Solution:

(class +Animal)
(class +Dog +Animal)
(class +Cat +Animal)
(class +Lab +Dog)
(class +Collie +Dog)

Show dependencies using the dep function:

: (dep '+Animal)
+Animal
   +Cat
   +Dog
      +Collie
      +Lab

Object Serialization

Create a set of data types based upon inheritance. Each data type or class should have a print command that displays the contents of an instance of that class to standard output. Create instances of each class in your inheritance hierarchy and display them to standard output.

Write each of the objects to a file named objects.dat in binary form using serialization or marshalling. Read the file
 and print the contents of each serialized object. 

Let's create two classes, +Point and its subclass +Circle. Both have a print> method.

(class +Point)
# x y

(dm T (X Y)
   (=: x (or X 0))
   (=: y (or Y 0)) )

(dm print> ()
   (prinl "Point " (: x) "," (: y)) )

(class +Circle +Point)
# r

(dm T (X Y R)
   (super X Y)
   (=: r (or R 0)) )

(dm print> ()
   (prinl "Circle " (: x) "," (: y) "," (: r)) )

Create objects of each class and print them to standard output:

(setq
   P (new '(+Point) 3 4)
   C (new '(+Circle) 10 10 5) )

(print> P)
(print> C)

# Output:
# Point 3,4
# Circle 10,10,5

Now let's write it to a filme object.dat using the pr function which serializes any kind of data:

(out "objects.dat"
   (pr (val P) (getl P))
   (pr (val C) (getl C)) )

and now let's read it back using the (rd) function:

(in "objects.dat"
   (putl (setq A (box (rd))) (rd))
   (putl (setq B (box (rd))) (rd)) )

Polymorphic Copy

An object is polymorphic when its specific type may vary. The types a specific value may take, is called class.

The task: let a polymorphic object contain an instance of some specific type S derived from a type T. The type T is known. The type S is possibly unknown until run time. The objective is to create an exact copy of such polymorphic object (not to create a reference, nor a pointer to).

PicoLisp: Any object can be copied by transferring the value and the property list. Create an object A and copy it to a new object B:

: (setq A (new '(+Cls1 +Cls2) 'attr1 123  'attr2 "def"  'attr3 (4 2 0)  'attr4 T))
-> $385603635

: (putl (setq B (new (val A))) (getl A))

Then (show A) and (show B) will both return the same output:

$385346595 (+Cls1 +Cls2)
   attr1 123
   attr2 "def"
   attr3 (4 2 0)
   attr4

Polymorphism

Create two classes Point(x,y) and Circle(x,y,r) with a polymorphic function print, accessors for (x,y,r), copy constructor, assignment and destructor and every possible default constructors.

Let's define a class +Point and a subclass +Circle each with a function print> and the initializing function T:

(class +Point)
# x y

(dm T (X Y)
   (=: x (or X 0))
   (=: y (or Y 0)) )

(dm print> ()
   (prinl "Point " (: x) "," (: y)) )

(class +Circle +Point)
# r

(dm T (X Y R)
   (super X Y)
   (=: r (or R 0)) )

(dm print> ()
   (prinl "Circle " (: x) "," (: y) "," (: r)) )

Now the output of print> returns different results depending on the object class:

(setq
   P (new '(+Point) 3 4)
   C (new '(+Circle) 10 10 5) )

(print> P)
(print> C)

returns:

Point 3,4
Circle 10,10,5

Reflection/List methods

The goal is to get the methods of an object, as names, values or both.

This is possible in debug mode using the function methods. Let's open our shape.l-file with the +Rectangle-class definition from the previous post (or from here) and open it with $ pil shape.l +.

After creating a rectangle object R, we can check its methods using (method R). For each method, we can see from which class it is inherited.

: (setq R (new '(+Rectangle) 0 0 30 20)) 
-> $177356065126400

: (methods R)
-> ((draw> . +Rectangle) (perimeter> . +Rectangle) (area> . +Rectangle) (T . +Rectangle) (move> . +Shape))

Reflection/List properties

The goal is to get the properties of an object, as names, values or both.

We re-use the example from above and can check the properties of R using show (unlike the previous example, this is not restricted to debugger).

: (show R)
$177715702441044 (+Rectangle)
   dy 20
   dx 30
   y 0
   x 0
-> $177715702441044

Respond to an unknown method call

Demonstrate how to make the object respond (sensibly/usefully) to an invocation of a method on it that it does not support through its class definitions.

The function try is used to send a message to an object for which it is not known whether it inherits a method for that message or not. As opposed to the syntacically equivalent send function, try does not give an error, but returns NIL.

: (try 'msg> 123)
-> NIL
: (try 'html> 'a)
-> NIL

Send an unknown method call

Invoke an object method where the name of the method to be invoked can be generated at run time.

This can be done using the send function. If the function cannot be located in the object's classes and superclasses, an error "Bad message" is issued.

# (send (expression) Obj arg1 arg2)
: (send 'stop> Dlg)
-> NIL

Singleton

A Global Singleton is a class of which only one instance exists within a program.

As there is no physical difference between classes and objects, we can use the class symbol itself (instead of instantiating an object).

(class +Singleton)

(dm message1> ()
   (prinl "This is method 1 on " This) )

(dm message2> ()
   (prinl "This is method 2 on " This) )

Output:

: (message1> '+Singleton)
This is method 1 on +Singleton
-> +Singleton

: (message2> '+Singleton)
This is method 2 on +Singleton
-> +Singleton

That's it! Now that we have covered the most important aspects of object-oriented programming in PicoLisp, let's return to our Web Application Programming tutorial and see how we can use our new knowledge.

Blog