module/slib/objdoc.txi

   1
   2 @code{(require 'object)}
   3 @ftindex object
   4
   5 This is the Macroless Object System written by Wade Humeniuk
   6 (whumeniu@@datap.ca).  Conceptual Tributes: @ref{Yasos}, MacScheme's
   7 %object, CLOS, Lack of R4RS macros.
   8
   9 @subsection Concepts
  10 @table @asis
  11
  12 @item OBJECT
  13 An object is an ordered association-list (by @code{eq?}) of methods
  14 (procedures).  Methods can be added (@code{make-method!}), deleted
  15 (@code{unmake-method!}) and retrieved (@code{get-method}).  Objects may
  16 inherit methods from other objects.  The object binds to the environment
  17 it was created in, allowing closures to be used to hide private
  18 procedures and data.
  19
  20 @item GENERIC-METHOD
  21 A generic-method associates (in terms of @code{eq?}) object's method.
  22 This allows scheme function style to be used for objects.  The calling
  23 scheme for using a generic method is @code{(generic-method object param1
  24 param2 ...)}.
  25
  26 @item METHOD
  27 A method is a procedure that exists in the object.  To use a method
  28 get-method must be called to look-up the method.  Generic methods
  29 implement the get-method functionality.  Methods may be added to an
  30 object associated with any scheme obj in terms of eq?
  31
  32 @item GENERIC-PREDICATE
  33 A generic method that returns a boolean value for any scheme obj.
  34
  35 @item PREDICATE
  36 A object's method asscociated with a generic-predicate. Returns
  37 @code{#t}.
  38 @end table
  39
  40 @subsection Procedures
  41
  42 @defun make-object ancestor @dots{}
  43 Returns an object.  Current object implementation is a tagged vector.
  44 @var{ancestor}s are optional and must be objects in terms of object?.
  45 @var{ancestor}s methods are included in the object.  Multiple
  46 @var{ancestor}s might associate the same generic-method with a method.
  47 In this case the method of the @var{ancestor} first appearing in the
  48 list is the one returned by @code{get-method}.
  49 @end defun
  50
  51 @defun object? obj
  52 Returns boolean value whether @var{obj} was created by make-object.
  53 @end defun
  54
  55 @defun make-generic-method exception-procedure
  56 Returns a procedure which be associated with an object's methods.  If
  57 @var{exception-procedure} is specified then it is used to process
  58 non-objects.
  59 @end defun
  60
  61 @defun make-generic-predicate
  62 Returns a boolean procedure for any scheme object.
  63 @end defun
  64
  65 @defun make-method! object generic-method method
  66 Associates @var{method} to the @var{generic-method} in the object.  The
  67 @var{method} overrides any previous association with the
  68 @var{generic-method} within the object.  Using @code{unmake-method!}
  69 will restore the object's previous association with the
  70 @var{generic-method}.  @var{method} must be a procedure.
  71 @end defun
  72
  73 @defun make-predicate! object generic-preciate
  74 Makes a predicate method associated with the @var{generic-predicate}.
  75 @end defun
  76
  77 @defun unmake-method! object generic-method
  78 Removes an object's association with a @var{generic-method} .
  79 @end defun
  80
  81 @defun get-method object generic-method
  82 Returns the object's method associated (if any) with the
  83 @var{generic-method}.  If no associated method exists an error is
  84 flagged.
  85 @end defun
  86
  87 @subsection Examples
  88
  89 @example
  90 (require 'object)
  91 @ftindex object
  92
  93 (define instantiate (make-generic-method))
  94
  95 (define (make-instance-object . ancestors)
  96   (define self (apply make-object
  97                       (map (lambda (obj) (instantiate obj)) ancestors)))
  98   (make-method! self instantiate (lambda (self) self))
  99   self)
 100
 101 (define who (make-generic-method))
 102 (define imigrate! (make-generic-method))
 103 (define emigrate! (make-generic-method))
 104 (define describe (make-generic-method))
 105 (define name (make-generic-method))
 106 (define address (make-generic-method))
 107 (define members (make-generic-method))
 108
 109 (define society
 110   (let ()
 111     (define self (make-instance-object))
 112     (define population '())
 113     (make-method! self imigrate!
 114                   (lambda (new-person)
 115                     (if (not (eq? new-person self))
 116                         (set! population (cons new-person population)))))
 117     (make-method! self emigrate!
 118                   (lambda (person)
 119                     (if (not (eq? person self))
 120                         (set! population
 121                               (comlist:remove-if (lambda (member)
 122                                                    (eq? member person))
 123                                                  population)))))
 124     (make-method! self describe
 125                   (lambda (self)
 126                     (map (lambda (person) (describe person)) population)))
 127     (make-method! self who
 128                   (lambda (self) (map (lambda (person) (name person))
 129                                       population)))
 130     (make-method! self members (lambda (self) population))
 131     self))
 132
 133 (define (make-person %name %address)
 134   (define self (make-instance-object society))
 135   (make-method! self name (lambda (self) %name))
 136   (make-method! self address (lambda (self) %address))
 137   (make-method! self who (lambda (self) (name self)))
 138   (make-method! self instantiate
 139                 (lambda (self)
 140                   (make-person (string-append (name self) "-son-of")
 141                                %address)))
 142   (make-method! self describe
 143                 (lambda (self) (list (name self) (address self))))
 144   (imigrate! self)
 145   self)
 146 @end example
 147
 148 @subsubsection Inverter Documentation
 149 Inheritance:
 150 @lisp
 151         <inverter>::(<number> <description>)
 152 @end lisp
 153 Generic-methods
 154 @lisp
 155         <inverter>::value      @result{} <number>::value
 156         <inverter>::set-value! @result{} <number>::set-value!
 157         <inverter>::describe   @result{} <description>::describe
 158         <inverter>::help
 159         <inverter>::invert
 160         <inverter>::inverter?
 161 @end lisp
 162
 163 @subsubsection Number Documention
 164 Inheritance
 165 @lisp
 166         <number>::()
 167 @end lisp
 168 Slots
 169 @lisp
 170         <number>::<x>
 171 @end lisp
 172 Generic Methods
 173 @lisp
 174         <number>::value
 175         <number>::set-value!
 176 @end lisp
 177
 178 @subsubsection Inverter code
 179 @example
 180 (require 'object)
 181 @ftindex object
 182
 183 (define value (make-generic-method (lambda (val) val)))
 184 (define set-value! (make-generic-method))
 185 (define invert (make-generic-method
 186                 (lambda (val)
 187                   (if (number? val)
 188                       (/ 1 val)
 189                       (error "Method not supported:" val)))))
 190 (define noop (make-generic-method))
 191 (define inverter? (make-generic-predicate))
 192 (define describe (make-generic-method))
 193 (define help (make-generic-method))
 194
 195 (define (make-number x)
 196   (define self (make-object))
 197   (make-method! self value (lambda (this) x))
 198   (make-method! self set-value!
 199                 (lambda (this new-value) (set! x new-value)))
 200   self)
 201
 202 (define (make-description str)
 203   (define self (make-object))
 204   (make-method! self describe (lambda (this) str))
 205   (make-method! self help (lambda (this) "Help not available"))
 206   self)
 207
 208 (define (make-inverter)
 209   (let* ((self (make-object
 210                 (make-number 1)
 211                 (make-description "A number which can be inverted")))
 212          (<value> (get-method self value)))
 213     (make-method! self invert (lambda (self) (/ 1 (<value> self))))
 214     (make-predicate! self inverter?)
 215     (unmake-method! self help)
 216     (make-method! self help
 217                   (lambda (self)
 218                     (display "Inverter Methods:") (newline)
 219                     (display "  (value inverter) ==> n") (newline)))
 220     self))
 221
 222 ;;;; Try it out
 223
 224 (define invert! (make-generic-method))
 225
 226 (define x (make-inverter))
 227
 228 (make-method! x invert! (lambda (x) (set-value! x (/ 1 (value x)))))
 229
 230 (value x)                       @result{} 1
 231 (set-value! x 33)               @result{} undefined
 232 (invert! x)                     @result{} undefined
 233 (value x)                       @result{} 1/33
 234
 235 (unmake-method! x invert!)      @result{} undefined
 236
 237 (invert! x)                     @error{}  ERROR: Method not supported: x
 238 @end example