Path: utzoo!attcan!utgpu!jarvis.csri.toronto.edu!mailrus!cs.utexas.edu!uunet!mcsun!sunic!liuida!mikpe From: mikpe@senilix.ida.liu.se (Mikael Pettersson) Newsgroups: comp.lang.lisp.x Subject: Re: xscheme oop package Summary: bug fix Message-ID: <1343@senilix.ida.liu.se> Date: 16 Sep 89 18:23:12 GMT References: <1341@majestix.ida.liu.se> Organization: CIS Dept, Univ of Linkoping, Sweden Lines: 152 In article <1341@majestix.ida.liu.se> I wrote: >... The following two files implement, in Scheme, an object mechanism >that is supposed to be near 100% compatible with those in xscheme and xlisp. Oops! Except for some bugs in the handling of class variables that is :-( (methods could execute in the wrong class context and class variables weren't inherited properly). The following context diff to "obj.scm" should fix this. Sorry 'bout the inconvenience. /Mike *** obj.scm.~1~ Fri Sep 15 22:35:57 1989 --- obj.scm Sat Sep 16 19:22:09 1989 *************** *** 6,12 **** --- 6,15 ---- ;; Version 1.0 Sep 15, 1989 (mpe@ida.liu.se) ;; Released to comp.lang.lisp.x ;; + ;; Version 1.1 Sep 16, 1989 (mpe@ida.liu.se) + ;; Fixed some bugs in class variable handling ;; + ;; ;; Implementation notes ;; ==================== ;; An object is represented by a closure with bindings for the *************** *** 29,34 **** --- 32,38 ---- ;; 5 the state of the superclass ;; 6 number of class instance variables ;; 7 total number of instance variables + ;; 8 list of initial class variable values ;; ;; Methods execute in a pseudo-environment (see cl-answer) with bindings ;; for SELF and the instance and class variables. Free variables are *************** *** 89,94 **** --- 93,100 ---- (macro set-ivarcnt! (mkvset 6)) (macro get-ivartotal (mkvref 7)) (macro set-ivartotal! (mkvset 7)) + (macro get-cinits (mkvref 8)) + (macro set-cinits! (mkvset 8)) ;; ;; make a package to hide the implementation details *************** *** 100,106 **** ;; misc. stuff ;; ! (define class-size 7) (define (new-object-state slots) (make-vector (1+ slots))) ; add one for SELF --- 106,112 ---- ;; misc. stuff ;; ! (define class-size 8) (define (new-object-state slots) (make-vector (1+ slots))) ; add one for SELF *************** *** 112,118 **** (define (send cls-state o-cls-state obj-state msg argl) ;; cls-state is where we begin searching for the method ;; o-cls-state is the original class-state for 'self' - ;; (needed for some built-in methods) ;; obj-state is the state for 'self' (let (m) (while (and cls-state --- 118,123 ---- *************** *** 120,126 **** (null? m))) (set! cls-state (get-super-state cls-state))) (if m ! ((cdr m) obj-state o-cls-state (get-cvals cls-state) argl) (error "no method for this message" msg (get-self obj-state))))) (define (assert-null! argl who) --- 125,131 ---- (null? m))) (set! cls-state (get-super-state cls-state))) (if m ! ((cdr m) obj-state o-cls-state (get-cvals o-cls-state) argl) (error "no method for this message" msg (get-self obj-state))))) (define (assert-null! argl who) *************** *** 207,219 **** ;; store the instance and class variable lists and the superclass (set-ivars! self-state (append (get-ivars super-state) (append ivars '()))) ! (if cvars ! (let ((naml (map (lambda (x) (if (symbol? x) x (car x))) ! cvars)) ! (vals (map (lambda (x) (if (symbol? x) '() (cadr x))) ! cvars))) ! (set-cvals! self-state (list->vector vals)) ! (set-cvars! self-state naml))) (set-super-state! self-state super-state) ;; compute the instance variable count --- 212,227 ---- ;; store the instance and class variable lists and the superclass (set-ivars! self-state (append (get-ivars super-state) (append ivars '()))) ! (set-cvars! self-state ! (append (get-cvars super-state) ! (map (lambda (x) (if (symbol? x) x (car x))) cvars))) ! (if (get-cvars self-state) ! (begin ! (set-cinits! self-state ! (append (get-cinits super-state) ! (map (lambda (x) (if (symbol? x) '() (cadr x))) ! cvars))) ! (set-cvals! self-state (list->vector (get-cinits self-state))))) (set-super-state! self-state super-state) ;; compute the instance variable count *************** *** 316,322 **** (entermsg! Object-state 'show ob-show) (entermsg! Object-state '%state ob-state) ; used by cl-isnew ! (set-ivars! Class-state '(messages ivars cvars cvals super-state ivarcnt ivartotal)) (set-ivarcnt! Class-state class-size) (set-ivartotal! Class-state class-size) (set-super-state! Class-state Object-state) --- 324,330 ---- (entermsg! Object-state 'show ob-show) (entermsg! Object-state '%state ob-state) ; used by cl-isnew ! (set-ivars! Class-state '(messages ivars cvars cvals super-state ivarcnt ivartotal cinits)) (set-ivarcnt! Class-state class-size) (set-ivartotal! Class-state class-size) (set-super-state! Class-state Object-state) *************** *** 349,351 **** --- 357,361 ---- (put 'set-ivarcnt! '%macro '()) (put 'get-ivartotal '%macro '()) (put 'set-ivartotal! '%macro '()) + (put 'get-cinits '%macro '()) + (put 'set-cinits! '%macro '()) -- Mikael Pettersson, Dept of Comp & Info Sci, University of Linkoping, Sweden email: mpe@ida.liu.se or ..!{mcvax,munnari,uunet}!enea!liuida!mpe