Trivial single dispatch OOP with R5RS closures

Just to provide a trivial example should anyone ever be looking for such. It’s easy to find let/lambda examples, but not much with “class methods” or “class variables” (you’ll notice however that it’s basically the same thing, just using two pairs of let/lambda). I figure this would have saved me a bit of time a while ago, so maybe someone else’ll find it useful. It’s far from perfect I’m sure, but it works.

;; Is clobbered later.
(define make-obj #f)

(let ()

  ;; "Class methods" Entirely redundant, pretend these do something interesting.
  (define (setter! obj var val)
    (obj var val))
  (define (other-setter! obj var val)	
    (setter! obj var val))

  ;; "Class variables" could also be done here.

  ;; "Export" the instantiator (clobbering the define above the let).
  (set! make-obj

	;; "Initialization variables"
	(lambda (x)

	  ;; "Instance variables"
	  (let ((y 1))			

	    ;; The "object" returned by the instantiator.
	    (define (self msg . arg)
	      ;; "Instance methods"
	      (define (display-vars)
		(display "X: ")
		(display x)
		(display "Y: ")
		(display y)

	      ;; Single dispatch
	      (case msg
		 (if (null? arg)
		     (set! x (car arg))))
		 (if (null? arg)
		     (set! y (car arg))))
		 (setter! self 'x (car arg)))
		 (other-setter! self 'y (car arg)))
		(else (display "Unknown message: ")
		      (display msg)

            ;; This is the return value of make-obj

  ;; let () ...

And some sample interaction…

> (define object-1 (make-obj 3))
> (define object-2 (make-obj 5))
> (object-1 'd)
X: 3
Y: 1
> (object-2 'd)
X: 5
Y: 1
> (object-1 'x 42)
> (object-1 'd)
X: 42
Y: 1
> (object-2 's2 6)
> (object-2 'y)
> (object-2 'd)
X: 5
Y: 6
> (object-1 's2 (+ (object-1 'y) (object-2 'x)))
> (object-1 'd)
X: 42
Y: 6
> (object-2 's1 (/ (object-1 'x) (object-1 'y)))
> (object-2 'd)
X: 7
Y: 6

You have a couple of easy choices for subclassing/inheritance as well. When defining the subclass, make its dispatch for any unknown messages call the parent object(s) with the same message and args. The parent objects(s) can be pre-existing or you might instantiate copies of them from within your subclass, either way has its pros and cons. I’m not really going to get those though as it’s a quick way to wind up playing with call/cc and macros which is far beyond this simple example’s scope. Really if you’re doing anything that complicated, you might consider one of the many OOP systems already written to handle that sort of stuff. There’s MeroonV3, Meroonet, YASOS (Yet Another Scheme Object System), MOS (Macroless Object System), POS (Portable Object System), ScmObj, the list goes on, and all of these are pretty widely portable between implementations. YASOS and MOS both come with SLIB. I might wind up porting POS to Snow. Many implementations already come with one as well.

For the “basic” stuff when you just need a bit of encapsulation though, closures alone are plenty flexible.

Any suggestions to improve or clarify this example is welcome.

June 28, 2008 - Posted by | Programming, Scheme

No comments yet.

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s

%d bloggers like this: