Metaclass fun

Travis Griggs tgriggs at keyww.com
Tue Apr 21 05:33:38 UTC 1998


Oops, wrong file attachment. Here's the right one.

--
Travis Griggs
Key Technology
tgriggs at keyww.com
To Smalltalk! - and Beyond!


'From Squeak 1.31 of Feb 4, 1998 on 20 April 1998 at 2:45:46 pm'!

!Object methodsFor: 'error handling'!
attemptToUnderstand: aMessage 
	"go and see if we can find a keyword selector whose keys are the same but in different order, if we can then reorder the arguments appropriately and resend the reordered selector and arguments - returns the argument when resolution is not possible"

	"the very first thing we do is find out whether this even makes sense and eliminate wasted cycles trying to correct a condition that can't be corrected, that where there's not more than one keyword"

	| oldSel oldArgs oldKeys newSel newArgs newKeys |
	(oldArgs := aMessage arguments) size <= 1 ifTrue: [^aMessage].
	oldSel := aMessage selector.
	oldKeys := oldSel keywords.
	(newSel := self class allSelectors 
				detect: [:eachAltSel | eachAltSel sameKeywords: oldKeys]
				ifNone: [nil]) isNil 
		ifTrue: [^aMessage].
	newKeys := newSel keywords.
	newArgs := Array new: oldArgs size.	"the common case is probably a 2 key inversion, in this case, it's just a transposition of the argument array, and we can save a bit of time avoiding indexing"
	newArgs size = 2 
		ifTrue: 
			[newArgs
				at: 1 put: (oldArgs at: 2);
				at: 2 put: (oldArgs at: 1)]
		ifFalse: 
			[newKeys keysAndValuesDo: 
					[:index :keyword | 
					newArgs at: index put: (oldArgs at: (oldKeys indexOf: keyword))]].
	^self perform: newSel withArguments: newArgs! !

!Object methodsFor: 'error handling' stamp: 'TAG 4/20/98 14:33'!
doesNotUnderstand: aMessage 
	 "Handle the fact that there was an attempt to send the given message to the receiver but the receiver does not understand this message (typically sent from the machine when a message is sent to the receiver and no method is defined for that selector)."
	"Unless the receiver has an error handler defined for the active process, report to the user that the receiver does not understand the argument, aMessage, as a message."
	"Testing: (3 activeProcess)"

	| handler errorString result |
	(Preferences autoAccessors and: [self tryToDefineVariableAccess: aMessage])
		ifTrue: [^ aMessage sentTo: self].
	(result _ self attemptToUnderstand: aMessage) == aMessage ifFalse: [^result].
	errorString _ 'Message not understood: ', aMessage selector.
	(handler _ Processor activeProcess errorHandler) notNil
		ifTrue: [handler value: errorString value: self]
		ifFalse: [DebuggerView openContext: thisContext
					label: errorString
					contents: thisContext shortStack].
	^ aMessage sentTo: self! !


!Collection methodsFor: 'testing' stamp: 'TAG 4/20/98 14:36'!
conforms: aBlock
	"enumerate a collection to verify if ALL elements answer true inside of aBlock"

	self do: [:each | (aBlock value: each) ifFalse: [^false]].
	^true! !


!Symbol methodsFor: 'system primitives'!
sameKeywords: aCollectionOfKeywords 
	"return whether the reciever represents the equivalent set of keywords, regardless of order"

	^self numArgs = aCollectionOfKeywords size 
		and: [self keywords conforms: [:each | aCollectionOfKeywords includes: each]]! !





More information about the Squeak-dev mailing list