[ANN] LambdaMessageSend on SqueakMap
Stéphane Rollandin
lecteur at zogotounga.net
Sun May 14 19:52:50 UTC 2006
Alexandre Bergel wrote:
> Hello,
>
> I like this. But where can I try it ? Squeaksource and squeakmap do not
> know about it. I would like to see more about it.
it's on SqueakMap: the name is LambdaMessageSend:
http://map.squeak.org/package/6bc04644-035c-4d47-a513-f7cde7b01bad
anyway, attached to this post is the latest version, not even on
SqueakMap yet :)
file it into a 3.8 image
>>
>> you can do things like:
>>
>> | x y f g j |
>>
>> x _ Lambda x.
>> y _ Lambda y.
>
> Why do you use the term lambda to create a variable ?
>
That's syntactic sugar. The full expression would be
x _ LambdaSlot id: 'x'
and in the newest version of the package which I am currently working on
(the one attached to this post), it would be
x _ AtomicLambdaMessageSend receiver: (LambdaSlot id: 'x')
whatever, the idea is that x is not a variable name, it's an instance of
the lambda function identity which evaluates to its (single) argument.
AtomicLambdaMessageSend instances are the leaves of the recursive
evaluation mechanism.
>> f _ ((x*x) + (y*y)) sqrt.
>
> Why is there no term named lambda here ?
x and y are themselves the lambda functions used to build f
so f is a LambdaMessageSend whose receiver is ((x*x) + (y*y)), a
LambdaMessageSend, and selector is #sqrt.
now ((x*x) + (y*y)) is itself a LambdaMessageSend whose receiver is
(x*x), selector #+ and argument (y+y) which is also a LambdaMessageSend.
the tree has two branchs.
(x*x) is a LambdaMessageSend in which both receiver and argument are x,
an AtomicLambdaMessageSend . this is the end of one branch, with two
identical (in the == sense) leaves.
same thing for (y*y)
>
>> self assert: f printString = '(((<x> * <x>) + (<y> * <y>)) sqrt)'.
>> self assert: {3 . 4} ~~> f = 5.
>> g := ('y' -> 0) ~>> f.
>
> I like this mechanism of curryfication.
yes, you can also do
g := (Lambda . 0) ~~> f.
BTW I made all arrow operators work in both directions, so you can also do
g := f <~~ (Lambda . 0)
or
g := f <<~ ('y' -> 0)
the operators are:
@> and <@ substitute the (single) argument
@@> and <@@ substitute the array of arguments
~> and <~ substitute and reduce (one single arguments)
~~> and <~~ substitute and reduce (arguments array)
~>> and <<~ substitute one named slot
~~>> and <<~~ substitute several named slots
>
>> self assert: g printString = '(((<x> * <x>) + 0) sqrt)' .
>> self assert: 3 ~> g = 3.
>>
>
>> j := ('y' -> (Lambda z1 + Lambda z2)) ~>> f.
>
> I did not get this one... Could you explain a bit ?
in j, the y in f is replaced by (z1 + z2). so j is now a function of
three arguments:
(((<x> * <x>) + ((<z1> + <z2>) * (<z1> + <z2>))) sqrt)
thus we have:
>> self assert: {3 . 2 . 2} ~~> j = 5.
>>
>>
>> see the test cases in FunctionalTalkTest for comprehensive documentation.
>
> Where are they ?
>
see attached file :)
> It seems to me that, what is tricky with lambda calculus are the
> evaluation strategies...
>
could you please elaborate ?
in my package, the evaluation is as described above the plain
MessageSend mechanism, only made fully recursive (even the selector can
be a lambda function). I was very surprised as how easy it was to made
the thing work, which made me think that Smalltalk could almost be
considered a functional language if you consider LambdaMessageSend as
its basic object.
it took me a couple of days to code the package and at the end of it I
just wondered: why did not people do this or something of the like
before ?
cheers,
Stef
-------------- next part --------------
'From Squeak3.8 of ''5 May 2005'' [latest update: #6665] on 13 May 2006 at 9:08:01 pm'!
MessageSend subclass: #LambdaMessageSend
instanceVariableNames: 'compiledForm'
classVariableNames: ''
poolDictionaries: ''
category: 'FunctionalTalk'!
!LambdaMessageSend commentStamp: 'spfa 5/11/2006 18:13' prior: 0!
a MessageSend suitable for functional programming:
its receiver, selector and arguments can themselves be LambdaMessageSends.
see the 'documentation' test cases in FunctionalTalkTest for a comprehensive overview of this topic
!
!LambdaMessageSend methodsFor: 'testing' stamp: 'spfa 5/9/2006 23:46'!
isLambda
^ receiver isLambda
or: [selector isLambda]
or: [arguments isLambda]
or: [arguments anySatisfy: [:arg | arg isLambda]]! !
!LambdaMessageSend methodsFor: 'testing' stamp: 'spfa 5/12/2006 09:57'!
= anObject
^ anObject species == self species
and: [receiver = anObject receiver
and: [selector = anObject selector
and: [arguments = anObject arguments]]]
and: [anObject lambdaArity = self lambdaArity]! !
!LambdaMessageSend methodsFor: 'composition' stamp: 'spfa 5/11/2006 15:18'!
adaptToNumber: rcvr andSend: sel
^ (rcvr lambda: sel) substitute: {self}! !
!LambdaMessageSend methodsFor: 'composition' stamp: 'spfa 5/11/2006 19:23'!
composeWith: aMessageSend
^ aMessageSend substitute: {self}! !
!LambdaMessageSend methodsFor: 'composition' stamp: 'spfa 5/13/2006 20:23'!
doesNotUnderstand: aMessage
^ self class
receiver: (self copyKeepSlots: self rootSlots)
selector: aMessage selector
arguments: aMessage arguments! !
!LambdaMessageSend methodsFor: 'printing' stamp: 'spfa 5/13/2006 20:55'!
constructor
^ String streamContents: [:stream | self writeConstructorOn: stream]! !
!LambdaMessageSend methodsFor: 'printing' stamp: 'spfa 5/10/2006 13:54'!
printAsCodeOn: stream
stream nextPut: $(.
receiver printAsCodeOn: stream.
selector ifNotNil: [
stream space.
(arguments isLambda not and: [arguments isEmpty]) ifTrue: [
selector isLambda ifTrue:[
stream nextPutAll: 'perform: '.
selector printAsCodeOn: stream]
ifFalse: [stream nextPutAll: selector]]
ifFalse: [
(selector isLambda or: [arguments isLambda]) ifTrue:[
stream nextPutAll: 'perform:'; space.
selector printAsCodeOn: stream.
stream space; nextPutAll: 'withArguments:'; space.
arguments isLambda
ifTrue:[arguments printAsCodeOn: stream]
ifFalse: [
stream nextPut: ${.
arguments do: [:arg |
arg printAsCodeOn: stream.
stream nextPutAll: ' . '].
stream skip: -3; nextPut: $}]]
ifFalse: [
arguments with: selector keywords do: [:arg :word |
stream nextPutAll: word.
stream space.
arg printAsCodeOn: stream.
stream space].
stream skip: -1]]].
stream nextPut: $)! !
!LambdaMessageSend methodsFor: 'printing' stamp: 'spfa 5/10/2006 10:15'!
printOn: stream
stream nextPut: $(.
receiver printOn: stream.
selector ifNotNil: [
stream space.
(arguments isLambda not and: [arguments isEmpty]) ifTrue: [
selector isLambda ifTrue:[
stream nextPutAll: 'perform: '.
selector printOn: stream]
ifFalse: [stream nextPutAll: selector]]
ifFalse: [
(selector isLambda or: [arguments isLambda]) ifTrue:[
stream nextPutAll: 'perform:'; space.
selector printOn: stream.
stream space; nextPutAll: 'withArguments:'; space.
arguments printOn: stream.]
ifFalse: [
arguments with: selector keywords do: [:arg :word |
stream nextPutAll: word.
stream space.
arg printOn: stream.
stream space].
stream skip: -1]]].
stream nextPut: $)
! !
!LambdaMessageSend methodsFor: 'printing' stamp: 'spfa 5/13/2006 20:59'!
storeOn: stream
"specific usage - should be renamed I guess"
stream nextPut: $(.
receiver storeOn: stream.
selector ifNotNil: [
stream space.
(arguments isLambda not and: [arguments isEmpty]) ifTrue: [
selector isLambda ifTrue:[
stream nextPutAll: 'perform: '.
selector storeOn: stream]
ifFalse: [stream nextPutAll: selector]]
ifFalse: [
(selector isLambda or: [arguments isLambda]) ifTrue:[
stream nextPutAll: 'perform:'; space.
selector storeOn: stream.
stream space; nextPutAll: 'withArguments:'; space.
arguments isLambda
ifTrue:[arguments storeOn: stream]
ifFalse: [
stream nextPut: ${.
arguments do: [:arg |
arg storeOn: stream.
stream nextPutAll: ' . '].
stream skip: -3; nextPut: $}]]
ifFalse: [
arguments with: selector keywords do: [:arg :word |
stream nextPutAll: word.
stream space.
arg storeOn: stream.
stream space].
stream skip: -1]]].
stream nextPut: $)! !
!LambdaMessageSend methodsFor: 'printing' stamp: 'spfa 5/13/2006 21:03'!
writeConstructorOn: stream
stream nextPutAll: '([| '.
self rootSlots do: [:s | s storeOn: stream. stream space].
stream nextPutAll: '| '.
self rootSlots do: [:s | s declareOn: stream].
self storeOn: stream.
stream nextPutAll: '] value)'! !
!LambdaMessageSend methodsFor: 'accessing' stamp: 'spfa 5/11/2006 21:25'!
lambdaArity
^ self slots asIdentitySet size! !
!LambdaMessageSend methodsFor: 'accessing' stamp: 'spfa 5/11/2006 15:39'!
rootSlots
^ self slots inject: #() into: [:uslots :s |
(uslots identityIncludes: s) ifTrue: [uslots] ifFalse: [uslots, {s}]]! !
!LambdaMessageSend methodsFor: 'accessing' stamp: 'spfa 5/11/2006 15:34'!
slots
^ Array streamContents: [:str |
receiver isLambda ifTrue: [str nextPutAll: receiver slots].
selector isLambda ifTrue: [str nextPutAll: selector slots].
arguments isLambda ifTrue: [str nextPutAll: arguments slots]
ifFalse: [arguments do: [:a |
a isLambda ifTrue: [str nextPutAll: a slots]]]]
! !
!LambdaMessageSend methodsFor: 'reducting' stamp: 'spfa 5/11/2006 08:41'!
collectArgumentsForAll: anArray from: aStream
^ anArray collect: [:each | self collectArgumentsFor: each from: aStream ]! !
!LambdaMessageSend methodsFor: 'reducting' stamp: 'spfa 5/11/2006 15:35'!
collectArgumentsFor: anObject from: aStream
^ anObject isLambda
ifFalse: [anObject]
ifTrue: [anObject reduceWithAll: (aStream next: anObject slots size)]! !
!LambdaMessageSend methodsFor: 'reducting' stamp: 'spfa 5/10/2006 23:14'!
copyKeepSlots: slots
^ self shallowCopy postCopyKeepSlots: slots
! !
!LambdaMessageSend methodsFor: 'reducting' stamp: 'spfa 5/12/2006 14:28'!
postCopyKeepSlots: slots
self eraseCompiledForm.
receiver isLambda
ifTrue: [receiver _ receiver copyKeepSlots: slots].
selector isLambda
ifTrue: [selector _ selector copyKeepSlots: slots].
arguments _ arguments isLambda
ifTrue: [arguments copyKeepSlots: slots]
ifFalse: [arguments collect:
[:arg | arg isLambda
ifTrue: [arg copyKeepSlots: slots]
ifFalse: [arg]]].
self ensureSlotsArityFromIds! !
!LambdaMessageSend methodsFor: 'reducting' stamp: 'spfa 5/11/2006 22:19'!
reduceWithAllNonLambda: args
self hasCompiledForm ifFalse: [self compileAsBlock].
^ compiledForm valueWithArguments: args
! !
!LambdaMessageSend methodsFor: 'reducting' stamp: 'spfa 5/13/2006 00:06'!
reduceWithAll: args
| val |
self isPure ifFalse:
[
self hasCompiledForm ifFalse: [self compileAsBlock].
((args size = self lambdaArity)
and: [args noneSatisfy: [:arg | arg isLambda or: [arg == Lambda]]])
ifTrue: [^ compiledForm valueWithArguments: args]
].
val _ self substitute: args.
val isLambda ifTrue: [^ val compileAsBlock] ifFalse: [^ val value]
! !
!LambdaMessageSend methodsFor: 'reducting' stamp: 'spfa 5/11/2006 10:17'!
reduceWithNonLambda: arg
^ self reduceWithAllNonLambda: {arg}
! !
!LambdaMessageSend methodsFor: 'reducting' stamp: 'spfa 5/12/2006 10:43'!
reduceWithSlots: anArrayOfAssociations
^ self reduceWithAll:
(self rootSlots collect: [:lambda |
lambda reduceWithSlots: anArrayOfAssociations])
! !
!LambdaMessageSend methodsFor: 'reducting' stamp: 'spfa 5/12/2006 10:43'!
reduceWithSlot: anAssociation
^ self reduceWithAll:
(self rootSlots collect: [:lambda |
lambda reduceWithSlot: anAssociation])
! !
!LambdaMessageSend methodsFor: 'reducting' stamp: 'spfa 5/9/2006 14:18'!
reduceWith: arg
^ self reduceWithAll: {arg}
! !
!LambdaMessageSend methodsFor: 'reducting' stamp: 'spfa 5/11/2006 22:22'!
substitute: args
| argsSlots fullArgs mySlots stream |
mySlots _ self slots.
args size = mySlots size
ifTrue: [
"this is NOT a public API ; used internally by #collectArgumentsFor:from:"
fullArgs _ args]
ifFalse: [
| size argsStream z |
args size > (size _ mySlots asIdentitySet size) "self lambdaArity"
ifTrue: [self error: 'Too many arguments'].
argsStream _ ReadStream on:
(args forceTo: size paddingWith: LambdaSlot new).
z _ 'zzzzdoing'.
fullArgs _ Array new: mySlots size withAll: z.
mySlots doWithIndex: [:s :i |
| a |
(fullArgs at: i) == z ifTrue: [
fullArgs at: i put: (a _ argsStream next).
mySlots doWithIndex: [:ss :j |
(ss == s and: [j > i])
ifTrue: [fullArgs at: j put: a]]]]].
stream _ ReadStream on: fullArgs.
argsSlots _ Array streamContents: [:str |
(fullArgs select: [:arg | arg isLambda])
do: [:arg | str nextPutAll: arg slots]].
^ ((self copyKeepSlots: argsSlots)
receiver: (self collectArgumentsFor: receiver from: stream);
selector: (self collectArgumentsFor: selector from: stream);
arguments: (arguments isLambda
ifTrue: [arguments reduceWithAll: stream upToEnd]
ifFalse: [self collectArgumentsForAll: arguments from: stream]))
ensureUnambigousSlotIds; compileAsBlock
! !
!LambdaMessageSend methodsFor: 'evaluating' stamp: 'spfa 5/10/2006 15:36'!
argument: anObject
super arguments: {anObject}! !
!LambdaMessageSend methodsFor: 'evaluating' stamp: 'spfa 5/9/2006 11:46'!
lambdaValue
^ self value! !
!LambdaMessageSend methodsFor: 'evaluating' stamp: 'spfa 5/9/2006 23:56'!
value
arguments isLambda ifTrue: [^ self].
^ self valueWithArguments: arguments
! !
!LambdaMessageSend methodsFor: 'evaluating' stamp: 'spfa 5/9/2006 22:56'!
valueWithArguments: anArray
selector ifNil: [^ receiver lambdaValue].
(receiver isLambda
or: [selector isLambda]
or: [anArray anySatisfy: [:arg | arg isLambda]])
ifTrue: [^ self].
^ receiver lambdaValue
perform: selector lambdaValue
withArguments: (anArray collect: [:each | each lambdaValue])! !
!LambdaMessageSend methodsFor: 'short API' stamp: 'spfa 5/11/2006 19:23'!
o: aMessageSend
^ self composeWith: aMessageSend
! !
!LambdaMessageSend methodsFor: 'short API' stamp: 'spfa 5/11/2006 10:18'!
</ arg
^ self reduceWithNonLambda: arg
! !
!LambdaMessageSend methodsFor: 'short API' stamp: 'spfa 5/11/2006 10:18'!
<// arg
^ self reduceWithAllNonLambda: arg
! !
!LambdaMessageSend methodsFor: 'short API' stamp: 'spfa 5/10/2006 15:33'!
<<~ anAssociation
^ self reduceWithSlot: anAssociation
! !
!LambdaMessageSend methodsFor: 'short API' stamp: 'spfa 5/10/2006 15:33'!
<<~~ anAssociation
^ self reduceWithSlots: anAssociation
! !
!LambdaMessageSend methodsFor: 'short API' stamp: 'spfa 5/10/2006 15:32'!
<@ anObject
^ self substitute: {anObject}
! !
!LambdaMessageSend methodsFor: 'short API' stamp: 'spfa 5/10/2006 15:32'!
<@@ anArray
^ self substitute: anArray
! !
!LambdaMessageSend methodsFor: 'short API' stamp: 'spfa 5/9/2006 14:19'!
<~ arg
^ self reduceWith: arg
! !
!LambdaMessageSend methodsFor: 'short API' stamp: 'spfa 5/9/2006 14:18'!
<~~ args
^ self reduceWithAll: args
! !
!LambdaMessageSend methodsFor: 'conversion' stamp: 'spfa 5/11/2006 22:03'!
asBlock
| slots |
^ Compiler evaluate: (String streamContents: [:str |
str nextPut: $[.
(slots _ self rootSlots) do: [:arg |
str nextPut: $:.
arg printAsCodeOn: str.
str space].
slots size isZero ifFalse: [str nextPut: $|; space].
self printAsCodeOn: str.
str nextPut: $]])
! !
!LambdaMessageSend methodsFor: 'compilation' stamp: 'spfa 5/13/2006 18:16'!
beFast
"allow internal compilation"
compiledForm _ nil.
self compileAsBlock.! !
!LambdaMessageSend methodsFor: 'compilation' stamp: 'spfa 5/13/2006 00:09'!
bePure
"do not allow internal compilation"
compiledForm _ #not
! !
!LambdaMessageSend methodsFor: 'compilation' stamp: 'spfa 5/12/2006 14:25'!
compileAsBlock
compiledForm == #not ifTrue: [^ self].
compiledForm _ self asBlock.
! !
!LambdaMessageSend methodsFor: 'compilation' stamp: 'spfa 5/11/2006 15:40'!
compileAs: aSelector in: aClass classified: heading
aClass class compile:
(String streamContents: [:code |
self rootSlots with: aSelector keywords do: [:arg :word |
code nextPutAll: word.
code space.
arg printAsCodeOn: code.
code space].
code cr; cr; tab; nextPutAll: '^ '.
self printAsCodeOn: code.])
classified: heading.
! !
!LambdaMessageSend methodsFor: 'compilation' stamp: 'spfa 5/13/2006 18:26'!
compiled
self isPure ifTrue: [^ self asBlock].
compiledForm ifNil: [self compileAsBlock].
^ compiledForm
! !
!LambdaMessageSend methodsFor: 'compilation' stamp: 'spfa 5/11/2006 09:23'!
compiledForm
^ compiledForm ! !
!LambdaMessageSend methodsFor: 'compilation' stamp: 'spfa 5/11/2006 15:40'!
compileIn: aClass classified: heading
self compileAs: (String streamContents: [:sel |
self rootSlots do: [:slot |
slot printAsCodeOn: sel.
sel nextPut: $:]])
in: aClass classified: heading
! !
!LambdaMessageSend methodsFor: 'compilation' stamp: 'spfa 5/12/2006 14:28'!
deepCopy
self eraseCompiledForm.
^super deepCopy
! !
!LambdaMessageSend methodsFor: 'compilation' stamp: 'spfa 5/11/2006 19:49'!
ensureSlotsArityFromIds
self slots do: [:s1 |
self slots do: [:s2 |
((s1 == s2) not and: [s1 id = s2 id])
ifTrue: [s1 becomeForward: s2]]].! !
!LambdaMessageSend methodsFor: 'compilation' stamp: 'spfa 5/11/2006 19:50'!
ensureUnambigousSlotIds
self slots do: [:s1 |
self slots do: [:s2 |
((s1 == s2) not and: [s1 id = s2 id])
ifTrue: [s1 getNewId]]].! !
!LambdaMessageSend methodsFor: 'compilation' stamp: 'spfa 5/12/2006 14:27'!
eraseCompiledForm
compiledForm isBlock ifTrue: [compiledForm _ nil]
! !
!LambdaMessageSend methodsFor: 'compilation' stamp: 'spfa 5/12/2006 14:26'!
hasCompiledForm
^ compiledForm notNil and: [compiledForm isBlock]
! !
!LambdaMessageSend methodsFor: 'compilation' stamp: 'spfa 5/13/2006 18:13'!
initialize
super initialize.
self bePure
! !
!LambdaMessageSend methodsFor: 'compilation' stamp: 'spfa 5/12/2006 23:51'!
isPure
^ compiledForm == #not
! !
!LambdaMessageSend methodsFor: 'compilation' stamp: 'spfa 5/12/2006 14:28'!
postCopy
self eraseCompiledForm.
receiver isLambda ifTrue: [receiver _ receiver copy].
selector isLambda ifTrue: [selector _ selector copy].
arguments _ arguments isLambda ifTrue: [arguments copy]
ifFalse: [arguments collect:
[:arg | arg isLambda ifTrue: [arg copy] ifFalse: [arg]]].
self ensureSlotsArityFromIds
! !
!LambdaMessageSend methodsFor: 'compilation' stamp: 'spfa 5/11/2006 15:40'!
slotIds
^ self rootSlots collect: [:slot | slot id].! !
!LambdaMessageSend methodsFor: 'compilation' stamp: 'spfa 5/11/2006 15:40'!
slotIds: anArray
self rootSlots with: anArray do: [:slot :id | slot id: id].! !
!LambdaMessageSend methodsFor: 'compilation' stamp: 'spfa 5/11/2006 22:21'!
slotId: anObject newId: bObject
(self rootSlots detect: [:slot | slot id = anObject] ifNone: [^ self])
id: bObject! !
!LambdaMessageSend methodsFor: 'compilation' stamp: 'spfa 5/12/2006 14:28'!
storeDataOn: aDataStream
self eraseCompiledForm.
super storeDataOn: aDataStream.
self compileAsBlock
! !
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
LambdaMessageSend class
instanceVariableNames: ''!
!LambdaMessageSend class methodsFor: 'as yet unclassified' stamp: 'spfa 5/11/2006 19:50'!
receiver: anObject selector: aSymbol arguments: anArray
^ (super receiver: anObject selector: aSymbol arguments: anArray)
ensureUnambigousSlotIds compileAsBlock! !
More information about the Squeak-dev
mailing list
|