Objects and Lambda

Objects in the sense of object-oriented programming can be built with judicious use of lambda. Let us proceed.

Basic object-oriented functionality

Say we wish to construct a ``dog'' object, which responds to the messages bark and describe. We will represent dogs as anonymous functions, created by a make-dog routine. To send a message to a dog, we call it with the first argument being a selector which says what kind of message is being sent, and the remaining arguments being arguments for that particular method.

(define make-dog
  (lambda (size)
    (lambda (selector . args)
      (cond ((equal? selector 'bark)
	     (cond ((equal? size 'small) 'yip)
		   ((equal? size 'medium) 'arf)
		   ((equal? size 'large) 'woof)))
	    ((equal? selector 'describe)
	     (list 'dog 'size size))
	    (else (error "DOG: unknown selector" selector))))))

(define fifi (make-dog 'small))
(define spot (make-dog 'medium))
(define duke (make-dog 'large))

(fifi 'bark)      ; yip
(spot 'describe)  ; (dog size medium)

Deficiencies

This provides us with a rudimentary object system. It has a number of deficiencies:

The methods for a single type cannot be textually dispersed.
There is no inheritence.
An object cannot send itself a message unless it happens to know its own name.
We cannot define system message handlers, eg so that dogs could print themselves with special syntax.
The way we handle extra arguments is awkward and error prone.
the syntax for sending a message is not textually distinguished from calling a function.

The first point we will regard as a problem not with our language but rather with the editor. The inability to print specially is implementation-dependent, but we should note that most Scheme implementations do provide system-level object systems so that user-defined object types can print themselves as they wish. So now let's address the remaining deficiencies.

Giving objects a sense of SELF

Objects cannot send messages to themselves in the above code because they do not have references to themselves available. We can correct this problem quite easily, as well as the lack of a special syntax for messages as opposed to regular function calls, by first defining a send procedure that takes an ``object'', a selector, and any additional arguments, and sends the required message

(define send
  (lambda (object selector . args)
     (apply object (cons selector args))))

and then modifying the way objects expect to be called, by having them expect to have themselves as one of their arguments, and making a symmetric change to send to pass ``self'' along.

(define make-dog
  (lambda (size)
    (lambda (self selector . args)
      (cond ((equal? selector 'bark)
	     (cond ((equal? size 'small) 'yip)
		   ((equal? size 'medium) 'arf)
		   ((equal? size 'large) 'woof)))
	    ((equal? selector 'describe)
	     (list 'dog 'size size))
	    ((equal? selector 'see)
	     (cond ((equal? (car args) 'cat)
	     	    (list (send self 'bark)
		          (send self 'bark)
			  (send self 'bark)))
		   ((equal? (car args) 'wolf)
		    'whimper)))
	    (else (error "DOG: unknown selector" selector))))))

(define send
  (lambda (object selector . args)
    (apply object (cons object (cons selector args)))))

(define fifi (make-dog 'small))

(send fifi 'see 'cat)          ; (yip yip yip)
(send fifi 'see 'wolf)         ; whimper

Making arguments convenient

The syntax for handling the arguments of the message remains awkward, and also error prone. If we had many args, we'd have to write (cadddr args) and such, which would be unfortunate. There's a reason programmers like to name the formal parameters to functions rather than just referring to them by number! Also, the code as it stands does not check for the right number of args, and it would be a hassle to include such checks. For instance, (send fifi 'bark 'for 'me) just ignores the for and me.

In order to solve this problem, we will use currying. In order to send an object x a message with selector s and argument y, we first call x with s (and x itself to let it send messages to itself) as an argument, and it returns a function which we then call with y as an argument. In other words, we'll go ((x x s) y). Naturally we also make a symmetric change to send.

(define make-dog
  (lambda (size)
    (lambda (self selector)
      (cond ((equal? selector 'bark)
             (lambda ()
	       (cond ((equal? size 'small) 'yip)
		     ((equal? size 'medium) 'arf)
		     ((equal? size 'large) 'woof))))
	    ((equal? selector 'describe)
	     (lambda ()
	       (list 'dog 'size size)))
	    ((equal? selector 'see)
	     (lambda (thing)
	       (cond ((equal? thing 'cat)
		      (list (send self 'bark)
			    (send self 'bark)
			    (send self 'bark)))
		     ((equal? thing 'wolf)
		      'whimper))))
	    (else (error "DOG: unknown selector" selector))))))

(define send
  (lambda (object selector . args)
    (apply (object object selector) args)))

(define fifi (make-dog 'small))

(send fifi 'see 'cat)          ; (yip yip yip)
(send fifi 'see 'wolf)         ; whimper

Inheritance using Delegation

Now we have convenient variable names for args, and nice error checking of arguments, but there is still no inheritance.

There are two kinds of inheritance used in object-oriented programming languages: supertypes, and delegation. In languages with supertype inheritance, such as C++ or Smalltalk, objects are members of a type, and a type can inherit from a supertype. But in our way of defining objects there are no types as such! Instead, we will use the delegation method pioneered in the language SELF. We will modify our objects to each have an optional delegate, who will handle messages they don't handle themselves for them. The delegate is just another object like any other, not distinguished in any way.

Let us make an example: we will make two kinds of point objects, which represent their coordinates in polar vs rectangular coordinates. Each such object will delegate to a generic point object, which knows how to handle any messages which should be handled in common.

(define delegate
  (lambda (parent object selector . args)
    (apply (parent object selector) args)))

(define delegate-selector
  (lambda (parent object selector)
    (parent object selector)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Points
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define generic-point
  (lambda (self selector)
    (cond ((equal? selector 'DESCRIBE-RECT)
           (lambda ()
	     (list 'rect
		   (send self 'get-x)
		   (send self 'get-y))))
          ((equal? selector 'DESCRIBE-POLAR)
           (lambda ()
	     (list 'polar
		   (send self 'get-radius)
		   (send self 'get-angle))))
          ((equal? selector 'SCALE)
	   (lambda (factor)
	     (make-polar-point (* factor (send self 'get-radius))
			       (send self 'get-angle))))
          ((equal? selector '+)
	   (lambda (other)
	     (make-rect-point (+ (send self 'get-x)
				 (send other 'get-x))
			      (+ (send self 'get-y)
				 (send other 'get-y)))))
          (else (error "Unknown selector" selector)))))

(define make-rect-point
  (lambda (x y)
    (lambda (self selector)
      (cond ((equal? selector 'GET-X)
             (lambda () x))
	    ((equal? selector 'GET-Y)
             (lambda () y))
	    ((equal? selector 'GET-RADIUS)
             (lambda ()
	       (sqrt (+ (* x x) (* y y)))))
	    ((equal? selector 'GET-ANGLE)
	     (lambda ()
	       (atan y x)))
	    ((equal? selector 'SCALE)
	     (lambda (factor)
	       (make-rect-point (* factor x)
				(* factor y))))
	    ((equal? selector 'DOT)
	     (lambda (other)
	       (+ (* (send self 'get-x)
	             (send other 'get-x))
	          (* (send self 'get-y)
	             (send other 'get-y)))))
	    (else
	     (delegate-selector generic-point self selector))))))

(define make-polar-point
  (lambda (radius angle)
    (lambda (self selector)
      (cond ((equal? selector 'GET-X)
             (lambda ()
	       (* radius (sin angle))))
	    ((equal? selector 'GET-Y)
             (lambda ()
	       (* radius (cos angle))))
	    ((equal? selector 'GET-RADIUS)
	     (lambda () radius))
	    ((equal? selector 'GET-ANGLE)
	     (lambda () angle))
	    ((equal? selector 'dot)
	     (lambda (other)
	       (* radius
	          (send other 'radius)
		  (cos (- angle (send other 'get-angle))))))
	    (else
	     (delegate-selector generic-point self selector))))))

(define p1 (make-rect-point 1 1))
(define p2 (make-rect-point 2 3))
(define p3 (send p1 '+ p2))
(define p4 (send p3 'scale 2))

(send p4 'describe-rect)              ; (rect 5 8)
(send p4 'describe-polar)             ; (polar 10 0.927)

Sample code in a nice file is available in the file object.scm.

Barak Pearlmutter <bap@cs.unm.edu>