Path: utzoo!attcan!uunet!tektronix!tekcrl!tekgvs!jans
From: jans@tekgvs.LABS.TEK.COM (Jan Steinman)
Newsgroups: comp.lang.smalltalk
Subject: Re: Polymorphism (really, contexts)
Message-ID: <5014@tekgvs.LABS.TEK.COM>
Date: 27 Apr 89 20:37:20 GMT
Organization: Tektronix Inc., Beaverton, Or.
Lines: 120

<<Given a method, you can find out the names of its temporaries, and given a 
context, you can find out the method that invoked it, but it is not very 
convenient.>>

<How do you do that?>

Many of these sorts of things are accessible through "thisContext", which is a 
first-class object that describes the execution state of a method:

1) "thisContext tempNames" returns the names of temporary variables.

2) "thisContext selector" returns the name of the method.

If using these in a method, what you probably really want is "thisContext 
sender ...", which is the context of the method that called the one that is 
executing.  If you want to send a message to the object that called you, rather 
than it's current execution state, try "thisContext sender receiver ...".

Agreed, it's messy, but can be useful.  When I had a bunch of methods that 
differed only by one datum, but for some reason (like use from a menu) I didn't 
want to pass an argument, I set up a bunch of "relay methods", that were really 
only additional method dictionary keys for one method.  That method then 
determined which selector it was called by, and took the apropriate action.  
(Sort of like shell scripts with references to "$0" in them.)

Here's some more fun things to do with contexts.  I especially find 
"isRecursive" invaluable.  This works with Tek Smalltalk.  PPS Smalltalk <= 2.3 
will require some hacking, and I have no idea if it will work at all in 
Smalltalk/V.  The blockish ones probalby won't work at all for >= PPS 2.4, 
because they are no longer Blue-Book compatible.  (If you own it, you can do 
what you want with it, I guess.)

(If using the Tek MailBrowser, double-click inside the curly brace and pick 
"file in".)

{'From Tektronix Smalltalk-80 version TB2.2.2a of May 05, 1988, 18:14:03.'!

'$Header: ContextMods.st,v 1.1 89/02/13 12:35:51 jans Exp $'!

"The following methods add various functionality to Contexts."!

!BlockContext methodsFor: 'accessing'!

argCount
        "Return the number of arguments the receiver expects."

        ^nargs! !

!BlockContext methodsFor: 'testing'!

isEmpty
	"Is this block devoid of any code?  Is the block only big enough for pushing 
args and returning?"

	^(self method at: startpc-2) \\ 16 - 4 * 16r100 + (self method at: startpc-1) 
- nargs = 2! !

!ContextPart methodsFor: 'message handling'!

sendersDo: aBlock
	"Cause each object in the stack to execute <aBlock> with itself as the 
argument."

	| ctx |
	ctx _ self home.
		[aBlock value: ctx receiver.
		(ctx _ ctx sender) == nil] whileFalse:
			[ctx _ ctx home "skip intervening contexts"]!

senderPerform: selector withArguments: args ifAbsent: exception
	"Look for an object in the stack who can respond to <selector>.  Send that 
object the message <selector> with the arguments <args>.  If no respondents are 
found, execute <exception>."

	self sendersDo: [:receiver | (receiver respondsTo: selector)
		ifTrue: [^receiver perform: selector withArguments: args]].
	exception!

senderClass: aClass perform: selector withArguments: args
	"Look for an object in the stack of class <aClass> and send it the message 
<selector> with the arguments <args>, returning the result."

	self sendersDo: [:receiver | receiver class == aClass
		ifTrue: [^receiver perform: selector withArguments: args]].
	exception! !

self notify:
'My version of this has original Xerox code.  To avoid
copyright problems, I turned it into a relay.  Rename
"printOn:" to "printOnOld:" before proceeding."'!

!ContextPart methodsFor: 'printing'!

printOn: aStream
	"Print a textual representation of this context on <aStream>, as either class 
and selector, or source code."

	| mclass selector class |
	Sensor leftShiftDown ifTrue: [^aStream cr; nextPut: $'; nextPutAll: self 
sourceCode; nextPut: $'].
	self printOnOld: aStream! !

!ContextPart methodsFor: 'testing'!

isRecursive
	"Does the sender's receiver and method appear previously in this context?"

	| ctx obj meth |
	ctx _ self home.
	obj _ self receiver.
	meth _ self method.
		[(ctx _ ctx sender) == nil] whileFalse:
			[ctx _ ctx home.		"Optimization: skip intervening contexts."
			(ctx method == meth and: [ctx receiver == obj]) ifTrue: [^true]].
	^false! !
}

:::::: Jan Steinman - N7JDB		   Electronic Systems Laboratory ::::::
:::::: jans@tekgvs.LABS.TEK.COM	      Box 500, MS 50-370 (w)503/627-5881 ::::::
:::::: jsteinma@caip.RUTGERS.EDU     Beaverton, OR 97077 (h)503/657-7703 ::::::