GNU Info

(slib.info)Object

---

Next: Priority Queues Prev: Hashing Up: Data Structures

---

Enter node , (file) or (file)node

Macroless Object System
-----------------------

  `(require 'object)'

  This is the Macroless Object System written by Wade Humeniuk
(whumeniu@datap.ca).  Conceptual Tributes: Note: Yasos, MacScheme's
%object, CLOS, Lack of R4RS macros.

Concepts
--------

OBJECT
     An object is an ordered association-list (by `eq?') of methods
     (procedures).  Methods can be added (`make-method!'), deleted
     (`unmake-method!') and retrieved (`get-method').  Objects may
     inherit methods from other objects.  The object binds to the
     environment it was created in, allowing closures to be used to
     hide private procedures and data.

GENERIC-METHOD
     A generic-method associates (in terms of `eq?') object's method.
     This allows scheme function style to be used for objects.  The
     calling scheme for using a generic method is `(generic-method
     object param1 param2 ...)'.

METHOD
     A method is a procedure that exists in the object.  To use a method
     get-method must be called to look-up the method.  Generic methods
     implement the get-method functionality.  Methods may be added to an
     object associated with any scheme obj in terms of eq?

GENERIC-PREDICATE
     A generic method that returns a boolean value for any scheme obj.

PREDICATE
     A object's method asscociated with a generic-predicate. Returns
     `#t'.

Procedures
----------

 - Function: make-object ancestor ...
     Returns an object.  Current object implementation is a tagged
     vector.  ANCESTORs are optional and must be objects in terms of
     object?.  ANCESTORs methods are included in the object.  Multiple
     ANCESTORs might associate the same generic-method with a method.
     In this case the method of the ANCESTOR first appearing in the
     list is the one returned by `get-method'.

 - Function: object? obj
     Returns boolean value whether OBJ was created by make-object.

 - Function: make-generic-method exception-procedure
     Returns a procedure which be associated with an object's methods.
     If EXCEPTION-PROCEDURE is specified then it is used to process
     non-objects.

 - Function: make-generic-predicate
     Returns a boolean procedure for any scheme object.

 - Function: make-method! object generic-method method
     Associates METHOD to the GENERIC-METHOD in the object.  The METHOD
     overrides any previous association with the GENERIC-METHOD within
     the object.  Using `unmake-method!' will restore the object's
     previous association with the GENERIC-METHOD.  METHOD must be a
     procedure.

 - Function: make-predicate! object generic-preciate
     Makes a predicate method associated with the GENERIC-PREDICATE.

 - Function: unmake-method! object generic-method
     Removes an object's association with a GENERIC-METHOD .

 - Function: get-method object generic-method
     Returns the object's method associated (if any) with the
     GENERIC-METHOD.  If no associated method exists an error is
     flagged.

Examples
--------

     (require 'object)
     
     (define instantiate (make-generic-method))
     
     (define (make-instance-object . ancestors)
       (define self (apply make-object
                           (map (lambda (obj) (instantiate obj)) ancestors)))
       (make-method! self instantiate (lambda (self) self))
       self)
     
     (define who (make-generic-method))
     (define imigrate! (make-generic-method))
     (define emigrate! (make-generic-method))
     (define describe (make-generic-method))
     (define name (make-generic-method))
     (define address (make-generic-method))
     (define members (make-generic-method))
     
     (define society
       (let ()
         (define self (make-instance-object))
         (define population '())
         (make-method! self imigrate!
                       (lambda (new-person)
                         (if (not (eq? new-person self))
                             (set! population (cons new-person population)))))
         (make-method! self emigrate!
                       (lambda (person)
                         (if (not (eq? person self))
                             (set! population
                                   (comlist:remove-if (lambda (member)
                                                        (eq? member person))
                                                      population)))))
         (make-method! self describe
                       (lambda (self)
                         (map (lambda (person) (describe person)) population)))
         (make-method! self who
                       (lambda (self) (map (lambda (person) (name person))
                                           population)))
         (make-method! self members (lambda (self) population))
         self))
     
     (define (make-person %name %address)
       (define self (make-instance-object society))
       (make-method! self name (lambda (self) %name))
       (make-method! self address (lambda (self) %address))
       (make-method! self who (lambda (self) (name self)))
       (make-method! self instantiate
                     (lambda (self)
                       (make-person (string-append (name self) "-son-of")
                                    %address)))
       (make-method! self describe
                     (lambda (self) (list (name self) (address self))))
       (imigrate! self)
       self)

Inverter Documentation
......................

  Inheritance:
             <inverter>::(<number> <description>)
  Generic-methods
             <inverter>::value      => <number>::value
             <inverter>::set-value! => <number>::set-value!
             <inverter>::describe   => <description>::describe
             <inverter>::help
             <inverter>::invert
             <inverter>::inverter?

Number Documention
..................

  Inheritance
             <number>::()
  Slots
             <number>::<x>
  Generic Methods
             <number>::value
             <number>::set-value!

Inverter code
.............

     (require 'object)
     
     (define value (make-generic-method (lambda (val) val)))
     (define set-value! (make-generic-method))
     (define invert (make-generic-method
                     (lambda (val)
                       (if (number? val)
                           (/ 1 val)
                           (error "Method not supported:" val)))))
     (define noop (make-generic-method))
     (define inverter? (make-generic-predicate))
     (define describe (make-generic-method))
     (define help (make-generic-method))
     
     (define (make-number x)
       (define self (make-object))
       (make-method! self value (lambda (this) x))
       (make-method! self set-value!
                     (lambda (this new-value) (set! x new-value)))
       self)
     
     (define (make-description str)
       (define self (make-object))
       (make-method! self describe (lambda (this) str))
       (make-method! self help (lambda (this) "Help not available"))
       self)
     
     (define (make-inverter)
       (let* ((self (make-object
                     (make-number 1)
                     (make-description "A number which can be inverted")))
              (<value> (get-method self value)))
         (make-method! self invert (lambda (self) (/ 1 (<value> self))))
         (make-predicate! self inverter?)
         (unmake-method! self help)
         (make-method! self help
                       (lambda (self)
                         (display "Inverter Methods:") (newline)
                         (display "  (value inverter) ==> n") (newline)))
         self))
     
     ;;;; Try it out
     
     (define invert! (make-generic-method))
     
     (define x (make-inverter))
     
     (make-method! x invert! (lambda (x) (set-value! x (/ 1 (value x)))))
     
     (value x)                       => 1
     (set-value! x 33)               => undefined
     (invert! x)                     => undefined
     (value x)                       => 1/33
     
     (unmake-method! x invert!)      => undefined
     
     (invert! x)                     error-->  ERROR: Method not supported: x