Hi!

    We've done some funny things this weekend... here is one

    After filing in this change set you'll be able to add methods to an
object (not its class).
    This implementation lacks a lot of things, for example, something to
remove this methods (what can be done only manually)
   Some examples so it gets clear (test them on new methods, not
overwriting class' methods)

"initialize the system"
OriginalMethods _ Dictionary new.
InstanceMethods _ Dictionary new.

"some examples"

"create two test objects"

b _ Object new.
a _ Object new.

"add a method named #uno to object named a"
a addMethod: 'uno
 ^ ''aaaa | #uno''' selector: #uno.

b addMethod: 'uno
 ^ ''bbbb | #uno''' selector: #uno.

a addMethod: '+ arg
 ^ ''aaaa | #+ '',arg printString' selector: #+.

b addMethod: '+ arg
 ^ ''bbbb | #+ '',arg printString' selector: #+.

a addMethod: 'uno: arg
 ^ ''aaaa | #uno: '',arg printString' selector: #uno:.

b addMethod: 'uno: arg
 ^ ''bbbb | #uno: '', arg printString' selector: #uno:.

"print every line to test the engine"
a uno
b uno
a + 1
b + 2
a uno: 1
b uno: 2

"this lines are to show that standard instances still perform the
original method"
Object new uno
Object new + 1
Object new uno: 1

    There are a lot of things to do before this gets usable, things we
know and things we don't know, but still this is a starting point.We'll
keep on working on this.

    Instanciated Bye!
    Richie++

    Let's get Morefreak with MorphicWrappers!    (-:

--
A390 1BBA 2C58 D679 5A71 - 86F9 404F 4B53 3944 C2D0
Investigacion y Desarrollo - CoreLabs - Core SDI
http://www.core-sdi.com

-------------- next part --------------
'From Squeak2.8alpha of 19 February 2000 [latest update: #1762] on 21 February 2000 at 12:15:19 pm'!

!ProtoObject methodsFor: 'object protocol' stamp: 'r++ 2/21/2000 00:59'!
addMethod: aString selector: aSymbol
	| oldMethod selector newMethodSource |

	newMethodSource _ self invocationStringFor: aSymbol.
	oldMethod _ self class compiledMethodAt: aSymbol
		ifAbsent: [	"there wasn't a class' version of the method to be added"
			self class compile: (newMethodSource, '
	^ super ',newMethodSource).
			self class compiledMethodAt: aSymbol].
	selector _ self class compile: aString.
	selector ~= aSymbol ifTrue: ["there was an error compiling or aSymbol didn't match aStirng's selector"^ nil].

	(OriginalMethods at: self class ifAbsentPut: [Dictionary new])
		at: selector ifAbsentPut: [oldMethod].
	(InstanceMethods at: selector ifAbsentPut: [IdentityDictionary new])
		at: self put: (self class compiledMethodAt: selector).

	"In the next code, #OriginalMethod and #InstancesMethods are used as a placeholder for
	((OriginalMethods at: self class) at: selector) which is later put in its
	place into the literal frame"

	newMethodSource _ newMethodSource, '
	"Don''t recompile this method, literals for #OriginalMethod and #InstancesMethods
	was changed by ProtoObject | #addMethod:selector:"
	| answer |
	
	self class
		addSelector: #',(self class defaultSelectorForMethod: oldMethod),'
		withMethod: (#InstancesMethods at: self ifAbsent: [#OriginalMethod]).
	answer _ self ', (self invocationStringFor: (self class defaultSelectorForMethod: oldMethod)),'.
	self class removeSelector: #',(self class defaultSelectorForMethod: oldMethod),'.
	^ answer
'.
	self class compile: newMethodSource.
	(self class compiledMethodAt: selector)
		replaceLiteral: #OriginalMethod
			with: ((OriginalMethods at: self class) at: selector);
		replaceLiteral: #InstancesMethods
			with: (InstanceMethods at: selector).! !

!ProtoObject methodsFor: 'object protocol' stamp: 'r++ 2/20/2000 16:53'!
invocationStringFor: selector
	| strm keyws |
	selector isUnary ifTrue: [^selector asString].
	strm _ WriteStream on: ''.
	1 to: (keyws _ selector keywords) size do: [:i |
		strm
			nextPutAll: (keyws at: i);
			nextPut: $ ;
			nextPutAll: 'arg'.
		i printOn: strm.
		strm nextPut: $ ].
	^ strm contents asString	! !


!CompiledMethod methodsFor: 'literals' stamp: 'r++ 2/21/2000 00:21'!
replaceLiteral: anObject with: anotherObject
	 1 to: self numLiterals do: [:i |
		(self literalAt: i) == anObject ifTrue: [self literalAt: i put: anotherObject. ^ self]].! !