sherin@linc.cis.upenn.edu.UUCP (06/14/87)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; ;;;
;;; 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)))))