dleigh@hplabsz.HPL.HP.COM (Darren Leigh) (10/09/90)
There are a couple of bugs in the xscheme objects implementation. These
were found while trying to translate Tim Mikkelsen's XLISP 2.0 Objects
Primer to work with xscheme. Enclosed are the bug fixes and the xscheme
translation of Tim's Objects Primer.
Both fixes are in the file xsobj.c.
The first is in the function clisnew(). The line:
xlval = newframe(getivar(super,CVARS),listlength(xlval)+1);
should be:
xlval = newframe(getivar(super,CVARS),listlength(cvars)+2);
This bug was found and fixed by David Duke, david@batserver.cs.uq.OZ.AU.
Thanks David!
The second bug is in the function xsendsuper(). The lines:
/* get the message class and the 'self' object */
cls = getivar(getelement(car(cdr(obj)),0),SUPERCLASS);
obj = car(obj);
should be:
/* get the message class and the 'self' object */
obj = car(obj);
cls = getivar(getclass(obj),SUPERCLASS);
This one was found and fixed by me.
Below is an xscheme translation of the xlisp object code from Tim
Mikkelsen's objects primer. Share and enjoy. If you have any questions
or further bugs and fixes, please let me know.
Darren Leigh -- (415) 857-6713
dleigh@hplabs.hp.com
hplabs!dleigh
========================== cut here ===================================
(define my-tools (class 'new '(power moveable operation)))
(my-tools 'answer 'isnew '(pow mov op) '((set! power pow)
(set! moveable mov)
(set! operation op)
self))
(define drill (my-tools 'new 'AC t 'holes))
(define hand-saw (my-tools 'new 'none t 'cuts))
(define table-saw (my-tools 'new 'AC nil 'cuts))
(drill 'show)
(hand-saw 'show)
(object 'show)
(class 'show)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; Define the superclasses and classes
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; make TOOLS superclass
; with a different 'ISNEW method
; added methods are 'BORROW and 'RETURN
; class variables are NUMBER contains # of tool instances
; ACTIVE-LIST contains list of current objects
; instance variables are POWER list - (AC BATTERY HAND)
; MOVEABLE CAN-CARRY or CAN-ROLL or FIXED
; OPERATIONS list
; MATERIAL list - (WOOD METAL PLASTIC ...)
; PIECES list
; LOCATION HOME or person's name
;
(define tools (class 'new '(power moveable operations material pieces location)
'(number active-list)))
(tools 'answer 'isnew '() '((if (null? number) (set! number 1)
(set! number (1+ number)))
(set! active-list (cons self active-list))
(set! location 'home)
self))
(tools 'answer 'borrow '(by-who)
'((if (eq? location 'home) (set! location by-who)
(princ "you can't"))))
(tools 'answer 'return '()
'((if (eq? location 'home) (princ "got it already")
(set! location 'home))))
;
; make HAND-TOOLS class
; with a different 'ISNEW method
; new instance variable WEIGHT <number> of pounds
; the rest is inherited from TOOLS
;
(define hand-tools (class 'new '(weight) '() tools))
(hand-tools 'answer 'isnew '(pow op mat parts w-in)
'((set! power pow)
(set! moveable 'can-carry)
(set! operations op)
(set! material mat)
(set! pieces parts)
(set! weight w-in)
(send-super 'isnew)
self))
;
; make SHOP-TOOLS class
; with a different 'ISNEW method
; no new instance variables
; the rest is inherited from TOOLS
;
(define shop-tools (class 'new '() '() tools))
(shop-tools 'answer 'isnew '(pow mov op mat parts)
'((set! power pow)
(set! moveable mov)
(set! operations op)
(set! material mat)
(set! pieces parts)
(send-super 'isnew)
self))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; Create instances of various tool classes
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define hand-drill (hand-tools 'new ; make an instance - HAND-DRILL
'(ac)
'(drill polish grind screw)
'(wood metal plastic)
'(drill drill-bits screw-bits buffer)
'2.5))
(define table-saw (shop-tools 'new ; make an instance - TABLE-SAW
'(ac)
'fixed
'(rip cross-cut)
'(wood plastic)
'(saw blades fence)))
(define radial-arm (shop-tools 'new ; make an instance = RADIAL-ARM
'(ac)
'can-roll
'(rip cross-cut)
'(wood plastic)
'(saw blades dust-bag)))
(hand-drill 'borrow 'fred)
(table-saw 'return)
(hand-drill 'borrow 'joe)
(hand-drill 'return)
(tools 'show)
(hand-tools 'show)
(shop-tools 'show)
(hand-drill 'show)