[Seaside-dev] WADelayedMessageSend (issue 268)

[Paolo Bonzini]

Here is my try, together with testcases.  I suppose integrating it is
easier than rewriting it.

There's quite some duplication, but at the end you risk being slower
than the blocks you're trying to replace (though memory usage will be of
course lower, except on VW or other implementations with copying blocks).

Paolo
-------------- next part --------------
Object subclass: #WADelayedMessageSend
	instanceVariableNames: 'freeSlotsCount fixedSlotsCount receiver selector fixedArgs'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Seaside-Core'!

!WADelayedMessageSend class methodsFor: 'instance creation'!

selector: aSymbol
	^self new selector: aSymbol fixedSlots: #()
!

receiver: anObject selector: aSymbol
	^self new selector: aSymbol fixedSlots: (Array with: anObject)
!

receiver: anObject selector: aSymbol argument: argObject
	^self new selector: aSymbol fixedSlots: (Array with: anObject with: argObject)
!

receiver: anObject selector: aSymbol arguments: anArray
	^self new selector: aSymbol fixedSlots: (Array with: anObject), anArray
! !

!WADelayedMessageSend methodsFor: 'instance creation'!

value
	freeSlotsCount = 0 ifFalse: [ ^self wrongArgCountError ].
	^receiver perform: selector withArguments: fixedArgs
!

value: anObject
	| actuals |
	freeSlotsCount = 1 ifFalse: [ ^self wrongArgCountError ].
	fixedSlotsCount = 0 ifTrue: [ ^anObject perform: selector ].
	fixedSlotsCount = 1 ifTrue: [ ^receiver perform: selector with: anObject ].
	fixedSlotsCount = 2 ifTrue: [ ^receiver perform: selector with: (fixedArgs at: 1) with: anObject ].

	actuals := Array new: fixedSlotsCount.
	actuals replaceFrom: 1 to: fixedSlotsCount - 1 with: fixedArgs startingAt: 1.
	actuals at: fixedSlotsCount put: anObject.
	^receiver perform: selector withArguments: actuals
!

value: obj1 value: obj2
	| actuals |
	freeSlotsCount = 2 ifFalse: [ ^self wrongArgCountError ].
	fixedSlotsCount = 0 ifTrue: [ ^obj1 perform: selector with: obj2 ].
	fixedSlotsCount = 1 ifTrue: [ ^receiver perform: selector with: obj1 with: obj2 ].
	fixedSlotsCount = 2 ifTrue: [ ^receiver perform: selector with: (fixedArgs at: 1) with: obj1 with: obj2 ].

	actuals := Array new: fixedSlotsCount + 1.
	actuals replaceFrom: 1 to: fixedSlotsCount - 1 with: fixedArgs startingAt: 1.
	actuals at: fixedSlotsCount put: obj1.
	actuals at: fixedSlotsCount + 1 put: obj2.
	^receiver perform: selector withArguments: actuals
!

value: obj1 value: obj2 value: obj3
	| actuals |
	freeSlotsCount = 3 ifFalse: [ ^self wrongArgCountError ].
	fixedSlotsCount = 0 ifTrue: [ ^obj1 perform: selector with: obj2 with: obj3 ].
	fixedSlotsCount = 1 ifTrue: [ ^receiver perform: selector with: obj1 with: obj2 with: obj3 ].

	actuals := Array new: fixedSlotsCount + 2.
	actuals replaceFrom: 1 to: fixedSlotsCount - 1 with: fixedArgs startingAt: 1.
	actuals at: fixedSlotsCount put: obj1.
	actuals at: fixedSlotsCount + 1 put: obj2.
	actuals at: fixedSlotsCount + 2 put: obj3.
	^receiver perform: selector withArguments: actuals
!

