(require 'object)
This is the Macroless Object System written by Wade Humeniuk
(whumeniu@datap.ca). Conceptual Tributes: Yasos, MacScheme's
%object, CLOS, Lack of R4RS macros.
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.
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 ...).
#t.
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.
Returns a procedure which be associated with an object's methods. If exception-procedure is specified then it is used to process non-objects.
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.
Makes a predicate method associated with the generic-predicate.
Removes an object's association with a generic-method .
Returns the object's method associated (if any) with the generic-method. If no associated method exists an error is flagged.
(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)
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?
Inheritance
<number>::()
Slots
<number>::<x>
Generic Methods
<number>::value
<number>::set-value!
(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