SCOOPS bug-fixes

[sherin@linc.cis.upenn.edu (Steve Sherin)]

5/24/87--METHODS.SCM:
In the define-methods macro

> ,formal-list <

was changed to > ',formal-list <
to enable methods with parameters.
>>Steve Sherin


5/25/87
In the file INSTANCE.SCM:
(define-macro (%sc-compile-class class)  ... )

has been changed to

(define (%sc-compile-class class)
  (begin
    (%inherit-method-vars class)
    (eval (%make-template (%sc-name class) class) 
		user-initial-environment)))
This made sure classes always compile in the user-initial-environment.

>>Steve Sherin

5/25/87
=======
In methods.scm:
(syntax-table-define ... 'define-macro ...)

was modified to 
(syntax-table-define system-global-syntax-table 'define-method (macro e
	(let ((class-name (caar e))
	      (method-name (cadar e))
	      (formal-list (cadr e))
	      (body (cddr e)))
	`(%sc-class-add-method
	',class-name
	',method-name
	',class-name
	',class-name
	(append (list 'lambda ',formal-list) ',body) 
	(lambda (env quoted-val)
	  (let* ((method-name ',method-name)
		 (temp `(in-package ,env (define ,method-name
		 	 ,quoted-val))))
		(eval temp (the-environment)))
)))))

Change enabled methods with multiple expressions within the main
lambda.

>>Steve Sherin


6/6/87

In INTERF.SCM:
changed

       (empty-slot?
         (lambda (form)
	   (not (eval form (the-environment)))))


to


	(empty-slot?
	  (lambda (form)
	  (cond
		((symbol? form) #f)
		((eq? form #f) #t)
		(else #f))))


Hence, "no more functions" for an active-value set- or get-
method is specified by a CONSTANT value for the false value.
The change provides the ability to use forward references
to methods as yet undefined when active values are declared.
(Thanks Eric.)

NB  This code does NOT check for the symbol >> false <<
as it is not used in r3rs and can be modified as any other
variable.

>> Steve Sherin




6/13/87
Send.scm was rewritten, correcting the following:

Errors during the use of send, send-if-handles now do not
mess up the interpreter.  Circularly sent messages are now
allowed.

>> Steve Sherin
-----------------------------------------------------------------
Here's the new version of send.scm:
----------------Cut here.----------------------------------------
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;                                                                 ;;;
;;;                     S c o o p s                                 ;;;
;;;                                                                 ;;;
;;;                                                                 ;;;
;;;		Rewritten 5/20/87 for cscheme			    ;;;
;;;		by Steve Sherin--U of P				    ;;;
;;;                   File : send.scm                               ;;;
;;;                                                                 ;;;
;;;                 Amitabh Srivastava                              ;;;
;;;                                                                 ;;;
;;;-----------------------------------------------------------------;;;
;;;    One does not have to use the SEND form to invoke methods     ;;;
;;;    in the same class; they can be invoked as Scheme functions.  ;;;
;;;                                                                 ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;; send

(syntax-table-define system-global-syntax-table 'send
	(macro e

(let ((args (cddr e))
	(msg (cadr e))
	(obj (car e)))
    `(let* ((set-parent! (access system-environment-set-parent! 
			environment-package))
	(ep environment-parent)
	(ibot ,obj)
	(itop (ep (ep ibot)))
	(ipar (ep itop))
	(class (access %sc-class ibot))
	(ctop (%sc-class-env class))
	(cpar (ep ctop))
	(cbot (%sc-method-env class))
	(instance-safe? (eq? ipar cbot)))

  (without-interrupts
   (lambda ()
    (dynamic-wind
      (lambda ()
        (set-parent! ctop ibot)
	(if instance-safe?
         (set-parent! itop cpar))) 


	(lambda ()
	 (in-package cbot (,msg ,@args)))

      (lambda ()
	  (set-parent! ctop cpar)
	  (set-parent! itop cbot))
	)))))))


;;; send-if-handles

(syntax-table-define system-global-syntax-table 'send-if-handles (macro e
    (let ((obj (car e))
	  (msg (cadr e))
	  (args (cddr e)))
`(let
	((self ,obj))

     	     (if (assq ',msg (%sc-method-structure (access %sc-class self)))
			(send self ,msg ,@args)
			#!false)))))