[plt-scheme] Poor Man's FOOP

From: Zelah Hutchinson (zelah at inbox.com)
Date: Sat Jun 27 04:27:40 EDT 2009

;;;;;;;;POOR MAN'S FOOP;;;;;;;;;;;;;
;I was inspired by the newLISP
;video demonstrations to build
;a system similar to theirs for
;Functional OOP.
;Unfortunately, I am still deficient
;in meta-programming skills so I must
;for the time being just describe 
;my ideas as best I can.

;Here is some code:

(define (append-symbol sym1 sym2)
  (let ((str1 (symbol->string sym1))
        (str2 (symbol->string sym2)))
    (string->symbol (string-append str1 str2))))

(define (-self- ls) (car ls))

(define (-state- ls) (cadr ls))

(define (-parent- ls) (caddr ls))

(define (-arguments- ls) (cadddr ls))

(define (->object . st)
  (lambda (method-name . args)
    (apply (eval (append-symbol '->object method-name))
           (let ((self '->object)
                 (state st)
                 (super #f)
                 (arguments (car args)))
             (list self state super arguments)))))

(define (->object:state . ls)
  (list (-self- ls) (-state- ls)))

(define (->object:super . ls) (-parent- ls))

;;;;;;;;;more object methods could go here;;;;;;;;;;;;

;;;;;;;;;more child classes could go here;;;;;;;;;;;;;
(define (:state object . args)
  (object ':state args))

(define (:super object . args)
  (object ':super args))

;;;;;;;;;more generic methods could go here;;;;;;;;;;;

(:state (->object)) ;-> (->object ())
(:state (->object 'size=medium 'weight=heavy 'color=black))
   ;-> (->object (size=medium weight=heavy color=black))
(:super (->object)) ;-> #f

;This is rather simple, I know. Ultimately, it would be nice to add inheritance to the mix.
;But even now, you can see that new generic methods will be added cheaply.
;Also, it should be clear that a little meta-programming and similar techniques can
;essentially automate and improve upon the poor man's method of copying and pasting
;to produce new classes. I hope this will spark a discussion about FOOP in PLT.


Posted on the users mailing list.