1 | [[tags: egg]] |
---|
2 | |
---|
3 | == yasos |
---|
4 | |
---|
5 | [[toc:]] |
---|
6 | |
---|
7 | === Description |
---|
8 | |
---|
9 | "Yet another Scheme Object System" |
---|
10 | |
---|
11 | A very simple OOP system with multiple inheritance, that allows mixing of styles and separates interface from implementation. There are no classes, no meta-anything, simply closures. |
---|
12 | |
---|
13 | === Scheming with Objects |
---|
14 | |
---|
15 | There is a saying--attributed to Norman Adams--that "Objects are a |
---|
16 | poor man's closures." In this article we discuss what closures are and |
---|
17 | how objects and closures are related, show code samples to make these |
---|
18 | abstract ideas concrete, and implement a Scheme Object System which |
---|
19 | solves the problems we uncover along the way. |
---|
20 | |
---|
21 | ==== The Classical Object Model |
---|
22 | |
---|
23 | Before discussing object oriented programming in Scheme, it pays to |
---|
24 | take a look at the classical model so that we have something to |
---|
25 | compare with and in order to clarify some of the terminology. One of |
---|
26 | the problems that the OO movement created for itself was the use of |
---|
27 | new terms to get away from older concepts and the confusion this has |
---|
28 | caused. So before going further I would like to give some of my own |
---|
29 | definitions and a simple operational model. The model is not strictly |
---|
30 | correct as most compiled systems use numerous short cuts and special |
---|
31 | optimization tricks, but it is close enough for most practical |
---|
32 | purposes and has been used to implement OO programming in imperative |
---|
33 | languages. |
---|
34 | |
---|
35 | An object "instance" consists of local (encapsulated) state and a |
---|
36 | reference to shared code which operates on its state. The easy way to |
---|
37 | think of this is as a C struct or Pascal record which has one field |
---|
38 | reserved for a pointer to its shared code environment and other slots |
---|
39 | for its instance variables. Each procedure in this shared environment |
---|
40 | is called a "method." A "class" is code which is can generate |
---|
41 | instances (new records) by initializing their fields, including a |
---|
42 | pointer to the instance's shared method environment. The environment |
---|
43 | just maps method names to their values (their code). Each method is a |
---|
44 | procedure which takes the record it is operating on as its first, |
---|
45 | sometimes hidden, argument. The first argument is called the |
---|
46 | "reciever" and typically aliased to the name "self" within the |
---|
47 | procedure's code. |
---|
48 | |
---|
49 | In order to make code management easy, object oriented systems such as |
---|
50 | Actor or Smalltalk wish to deal with code as objects and the way this |
---|
51 | is done is by making each class an object instance as well. In order |
---|
52 | to manipulate the class's code, however a "meta-class" is typically |
---|
53 | defined and in some cases a meta-meta... Well, you get the idea. |
---|
54 | Many people have spent a great deal of time in theories of how to |
---|
55 | "ground" such systems without infinite recursion. To confuse things |
---|
56 | further, many object systems have an object named "object" and a class |
---|
57 | object named "class"--so that the class of the "class" object is |
---|
58 | `class'. |
---|
59 | |
---|
60 | By making every data object an instance of the OO system, uniformity |
---|
61 | demands that numbers are added, e.g. 1 + 2 by "sending the message" + |
---|
62 | to the object 1 with the argument 2. This has the advantage that + is |
---|
63 | polymorphic--it can be applied to any data object. Unfortunately, |
---|
64 | polymorphism also makes optimization hard in that the compiler can no |
---|
65 | longer make assumptions about + and may not be able to do constant |
---|
66 | folding or inlining. |
---|
67 | |
---|
68 | The set of methods an object responds to is called a "protocol". |
---|
69 | Another way of saying this is that the functions or operations that |
---|
70 | are invokeable on an object make up its interface. More than one |
---|
71 | class of object may respond to the same protocol--i.e. many different |
---|
72 | types of objects have the same operation names available. |
---|
73 | |
---|
74 | |
---|
75 | ==== Object Based Message Passing |
---|
76 | |
---|
77 | |
---|
78 | So how can this "message passing" be implemented with lexical |
---|
79 | closures? And what are these closure things anyway? |
---|
80 | |
---|
81 | References within a function to variables outside of the local |
---|
82 | scope--free references--are resolved by looking them up in the |
---|
83 | environment in which the function finds itself. When a language is |
---|
84 | lexically scoped, you see the shape of the environment when you |
---|
85 | read--lex--the code. In Scheme, when a function is created it |
---|
86 | remembers the environment in which it was created. Free names are |
---|
87 | looked up in that environment, so the environment is said to be |
---|
88 | "closed over" when the function is created. Hence the term "closure." |
---|
89 | |
---|
90 | |
---|
91 | An example may help here: |
---|
92 | |
---|
93 | <enscript highlight=scheme> |
---|
94 | (define (curried-add x) (lambda (y) (+ x y)) |
---|
95 | |
---|
96 | (define add8 (curried-add 8)) |
---|
97 | |
---|
98 | (add8 3) ;-> 11 |
---|
99 | </enscript> |
---|
100 | |
---|
101 | |
---|
102 | When add8 is applied to its argument, we are doing ((lambda (y) (+ x y)) 3) |
---|
103 | |
---|
104 | The function add8 remembers that X has the value 8. It gets the value |
---|
105 | Y when it is applied to 3. It finds that + is the addition function. |
---|
106 | So (add8 3) evaluates to 11. |
---|
107 | |
---|
108 | (define ADD5 (curried-add 5)) makes a new function which shares the |
---|
109 | curried-add code (lambda (y) (+ x y)), but remembers that in its |
---|
110 | closed over environment, X has the value 5. |
---|
111 | |
---|
112 | Now that we have a way to create data objects, closures, which share |
---|
113 | code but have different data, we just need a "dispatching function" to |
---|
114 | which we can pass the symbols we will use for messages: |
---|
115 | |
---|
116 | |
---|
117 | <enscript highlight=scheme> |
---|
118 | (define (MAKE-POINT the-x the-y) |
---|
119 | (lambda (message) |
---|
120 | (case message |
---|
121 | ((x) (lambda () the-x)) ;; return a function which returns the answer |
---|
122 | ((y) (lambda () the-y)) |
---|
123 | ((set-x!) |
---|
124 | (lambda (new-value) |
---|
125 | (set! the-x new-value) ;; do the assignment |
---|
126 | the-x)) ;; return the new value |
---|
127 | ((set-y!) |
---|
128 | (lambda (new-value) |
---|
129 | (set! the-y new-value) |
---|
130 | the-y)) |
---|
131 | (else (error "POINT: Unknown message ->" message))))) |
---|
132 | |
---|
133 | (define p1 (MAKE-POINT 132 75)) |
---|
134 | |
---|
135 | (define p2 (MAKE-POINT 132 57)) |
---|
136 | |
---|
137 | ((p1 'x)) ;-> 132 |
---|
138 | |
---|
139 | ((p1 'set-x!) 5) ;-> 5 |
---|
140 | </enscript> |
---|
141 | |
---|
142 | |
---|
143 | We can even change the message passign style to function calling style: |
---|
144 | |
---|
145 | <enscript highlight=scheme> |
---|
146 | (define (x obj) (obj 'x)) |
---|
147 | |
---|
148 | (define (set-x! obj new-val) ((obj 'set-x!) new-val)) |
---|
149 | |
---|
150 | |
---|
151 | (set-x! p1 12) ;-> 12 |
---|
152 | |
---|
153 | (x p1) ;-> 12 |
---|
154 | |
---|
155 | (x p2) ;-> 132 ;; p1 and p2 share code but have different local data |
---|
156 | </enscript> |
---|
157 | |
---|
158 | Using Scheme's lexical scoping, we can also define make-point as: |
---|
159 | |
---|
160 | <enscript highlight=scheme> |
---|
161 | (define (MAKE-POINT the-x the-y) |
---|
162 | |
---|
163 | (define (get-x) the-x) ;; a "method" |
---|
164 | |
---|
165 | (define (get-y) the-y) |
---|
166 | |
---|
167 | (define (set-x! new-x) |
---|
168 | (set! the-x new-x) |
---|
169 | the-x) |
---|
170 | |
---|
171 | (define (set-y! new-y) |
---|
172 | (set! the-y new-y) |
---|
173 | the-y) |
---|
174 | |
---|
175 | (define (self message) |
---|
176 | (case message |
---|
177 | ((x) get-x) ;; return the local function |
---|
178 | ((y) get-y) |
---|
179 | ((set-x!) set-x!) |
---|
180 | ((set-y!) set-y!) |
---|
181 | (else (error "POINT: Unknown message ->" message)))) |
---|
182 | |
---|
183 | self) ;; the return value of make-point is the dispatch function |
---|
184 | </enscript> |
---|
185 | |
---|
186 | |
---|
187 | ==== Adding Inheritance |
---|
188 | |
---|
189 | |
---|
190 | "Inheritance" means that one object may be specialized by adding to |
---|
191 | and/or shadowing another's behavior. It is said that "object based" |
---|
192 | programming together with inheritance is "object oriented" programming. |
---|
193 | How can we add inheritance to the above picture? By delegating to |
---|
194 | another object! |
---|
195 | |
---|
196 | |
---|
197 | <enscript highlight=scheme> |
---|
198 | (define (MAKE-POINT-3D a b the-z) |
---|
199 | (let ((point (MAKE-POINT a b))) |
---|
200 | |
---|
201 | (define (get-z) the-z) |
---|
202 | |
---|
203 | (define (set-z! new-value) |
---|
204 | (set! the-z new-value) |
---|
205 | the-z) |
---|
206 | |
---|
207 | (define (self message) |
---|
208 | (case message |
---|
209 | ((z) get-z) |
---|
210 | ((set-z!) set-z!) |
---|
211 | (else (point message)))) |
---|
212 | |
---|
213 | self) |
---|
214 | |
---|
215 | (define p3 (MAKE-POINT-3D 12 34 217)) |
---|
216 | |
---|
217 | (x p3) ;-> 12 |
---|
218 | |
---|
219 | (z p3) ;-> 217 |
---|
220 | |
---|
221 | (set-x! p3 12) ;-> 12 |
---|
222 | |
---|
223 | (set-x! p2 12) ;-> 12 |
---|
224 | |
---|
225 | (set-z! p3 14) ;-> 14 |
---|
226 | </enscript> |
---|
227 | |
---|
228 | Note that in this style, we are not required to have a single distinguished |
---|
229 | base object, "object"--although we may do so if we wish. |
---|
230 | |
---|
231 | |
---|
232 | ==== What Is Wrong With The Above Picture ? |
---|
233 | |
---|
234 | |
---|
235 | While the direct strategy above is perfectly adequate for OO |
---|
236 | programming, there are a couple of rough spots. For example, how can |
---|
237 | we tell which functions are points and which are not? We can define a |
---|
238 | POINT? predicate, but not all Scheme data objects will take a 'point? |
---|
239 | message. Most will generate error messages, but some will just "do |
---|
240 | the wrong thing." |
---|
241 | |
---|
242 | <enscript highlight=scheme> |
---|
243 | (define (POINT? obj) (and (procedure? obj) (obj 'point?))) |
---|
244 | |
---|
245 | (POINT? list) -> (POINT?) ;; a list with the symbol 'point? |
---|
246 | </enscript> |
---|
247 | |
---|
248 | We want a system in which all objects participate and in which we can |
---|
249 | mix styles. Building dispatch functions is repetitive and can |
---|
250 | certainly be automated--and let's throw in multiple inheritance while |
---|
251 | we are at it. Also, it is generally a good design principle to |
---|
252 | separate interface from implementation, so we will. |
---|
253 | |
---|
254 | |
---|
255 | ==== One Set Of Solutions |
---|
256 | |
---|
257 | The following is one of a large number of possible implementations. |
---|
258 | Most Scheme programmers I know have written at least one object system |
---|
259 | and some have written several. Let's first look at the interface, then |
---|
260 | how it is used, then how it was implemented. |
---|
261 | |
---|
262 | In order to know what data objects are "instances", we have a |
---|
263 | predicate, INSTANCE?, which takes a single argument and answers #t or |
---|
264 | #f. |
---|
265 | |
---|
266 | For each kind of object is also useful to have a predicate, so we |
---|
267 | define a predicate maker: (DEFINE-PREDICATE <opname?>) which by default |
---|
268 | answers #f. |
---|
269 | |
---|
270 | To define operations which operate on any data, we need a default |
---|
271 | behavior for data objects which don't handle the operation: |
---|
272 | (define-operation (opname self arg ...) default-body). |
---|
273 | If we don't supply a default-behavior, the default default-behavior |
---|
274 | is to generate an error. |
---|
275 | |
---|
276 | We certainly need to return values which are instances of our object |
---|
277 | system: (object operation... ), where an operation has the form: |
---|
278 | ((opname self arg ...) body). There is also a let-like form for |
---|
279 | multiple inheritance: |
---|
280 | |
---|
281 | (object-with-ancestors ((ancestor1 init1) ...) operation ...). |
---|
282 | |
---|
283 | In the case of multiple inherited operations with the same identity, |
---|
284 | the operation used is the one found in the first ancestor in the |
---|
285 | ancestor list. |
---|
286 | |
---|
287 | And finally, there is the "send to super" problem, where we want to |
---|
288 | operate as an ancestor, but maintain our own self identity: |
---|
289 | |
---|
290 | (operate-as component operation composite arg ...), |
---|
291 | |
---|
292 | or, in curried form |
---|
293 | |
---|
294 | ((operate-as component operation) composite arg ...). |
---|
295 | |
---|
296 | Note that in this system, code which creates instances is just code, so |
---|
297 | there there is no need to define "classes" and no meta-<anything>! |
---|
298 | |
---|
299 | === Usage |
---|
300 | |
---|
301 | (require-extension yasos) |
---|
302 | |
---|
303 | === Module yasos |
---|
304 | |
---|
305 | ==== yasos |
---|
306 | |
---|
307 | <procedure>(yasos)</procedure> |
---|
308 | <procedure>(yasos sym)</procedure> |
---|
309 | |
---|
310 | documentation procedure: Lists the exported symbols, if run as a thunk, |
---|
311 | or the documentation of the exported sym. |
---|
312 | |
---|
313 | ==== protocol |
---|
314 | |
---|
315 | <procedure>(protocol obj)</procedure> |
---|
316 | <procedure>(protocol obj sym)</procedure> |
---|
317 | |
---|
318 | if run as thunk, returns the list of operations, obj accepts, |
---|
319 | otherwise the signature of sym. |
---|
320 | |
---|
321 | This operation is available for each yasos object without intervention |
---|
322 | of the client. |
---|
323 | |
---|
324 | ==== show |
---|
325 | |
---|
326 | <procedure>(show obj)</procedure> |
---|
327 | <procedure>(show obj arg)</procedure> |
---|
328 | |
---|
329 | prints obj with format to stdout, if no optional arg is given, or to the |
---|
330 | first format argument. To be updated in operations. |
---|
331 | |
---|
332 | ==== size |
---|
333 | |
---|
334 | <procedure>(size obj)</procedure> |
---|
335 | |
---|
336 | returns the size of an object. To be updated in operations. |
---|
337 | |
---|
338 | ==== define-predicate |
---|
339 | |
---|
340 | <macro>(define-predicate name)</macro> |
---|
341 | |
---|
342 | defines a predicate. |
---|
343 | |
---|
344 | ==== define-operation |
---|
345 | |
---|
346 | <macro>(define-operation (name obj . args) . default-body)</macro> |
---|
347 | |
---|
348 | defines an operation, obj should accept, with arguments args and |
---|
349 | default-body in case, no name is defined within operations. |
---|
350 | |
---|
351 | ==== operations |
---|
352 | |
---|
353 | <macro>(operations ((ancestor init) ...) ((name self . args) . body) ...)</macro> |
---|
354 | |
---|
355 | defines the list of operations, the object self will accept, possibly |
---|
356 | inheriting ancestor ... |
---|
357 | |
---|
358 | ==== operate-as |
---|
359 | |
---|
360 | <macro>(operate-as super operation)</macro> |
---|
361 | <macro>(operate-as super operation self . args)</macro> |
---|
362 | |
---|
363 | operation is send to super. The first is a curried version of the |
---|
364 | second. |
---|
365 | |
---|
366 | The following two macros are deprecated but still exported. They are |
---|
367 | superseded by operations. |
---|
368 | |
---|
369 | ==== object |
---|
370 | |
---|
371 | <macro>(object ((name self . args) . body) ...)</macro> |
---|
372 | |
---|
373 | same as (operations () ((name self . args) . body) ...) |
---|
374 | |
---|
375 | ==== object-with-ancestors |
---|
376 | |
---|
377 | <macro>(object-with-ancestors ((ancestor init) ...) ((name self . args) . body) ...)</macro> |
---|
378 | |
---|
379 | same as operations. |
---|
380 | |
---|
381 | ==== Example |
---|
382 | |
---|
383 | ===== person interface |
---|
384 | |
---|
385 | <enscript highlight=scheme> |
---|
386 | (define-predicate person?) |
---|
387 | (define-operation (name obj)) |
---|
388 | (define-operation (age obj)) |
---|
389 | (define-operation (set-age! obj new-age)) |
---|
390 | (define-operation (ssn obj password)) ;; Social Security # is protected |
---|
391 | (define-operation (new-password obj old-passwd new-passwd)) |
---|
392 | (define-operation (bad-password obj bogus-passwd) |
---|
393 | ;; assume internal (design) error |
---|
394 | (error (format #f "Bad Password: ~s given to ~a~%" |
---|
395 | bogus-passwd |
---|
396 | (show obj #f)))) |
---|
397 | </enscript> |
---|
398 | |
---|
399 | ===== person implementation |
---|
400 | |
---|
401 | <enscript highlight=scheme> |
---|
402 | (define (make-person a-name an-age a-ssn the-password) |
---|
403 | (object |
---|
404 | ((person? self) #t) |
---|
405 | ((name self) a-name) |
---|
406 | ((age self) an-age) |
---|
407 | ((set-age! self val) (set! an-age val) an-age) |
---|
408 | ((ssn self password) |
---|
409 | (if (equal? password the-password) |
---|
410 | a-ssn |
---|
411 | (bad-password self password))) |
---|
412 | ((new-password self old-passwd new-passwd) |
---|
413 | (cond |
---|
414 | ((equal? old-passwd the-password) (set! the-password new-passwd) self) |
---|
415 | (else (bad-password self old-passwd)))) |
---|
416 | ((bad-password self bogus-passwd) |
---|
417 | (format #t "Bad password: ~s~%" bogus-passwd)) ;; let user recover |
---|
418 | ((show self port) |
---|
419 | (format port "#<Person: ~a age: ~a>~%" (name self) (age self))))) |
---|
420 | </enscript> |
---|
421 | |
---|
422 | ===== account-history and bank-account interfaces |
---|
423 | |
---|
424 | <enscript highlight=scheme> |
---|
425 | (define-predicate bank-account?) |
---|
426 | (define-operation (current-balance obj pin)) |
---|
427 | (define-operation (add obj amount)) |
---|
428 | (define-operation (withdraw obj amount pin)) |
---|
429 | (define-operation (get-pin obj master-password)) |
---|
430 | (define-operation (get-account-history obj master-password)) |
---|
431 | </enscript> |
---|
432 | |
---|
433 | ===== account-history implementation |
---|
434 | |
---|
435 | <enscript highlight=scheme> |
---|
436 | ;; put access to bank database and report generation here |
---|
437 | (define (make-account-history initial-balance a-pin master-password) |
---|
438 | ;; history is a simple list of balances -- no transaction times |
---|
439 | (letrec |
---|
440 | ((history (list initial-balance)) |
---|
441 | (balance (lambda () (car history))) ; balance is a function |
---|
442 | (remember |
---|
443 | (lambda (datum) (set! history (cons datum history))))) |
---|
444 | (object |
---|
445 | ((bank-account? self) #t) |
---|
446 | ((add self amount) ;; bank will accept money without a password |
---|
447 | (remember (+ amount (balance))) |
---|
448 | ;; print new balance |
---|
449 | (format #t "New balance: $~a~%" (balance))) |
---|
450 | ((withdraw self amount pin) |
---|
451 | (cond |
---|
452 | ((not (equal? pin a-pin)) (bad-password self pin)) |
---|
453 | ((< (- (balance) amount) 0) |
---|
454 | (format |
---|
455 | #t |
---|
456 | "No overdraft~% Can't withdraw more than you have: $~a~%" |
---|
457 | (balance))) |
---|
458 | (else |
---|
459 | (remember (- (balance) amount)) |
---|
460 | (format #t "New balance: $~a~%" (balance))))) |
---|
461 | ((current-balance self password) |
---|
462 | (if (or (eq? password master-password) (equal? password a-pin)) |
---|
463 | (format #t "Your Balance is $~a~%" (balance)) |
---|
464 | (bad-password self password))) |
---|
465 | ;; only bank has access to account history |
---|
466 | ((get-account-history self password) |
---|
467 | (if (eq? password master-password) |
---|
468 | history |
---|
469 | (bad-password self password)))))) |
---|
470 | </enscript> |
---|
471 | |
---|
472 | ===== bank-account implementation |
---|
473 | |
---|
474 | <enscript highlight=scheme> |
---|
475 | (define (make-account a-name an-age a-ssn a-pin initial-balance master-password) |
---|
476 | (object-with-ancestors |
---|
477 | ((customer (make-person a-name an-age a-ssn a-pin)) |
---|
478 | (account (make-account-history initial-balance a-pin master-password))) |
---|
479 | ((get-pin self password) |
---|
480 | (if (eq? password master-password) |
---|
481 | a-pin |
---|
482 | (bad-password self password))) |
---|
483 | ((get-account-history self password) |
---|
484 | ((operate-as account get-account-history) self password)) |
---|
485 | ;; our bank is very conservative... |
---|
486 | ((bad-password self bogus-passwd) |
---|
487 | (format #t "~%CALL THE POLICE!!~%")) |
---|
488 | ;; protect the customer as well |
---|
489 | ((ssn self password) |
---|
490 | ((operate-as customer ssn) self password)) |
---|
491 | ((show self port) |
---|
492 | (format port "#<Bank-Customer ~a>~%" (name self))))) |
---|
493 | </enscript> |
---|
494 | |
---|
495 | ===== Running the bank-account example |
---|
496 | |
---|
497 | <enscript highlight=scheme> |
---|
498 | (require-extension yasos) |
---|
499 | |
---|
500 | (define main |
---|
501 | (lambda () |
---|
502 | (let ( |
---|
503 | (fred (make-person "Fred" 19 "573-19-4279" 'FadeCafe)) |
---|
504 | (sally (make-account "Sally" 26 "629-26-9742" 'FeedBabe 263 'bank-password)) |
---|
505 | ) |
---|
506 | (show 'mist) |
---|
507 | (show fred) |
---|
508 | (printf "Fred's ssn: ~a~%" (ssn fred 'FadeCafe)) |
---|
509 | (printf "Fred: person? ~a bank-account? ~a~%" (person? fred) (bank-account? fred)) |
---|
510 | (show sally) |
---|
511 | (printf "Sally's ssn: ~a~%" (ssn sally 'FeedBabe)) |
---|
512 | (printf "Sally: person? ~a bank-account? ~a~%" (person? sally) (bank-account? sally)) |
---|
513 | (current-balance sally 'FeedBabe) |
---|
514 | (add sally 200) |
---|
515 | (add sally 300) |
---|
516 | (withdraw sally 400 'FeedBabe) |
---|
517 | (printf "Account history of Sally: ~a~%" (get-account-history sally 'bank-password)) |
---|
518 | (withdraw sally 150 (get-pin sally 'bank-password)) |
---|
519 | (printf "Account history of Sally: ~a~%" (get-account-history sally 'bank-password)) |
---|
520 | (printf "Bad password for Fred:~%") |
---|
521 | (ssn fred 'bogus) |
---|
522 | (printf "Bad password for Sally:") |
---|
523 | (ssn sally 'bogus) |
---|
524 | (void)))) |
---|
525 | (main) |
---|
526 | </enscript> |
---|
527 | |
---|
528 | === Module stacks |
---|
529 | |
---|
530 | an implementation of random-acces stacks |
---|
531 | |
---|
532 | ==== make-stack |
---|
533 | |
---|
534 | <procedure>(make-stack)</procedure> |
---|
535 | |
---|
536 | creates an empty stack. |
---|
537 | |
---|
538 | ==== make-ra-stack |
---|
539 | |
---|
540 | <procedure>(make-ra-stack)</procedure> |
---|
541 | |
---|
542 | creates an empty random access stack. |
---|
543 | |
---|
544 | ==== stack? |
---|
545 | |
---|
546 | <procedure>(stack? xpr)</procedure> |
---|
547 | |
---|
548 | stack predicate. |
---|
549 | |
---|
550 | ==== ra-stack? |
---|
551 | |
---|
552 | <procedure>(ra-stack? xpr)</procedure> |
---|
553 | |
---|
554 | random access stack predicate. |
---|
555 | |
---|
556 | ==== push! |
---|
557 | |
---|
558 | <procedure>(push! obj val)</procedure> |
---|
559 | |
---|
560 | pushes val onto the stack. |
---|
561 | |
---|
562 | ==== top |
---|
563 | |
---|
564 | <procedure>(top obj)</procedure> |
---|
565 | |
---|
566 | returns the top of the stack. |
---|
567 | |
---|
568 | ==== down |
---|
569 | |
---|
570 | <procedure>(down obj k)</procedure> |
---|
571 | |
---|
572 | returns the result of stepping down the ra-stack k times. |
---|
573 | |
---|
574 | ==== pop! |
---|
575 | |
---|
576 | <procedure>(pop! obj)</procedure> |
---|
577 | |
---|
578 | pops the stack. |
---|
579 | |
---|
580 | ==== empty? |
---|
581 | |
---|
582 | <procedure>(empty? obj)</procedure> |
---|
583 | |
---|
584 | is stack empty? |
---|
585 | |
---|
586 | ==== clear! |
---|
587 | |
---|
588 | <procedure>(clear! obj)</procedure> |
---|
589 | |
---|
590 | empties the stack. |
---|
591 | |
---|
592 | === Module queues |
---|
593 | |
---|
594 | an implementation of queues with amortized constant time access. |
---|
595 | |
---|
596 | ==== make-queue |
---|
597 | |
---|
598 | <procedure>(make-queue)</procedure> |
---|
599 | |
---|
600 | creates an empty queue. |
---|
601 | |
---|
602 | ==== queue? |
---|
603 | |
---|
604 | <procedure>(queue? xpr)</procedure> |
---|
605 | |
---|
606 | queue predicate. |
---|
607 | |
---|
608 | ==== enq! |
---|
609 | |
---|
610 | <procedure>(enq! obj val)</procedure> |
---|
611 | |
---|
612 | enqueues val onto the tail of the queue. |
---|
613 | |
---|
614 | ==== front |
---|
615 | |
---|
616 | <procedure>(front obj)</procedure> |
---|
617 | |
---|
618 | returns the first item of the queue. |
---|
619 | |
---|
620 | ==== deq! |
---|
621 | |
---|
622 | <procedure>(deq! obj)</procedure> |
---|
623 | |
---|
624 | dequeues the the first item from the queue. |
---|
625 | |
---|
626 | ==== empty? |
---|
627 | |
---|
628 | <procedure>(empty? obj)</procedure> |
---|
629 | |
---|
630 | is queue empty? |
---|
631 | q |
---|
632 | ==== clear! |
---|
633 | |
---|
634 | <procedure>(clear! obj)</procedure> |
---|
635 | |
---|
636 | empties the queue. |
---|
637 | |
---|
638 | === Module points |
---|
639 | |
---|
640 | an implementation of flat points. |
---|
641 | |
---|
642 | ==== make-point-cartesian |
---|
643 | |
---|
644 | <procedure>(make-point-cartesian x y)</procedure> |
---|
645 | |
---|
646 | creates a point from cartesian coordinates. |
---|
647 | |
---|
648 | ==== make-point-polar |
---|
649 | |
---|
650 | <procedure>(make-point-polar rho theta)</procedure> |
---|
651 | |
---|
652 | creates a point from polar coordinates. |
---|
653 | |
---|
654 | ==== point? |
---|
655 | |
---|
656 | <procedure>(point? xpr)</procedure> |
---|
657 | |
---|
658 | type predicate. |
---|
659 | |
---|
660 | ==== distance |
---|
661 | |
---|
662 | <procedure>(distance obj other)</procedure> |
---|
663 | |
---|
664 | computes the distance between the two points obj and otern. |
---|
665 | |
---|
666 | The following four procedures return the respective coordinates: |
---|
667 | |
---|
668 | ==== x |
---|
669 | |
---|
670 | <procedure>(x obj)</procedure> |
---|
671 | |
---|
672 | ==== y |
---|
673 | |
---|
674 | <procedure>(y obj)</procedure> |
---|
675 | |
---|
676 | ==== rho |
---|
677 | |
---|
678 | <procedure>(rho obj)</procedure> |
---|
679 | |
---|
680 | ==== theta |
---|
681 | |
---|
682 | <procedure>(theta obj)</procedure> |
---|
683 | |
---|
684 | The following three commands do what their names suggest: |
---|
685 | |
---|
686 | ==== scale! |
---|
687 | |
---|
688 | <procedure>(scale! obj factor)</procedure> |
---|
689 | |
---|
690 | ==== rotate! |
---|
691 | |
---|
692 | <procedure>(rotate! obj angle)</procedure> |
---|
693 | |
---|
694 | ==== translate! |
---|
695 | |
---|
696 | <procedure>(translate! obj dx dy)</procedure> |
---|
697 | |
---|
698 | === Author |
---|
699 | |
---|
700 | Kenneth Dickey |
---|
701 | Ken(dot)Dickey(at)Whidbey(dot)Com |
---|
702 | |
---|
703 | ported to CHICKEN and enhanced by Juergen Lorenz |
---|
704 | |
---|
705 | === Maintainer |
---|
706 | |
---|
707 | [[/users/juergen-lorenz|Juergen Lorenz]] |
---|
708 | |
---|
709 | === License |
---|
710 | |
---|
711 | COPYRIGHT (c) 1992,2008 by Kenneth A Dickey, All rights reserved. |
---|
712 | COPYRIGHT (c) 2013-2014 by Juergen Lorenz, All rights reserved. |
---|
713 | |
---|
714 | Permission is hereby granted, free of charge, to any person obtaining |
---|
715 | a copy of this software and associated documentation files (the |
---|
716 | "Software"), to deal in the Software without restriction, including |
---|
717 | without limitation the rights to use, copy, modify, merge, publish, |
---|
718 | distribute, sublicense, and/or sell copies of the Software, and to |
---|
719 | permit persons to whom the Software is furnished to do so, subject to |
---|
720 | the following conditions: |
---|
721 | |
---|
722 | The above copyright notice and this permission notice shall be |
---|
723 | included in all copies or substantial portions of the Software. |
---|
724 | |
---|
725 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, |
---|
726 | EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF |
---|
727 | MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND |
---|
728 | NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE |
---|
729 | LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,WHETHER IN AN ACTION |
---|
730 | OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION |
---|
731 | WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. |
---|
732 | |
---|
733 | === Changelog |
---|
734 | |
---|
735 | ; 1.5 : ported to CHICKEN 5 |
---|
736 | ; 1.4 : tests with define-test instead of simple-test |
---|
737 | ; 1.3 : operations and protocol added, define-operation with arbitrary lambda-lists, examples stacks, queues and points added |
---|
738 | ; 1.2 : fixes in the setup script and simplification of the set of files |
---|
739 | ; 1.1 |
---|
740 | ; 1.0 : initial import |
---|
741 | |
---|