🚀 go-pugleaf

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