summaryrefslogtreecommitdiffstats
path: root/object.texi
blob: 123417b69a4cba07291893aadb07fefc54d8ad30 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238

@code{(require 'object)}
@ftindex object

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

@subsection Concepts
@table @asis

@item OBJECT
An object is an ordered association-list (by @code{eq?}) of methods
(procedures).  Methods can be added (@code{make-method!}), deleted
(@code{unmake-method!}) and retrieved (@code{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.

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

@item 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?

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

@item PREDICATE
A object's method asscociated with a generic-predicate. Returns
@code{#t}.
@end table

@subsection Procedures

@defun make-object ancestor @dots{}
Returns an object.  Current object implementation is a tagged vector.
@var{ancestor}s are optional and must be objects in terms of object?.
@var{ancestor}s methods are included in the object.  Multiple
@var{ancestor}s might associate the same generic-method with a method.
In this case the method of the @var{ancestor} first appearing in the
list is the one returned by @code{get-method}.
@end defun

@defun object? obj
Returns boolean value whether @var{obj} was created by make-object.
@end defun

@defun make-generic-method exception-procedure
Returns a procedure which be associated with an object's methods.  If
@var{exception-procedure} is specified then it is used to process
non-objects.
@end defun

@defun make-generic-predicate
Returns a boolean procedure for any scheme object.
@end defun

@defun make-method! object generic-method method
Associates @var{method} to the @var{generic-method} in the object.  The
@var{method} overrides any previous association with the
@var{generic-method} within the object.  Using @code{unmake-method!}
will restore the object's previous association with the
@var{generic-method}.  @var{method} must be a procedure.
@end defun

@defun make-predicate! object generic-preciate
Makes a predicate method associated with the @var{generic-predicate}.
@end defun

@defun unmake-method! object generic-method
Removes an object's association with a @var{generic-method} .
@end defun

@defun get-method object generic-method
Returns the object's method associated (if any) with the
@var{generic-method}.  If no associated method exists an error is
flagged.
@end defun

@subsection Examples

@example
(require 'object)
@ftindex 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)
@end example

@subsubsection Inverter Documentation
Inheritance:
@lisp
        <inverter>::(<number> <description>)
@end lisp
Generic-methods
@lisp
        <inverter>::value      @result{} <number>::value
        <inverter>::set-value! @result{} <number>::set-value!
        <inverter>::describe   @result{} <description>::describe
        <inverter>::help
        <inverter>::invert
        <inverter>::inverter?
@end lisp

@subsubsection Number Documention
Inheritance
@lisp
        <number>::()
@end lisp
Slots
@lisp
        <number>::<x>
@end lisp
Generic Methods
@lisp
        <number>::value
        <number>::set-value!
@end lisp

@subsubsection Inverter code
@example
(require 'object)
@ftindex 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)                       @result{} 1
(set-value! x 33)               @result{} undefined
(invert! x)                     @result{} undefined
(value x)                       @result{} 1/33

(unmake-method! x invert!)      @result{} undefined

(invert! x)                     @error{}  ERROR: Method not supported: x
@end example