This is the mail archive of the guile@cygnus.com mailing list for the guile project.
Index Nav: | [Date Index] [Subject Index] [Author Index] [Thread Index] | |
---|---|---|
Message Nav: | [Date Prev] [Date Next] | [Thread Prev] [Thread Next] |
Here is some food for thought for the new object system. This object system is simple but I think it has a nice syntax, consistent with the scheme philosophy. ;; Simple Object System - For Guile ;; These are objects are essentially closures with multiple ;; methods associated. Generic methods are defined at the ;; top level allowing specific methods to be specified on an object. ;; Inheritance is NOT supported as this can be added ;; later with additional macros. However inheritance can ;; be simulated (see examples). There is not alot of error ;; checking in the object-lambda macro. Only a matter of ;; coding (define *object-tag* "object") (define object? (lambda (obj) (and (vector? obj) (eq? (vector-ref obj 0) *object-tag*)))) (define (get-method obj generic-method) (let ((method (assq generic-method (vector-ref obj 1)))) (if method (cdr method) #f))) (define (make-generic-method) (letrec ((self (lambda (obj . args) (if (object? obj) (let ((method (get-method obj self))) (if method (apply method args) (error "Operation not supported on object" obj))) (error "Method being applied to non object: " obj))))) self)) ;; (object-lambda formals . method-list) --> #<object> (define object-lambda (procedure->macro (lambda (exp env) `(lambda ,(cadr exp) (vector *object-tag* (list ,@(map (lambda (method) (if (eq? (car method) 'method) (begin (if (not (defined? (cadr method))) (eval `(define ,(cadr method) (make-generic-method)))) `(cons ,(cadr method) (lambda ,(caddr method) ,@(cdddr method)))))) (cddr exp)))))))) ;; example ;; Object system has no inheritance, only uses relationships (define make-person (object-lambda (name age) (method get-name () name) (method get-age () age) (method set-name (new-name) (set! name new-name)))) (define wade (make-person 'wade 38)) (get-name wade) (set-name wade 'fred) (get-name wade) ;; Example of "psuedo" inheritence a.k.a "use" relationship ;; I guess macros could be defined to make it easier on the ;; coder. (define make-old-person (lambda (name age retired) ((object-lambda (person retired) (method get-name () (get-name person)) (method get-age () (get-age person)) (method retired? () retired)) (make-person name age) retired))) (define dad (make-old-person 'andrew '78 #t)) (retired? dad) (get-name dad)