valueWithArguments: args
	| actuals totalSlots |
	freeSlotsCount = args size ifFalse: [ ^self wrongArgCountError ].
	freeSlotsCount = 0 ifTrue: [ ^receiver perform: selector withArguments: fixedArgs ].
	fixedSlotsCount = 0 ifTrue: [ ^(args at: 1) perform: selector withArguments: (args copyFrom: 2) ].
	fixedSlotsCount = 1 ifTrue: [ ^receiver perform: selector withArguments: args ].

	totalSlots := fixedSlotsCount + freeSlotsCount - 1.
	actuals := Array new: totalSlots.
	actuals replaceFrom: 1 to: fixedSlotsCount - 1 with: fixedArgs startingAt: 1.
	actuals replaceFrom: fixedSlotsCount to: totalSlots with: args startingAt: 1.
	^receiver perform: selector withArguments: actuals
!

!WADelayedMessageSend methodsFor: 'accessing'!

numArgs
	^freeSlotsCount
! !

!WADelayedMessageSend methodsFor: 'private'!

wrongArgCountError
	self error: 'invalid number of arguments'
! !

!WADelayedMessageSend methodsFor: 'initialization'!

selector: aSymbol fixedSlots: anArray
	selector := aSymbol.
	freeSlotsCount := (aSymbol numArgs + 1) - anArray size.
	fixedSlotsCount := anArray size.
	receiver := anArray at: 1 ifAbsent: [nil].
	fixedArgs := fixedSlotsCount = 0 ifTrue: [nil] ifFalse: [anArray allButFirst].
! !

TestCase subclass: #WADelayedMessageSendTest
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Seaside-Core-Tests'!

!WADelayedMessageSendTest methodsFor: 'helpers'!

assertValue: aDMS is: result
	self assert: aDMS value = result.
	self assert: (aDMS valueWithArguments: #()) = result
!

assert: aDMS value: arg is: result
	self assert: (aDMS value: arg) = result.
	self assert: (aDMS valueWithArguments: (Array with: arg)) = result
!

assert: aDMS value: arg value: arg2 is: result
	self assert: (aDMS value: arg value: arg2) = result.
	self assert: (aDMS valueWithArguments: (Array with: arg with: arg2)) = result
!

assert: aDMS value: arg value: arg2 value: arg3 is: result
	self assert: (aDMS value: arg value: arg2 value: arg3) = result.
	self assert: (aDMS valueWithArguments: (Array with: arg with: arg2 with: arg3)) = result
! !

!WADelayedMessageSendTest methodsFor: 'testcases'!

testSelector
	self
		assert: (WADelayedMessageSend selector: #abs)
		value: -15
		is: 15.
	self
		assert: (WADelayedMessageSend selector: #*)
		value: 5
		value: 3
		is: 15.
	self
		assert: (WADelayedMessageSend selector: #ifTrue:ifFalse:)
		value: true
		value: [15]
		value: [-15]
		is: 15.
!

testReceiverSelector
	self
		assertValue: (WADelayedMessageSend receiver: -15 selector: #abs)
		is: 15.
	self
		assert: (WADelayedMessageSend receiver: 5 selector: #*)
		value: 3 is: 15.
	self
		assert: (WADelayedMessageSend receiver: true selector: #ifTrue:ifFalse:)
		value: [15]
		value: [-15]
		is: 15.
!

testReceiverSelectorArgument
	self
		assertValue: (WADelayedMessageSend receiver: 5 selector: #* argument: 3)
		is: 15.
	self
		assert: (WADelayedMessageSend receiver: true selector: #ifTrue:ifFalse: argument: [15])
		value: [-15]
		is: 15.
!

testReceiverSelectorArguments
	self
		assertValue: (WADelayedMessageSend receiver: 5 selector: #* arguments: #(3))
		is: 15.
	self
		assertValue: (WADelayedMessageSend receiver: 10 selector: #between:and: arguments: #(-15 15))
		is: true.
	self
		assert: (WADelayedMessageSend receiver: 10 selector: #between:and: arguments: #(-15))
		value: 15
		is: true.
! !