[ANN] LambdaMessageSend on SqueakMap

hello list,

LambdaMessageSend, aka FunctionalTalk, implements a specialized
MessageSend subclass and an associated API for functional programming in
Squeak.

you can do things like:

| x y f g j |

x _ Lambda x.
y _ Lambda y.
f _ ((x*x) + (y*y)) sqrt.
self assert: f printString = '(((<x> * <x>) + (<y> * <y>)) sqrt)'.
self assert: {3 . 4} ~~> f = 5.
g := ('y' -> 0) ~>> f.
self assert: g printString = '(((<x> * <x>) + 0) sqrt)' .
self assert: 3 ~> g = 3.
j := ('y' -> (Lambda z1 + Lambda z2)) ~>> f.
self assert: j printString = '(((<x> * <x>) + ((<z1> + <z2>) * (<z1> +
<z2>))) sqrt)' .
self assert: {3 . 2 . 2} ~~> j = 5.


see the test cases in FunctionalTalkTest for comprehensive documentation.


I would be interested in feedback and criticism from languages gurus.

the idea here is to define a MessageSend those receiver, selector and
arguments can themselves be MessageSend. It seems to me that we get this
way a clean lambda calculus framework but of course I may be wrong.

what do you think ?


Stef

Hi Stef,

on Sat, 13 May 2006 14:51:24 +0200, you <[hidden email]> wrote:

> hello list,
>
> LambdaMessageSend, aka FunctionalTalk, implements a specialized  
> MessageSend subclass and an associated API for functional programming in  
> Squeak.

What a great app! Now I no longer have to switch to other programs or do  
lengthy calculations on paper with pencil (and eraser, of course :-)

Thanks a lot.

/Klaus

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.

> LambdaMessageSend, aka FunctionalTalk, implements a specialized  
> MessageSend subclass and an associated API for functional  
> programming in Squeak.

Few months ago I worked on a module calculus. I first did an  
implementation in Squeak, but I had to switch for Scheme, mainly  
because of the closure.

>
> 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 ?

> f _ ((x*x) + (y*y)) sqrt.

Why is there no term named lambda here ?

> 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.

> 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 ?

> self assert: j printString = '(((<x> * <x>) + ((<z1> + <z2>) *  
> (<z1> + <z2>))) sqrt)' .
> self assert: {3 . 2 . 2} ~~> j = 5.
>
>
> see the test cases in FunctionalTalkTest for comprehensive  
> documentation.

Where are they ?


> I would be interested in feedback and criticism from languages gurus.
>
> the idea here is to define a MessageSend those receiver, selector  
> and arguments can themselves be MessageSend. It seems to me that we  
> get this way a clean lambda calculus framework but of course I may  
> be wrong.

It seems to me that, what is tricky with lambda calculus are the  
evaluation strategies...

Cheers,
Alexandre


>
> what do you think ?
>
>
> Stef
>
>

--
_,.;:~^~:;._,.;:~^~:;._,.;:~^~:;._,.;:~^~:;._,.;:
Alexandre Bergel  http://www.cs.tcd.ie/Alexandre.Bergel
^~:;._,.;:~^~:;._,.;:~^~:;._,.;:~^~:;._,.;:~^~:;.

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
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

'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! !

stupid me :)

please ignore the attached file from my previous post. here is the good
one !

cheers,

Stef

SystemOrganization addCategory: #FunctionalTalk!
SystemOrganization addCategory: #'FunctionalTalk-Tests'!


TestCase subclass: #FunctionalTalkTest
        instanceVariableNames: ''
        classVariableNames: ''
        poolDictionaries: ''
        category: 'FunctionalTalk-Tests'!

Object subclass: #Lambda
        instanceVariableNames: ''
        classVariableNames: ''
        poolDictionaries: ''
        category: 'FunctionalTalk'!

MessageSend subclass: #LambdaMessageSend
        instanceVariableNames: 'compiledForm'
        classVariableNames: ''
        poolDictionaries: ''
        category: 'FunctionalTalk'!

LambdaMessageSend subclass: #AtomicLambdaMessageSend
        instanceVariableNames: ''
        classVariableNames: ''
        poolDictionaries: ''
        category: 'FunctionalTalk'!

Object subclass: #LambdaSlot
        instanceVariableNames: 'id'
        classVariableNames: ''
        poolDictionaries: ''
        category: 'FunctionalTalk'!

FunctionalTalkTest class
        instanceVariableNames: ''!

Lambda class
        instanceVariableNames: ''!

LambdaMessageSend class
        instanceVariableNames: ''!

AtomicLambdaMessageSend class
        instanceVariableNames: ''!

LambdaSlot class
        instanceVariableNames: ''!


!AtomicLambdaMessageSend commentStamp: 'spfa 5/14/2006 13:22' prior: 0!
Wrapper for a LambdaSlot, e.g. function identity!
]style[(48)f1!

!FunctionalTalkTest commentStamp: 'spfa 5/10/2006 16:26' prior: 0!
Unit tests for the package FunctionalTalk.

See the tests classified "documentation" for an overview of the package.!

!Lambda commentStamp: 'spfa 5/14/2006 14:32' prior: 0!
This class simply provides syntactic sugar for lambda expressions.

        | f |
        "1) compact syntax for AtomicLambdaMessageSend creation"
        f _ Lambda x + (Lambda y * 5) sqrt. "printIt"
        "2) compact syntax for 'section' (Haskell vocabulary)"
        f <~~ {Lambda . 1} "printIt"!

!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
!

!LambdaSlot commentStamp: 'spfa 5/10/2006 16:23' prior: 0!
A slot in a lambda construct.

see LambdaMessageSend for details!

!LambdaMessageSend methodsFor: 'easy arithmetic' stamp: 'spfa 5/14/2006 11:09'!
adaptToNumber: rcvr andSend: sel

        "allows things like (1 + Lambda x)"

        ^  (rcvr lambda: sel) substitute: {self}! !

!LambdaMessageSend methodsFor: 'evaluating' stamp: 'spfa 5/10/2006 15:36'!
argument: anObject

        super arguments: {anObject}! !

!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: $]])
                       
! !

!LambdaSlot methodsFor: 'printing' stamp: 'spfa 5/10/2006 13:52'!
asVariableName

        ^ String streamContents: [:str | self printAsCodeOn: str]

! !

!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: '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: '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
                ! !

!AtomicLambdaMessageSend methodsFor: 'reducting' stamp: 'spfa 5/14/2006 13:49'!
composeWith: aMessageSend

        ^ aMessageSend substitute: {receiver}! !

!LambdaMessageSend methodsFor: 'composition' stamp: 'spfa 5/11/2006 19:23'!
composeWith: aMessageSend

        ^ aMessageSend substitute: {self}! !

!LambdaMessageSend methodsFor: 'printing' stamp: 'spfa 5/13/2006 20:55'!
constructor

        ^ String streamContents: [:stream | self writeConstructorOn: stream]! !

!LambdaMessageSend methodsFor: 'reducting' stamp: 'spfa 5/10/2006 23:14'!
copyKeepSlots: slots

        ^ self shallowCopy postCopyKeepSlots: slots
! !

!LambdaSlot methodsFor: 'reduction' stamp: 'spfa 5/10/2006 23:15'!
copyKeepSlots: slots

        (slots identityIncludes: self)
                ifFalse: [^ self copy]! !

!LambdaSlot methodsFor: 'printing' stamp: 'spfa 5/13/2006 20:57'!
declareOn: stream

        "specific usage. see #declareOn: "

        self printAsCodeOn: stream .
        stream nextPutAll: ' _ Lambda '.
        self printAsCodeOn: stream .
        stream nextPut: $.; space




! !

!LambdaMessageSend methodsFor: 'compilation' stamp: 'spfa 5/12/2006 14:28'!
deepCopy

        self eraseCompiledForm.
        ^super deepCopy

! !

!AtomicLambdaMessageSend methodsFor: 'printing' stamp: 'spfa 5/14/2006 13:45'!
doesNotUnderstand: aMessage

        ^ LambdaMessageSend
                receiver: receiver
                selector: aMessage selector
                arguments: aMessage arguments! !

!Lambda class methodsFor: 'as yet unclassified' stamp: 'spfa 5/14/2006 12:43'!
doesNotUnderstand: aMessage

        aMessage selector numArgs isZero
                ifTrue: [^ AtomicLambdaMessageSend receiver:
                                                (LambdaSlot new id: aMessage selector)].

        ^ super doesNotUnderstand: aMessage
! !

!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! !

!LambdaSlot class methodsFor: 'API' stamp: 'spfa 5/9/2006 22:39'!
doesNotUnderstand: aMessage

        ^ self selector: aMessage selector arguments: aMessage arguments! !

!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]
! !

!LambdaSlot methodsFor: 'accessing' stamp: 'spfa 5/10/2006 22:26'!
getNewId

        self id: (id isNumber ifTrue: [id +1]
                                        ifFalse: [id isString ifTrue: [id, 'z'] ifFalse: [1]])
        ! !

!LambdaMessageSend methodsFor: 'compilation' stamp: 'spfa 5/12/2006 14:26'!
hasCompiledForm

        ^ compiledForm notNil and: [compiledForm isBlock]
! !

!LambdaSlot methodsFor: 'accessing' stamp: 'spfa 5/9/2006 22:34'!
id

        ^ id ! !

!LambdaSlot methodsFor: 'accessing' stamp: 'spfa 5/9/2006 14:43'!
id: anObject

        id _ anObject! !

!LambdaSlot class methodsFor: 'instance creation' stamp: 'spfa 5/9/2006 14:45'!
id: anObject

        ^ self new id: anObject! !

!LambdaMessageSend methodsFor: 'compilation' stamp: 'spfa 5/13/2006 18:13'!
initialize

        super initialize.
        self bePure

       

! !

!AtomicLambdaMessageSend methodsFor: 'testing' stamp: 'spfa 5/14/2006 13:54'!
isAtomicLambda

        ^ true! !

!LambdaMessageSend methodsFor: 'testing' stamp: 'spfa 5/14/2006 13:55'!
isAtomicLambda

        ^ false! !

!LambdaSlot methodsFor: 'testing' stamp: 'spfa 5/14/2006 13:58'!
isAtomicLambda

        ^ true! !

!AtomicLambdaMessageSend methodsFor: 'testing' stamp: 'spfa 5/14/2006 13:56'!
isLambda

        ^ true! !

!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]]! !

!LambdaSlot methodsFor: 'testing' stamp: 'spfa 5/14/2006 14:14'!
isLambda

        ^ true
! !

!Object methodsFor: '*FunctionalTalk' stamp: 'spfa 5/9/2006 10:23'!
isLambda

        ^ false! !

!LambdaSlot methodsFor: 'testing' stamp: 'spfa 5/11/2006 14:02'!
isLambdaSlot

        ^ true
! !

!Object methodsFor: '*FunctionalTalk' stamp: 'spfa 5/11/2006 14:03'!
isLambdaSlot

        ^ false! !

!LambdaMessageSend methodsFor: 'compilation' stamp: 'spfa 5/12/2006 23:51'!
isPure

        ^ compiledForm == #not

! !

!LambdaMessageSend methodsFor: 'easy arithmetic' stamp: 'spfa 5/13/2006 22:01'!
isZero

        "allows things like (1/(Lambda x + 1))"

        ^ false
! !

!Object methodsFor: '*FunctionalTalk-API' stamp: 'spfa 5/9/2006 20:52'!
lambda

        ^ LambdaMessageSend
                receiver: self
                selector: nil
                arguments: #()
! !

!AtomicLambdaMessageSend methodsFor: 'reducting' stamp: 'spfa 5/14/2006 14:05'!
lambdaArity

        ^ 1! !

!LambdaMessageSend methodsFor: 'accessing' stamp: 'spfa 5/11/2006 21:25'!
lambdaArity

        ^ self slots asIdentitySet size! !

!Object methodsFor: '*FunctionalTalk' stamp: 'spfa 5/9/2006 13:13'!
lambdaArity

        ^ 0 ! !

!LambdaSlot class methodsFor: 'API' stamp: 'spfa 5/10/2006 10:00'!
lambdaMessage

        ^ (self id: 'receiver') lambdaMessage! !

!Object methodsFor: '*FunctionalTalk-API' stamp: 'spfa 5/10/2006 09:59'!
lambdaMessage

        ^ LambdaMessageSend
                receiver: self
                selector: (LambdaSlot id: 'selector')
                arguments: (LambdaSlot id: 'arguments')
! !

!LambdaMessageSend methodsFor: 'evaluating' stamp: 'spfa 5/9/2006 11:46'!
lambdaValue

        ^ self value! !

!Object methodsFor: '*FunctionalTalk' stamp: 'spfa 5/9/2006 11:46'!
lambdaValue

        ^ self ! !

!LambdaSlot class methodsFor: 'API' stamp: 'spfa 5/10/2006 09:53'!
lambda: anObjectOrArray

        ^ (self id: 'receiver') lambda: anObjectOrArray! !

!Object methodsFor: '*FunctionalTalk-API' stamp: 'spfa 5/10/2006 09:53'!
lambda: aSymbolOrArray

        aSymbolOrArray isSymbol
        ifTrue:
        [
                ^ LambdaMessageSend
                        receiver: self
                        selector: aSymbolOrArray
                        arguments: ((1 to: aSymbolOrArray numArgs)
                                                        collect: [:n | LambdaSlot id: n])
        ]
        ifFalse: "Array, then"
        [
                ^ LambdaMessageSend
                        receiver: self
                        selector: (LambdaSlot id: 'selector')
                        arguments: aSymbolOrArray
        ]

! !

!Object methodsFor: '*FunctionalTalk-API' stamp: 'spfa 5/9/2006 14:48'!
lambda: aSymbol slotIds: anArray

        ^ LambdaMessageSend
                receiver: self
                selector: aSymbol
                arguments: (anArray collect: [:n | LambdaSlot id: n])

! !

!Object methodsFor: '*FunctionalTalk-API' stamp: 'spfa 5/9/2006 16:01'!
lambda: aSymbol slotId: anObject

        aSymbol numArgs ~= 1 ifTrue: [^ self error: 'more than one slot defined'].

        ^ LambdaMessageSend
                receiver: self
                selector: aSymbol
                arguments: {LambdaSlot id: anObject}

! !

!Object methodsFor: '*FunctionalTalk-API' stamp: 'spfa 5/9/2006 21:01'!
lambda: aSymbol with: anObject

        ^ LambdaMessageSend
                receiver: self
                selector: aSymbol
                arguments: {anObject}

! !

!Object methodsFor: '*FunctionalTalk-API' stamp: 'spfa 5/9/2006 21:03'!
lambda: aSymbol with: anObject with: bObject

        ^ LambdaMessageSend
                receiver: self
                selector: aSymbol
                arguments: {anObject . bObject}

! !

!Object methodsFor: '*FunctionalTalk-API' stamp: 'spfa 5/9/2006 21:03'!
lambda: aSymbol with: anObject with: bObject with: cObject

        ^ LambdaMessageSend
                receiver: self
                selector: aSymbol
                arguments: {anObject . bObject . cObject}

! !

!LambdaMessageSend methodsFor: 'short API' stamp: 'spfa 5/11/2006 19:23'!
o: aMessageSend

        ^ self composeWith: aMessageSend

        ! !

!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: '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: '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: $)! !

!LambdaSlot methodsFor: 'printing' stamp: 'spfa 5/10/2006 13:52'!
printAsCodeOn: stream

         | varname |

        varname _ id asString.
        (varname allSatisfy: [:char | char isAlphaNumeric])
                ifFalse: [varname _ varname asIdentifier: false]
                ifTrue: [varname startsWithDigit ifTrue: [stream nextPutAll: 'arg']].

        stream nextPutAll: varname



! !

!Object methodsFor: '*FunctionalTalk' stamp: 'spfa 5/11/2006 23:31'!
printAsCodeOn: aStream

        self storeOn: aStream! !

!AtomicLambdaMessageSend methodsFor: 'printing' stamp: 'spfa 5/14/2006 12:44'!
printOn: aStream

        ^ receiver printOn: aStream! !

!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: $)
! !

!LambdaSlot methodsFor: 'printing' stamp: 'spfa 5/10/2006 16:21'!
printOn: stream

        stream nextPut: $<.
        stream nextPutAll: id asString.
        stream nextPut: $>.
! !

!AtomicLambdaMessageSend class methodsFor: 'as yet unclassified' stamp: 'spfa 5/14/2006 12:42'!
receiver: aLambdaSlot

        ^ self receiver: aLambdaSlot selector: #yourself arguments: #()! !

!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! !

!LambdaMessageSend methodsFor: 'reducting' stamp: 'spfa 5/11/2006 22:19'!
reduceWithAllNonLambda: args

        self hasCompiledForm ifFalse: [self compileAsBlock].
        ^ compiledForm valueWithArguments: args
! !

!AtomicLambdaMessageSend methodsFor: 'reducting' stamp: 'spfa 5/14/2006 13:47'!
reduceWithAll: args

        | arg |

        arg _ args first.
        arg == Lambda ifTrue: [^ self].
        arg isLambdaSlot ifTrue: [^ self class receiver: arg].
        ^ arg ! !

!LambdaMessageSend methodsFor: 'reducting' stamp: 'spfa 5/14/2006 13:41'!
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]

! !

!LambdaSlot methodsFor: 'reduction' stamp: 'spfa 5/14/2006 14:18'!
reduceWithAll: args

        | x |

        args size ~= 1 ifTrue: [self error: 'Bad number of arguments'].

        ((x _ args first) == Lambda
         or: [x isLambdaSlot and: [x id isNil]]) ifTrue: [^ self].

        ^ x
! !

!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])
! !

!LambdaSlot methodsFor: 'reduction' stamp: 'spfa 5/12/2006 10:43'!
reduceWithSlots: anArrayOfAssociation

        ^ (anArrayOfAssociation
                detect: [:assoc | (id = assoc key)] ifNone: [^ self]) value
! !

!LambdaMessageSend methodsFor: 'reducting' stamp: 'spfa 5/12/2006 10:43'!
reduceWithSlot: anAssociation

        ^ self reduceWithAll:
                (self rootSlots collect: [:lambda |
                                lambda reduceWithSlot: anAssociation])


! !

!LambdaSlot methodsFor: 'reduction' stamp: 'spfa 5/12/2006 10:42'!
reduceWithSlot: anAssociation

        (id = anAssociation key) ifTrue: [^ anAssociation value]
! !

!LambdaMessageSend methodsFor: 'reducting' stamp: 'spfa 5/9/2006 14:18'!
reduceWith: arg

        ^ self reduceWithAll: {arg}


! !

!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}]]! !

!LambdaSlot class methodsFor: 'API' stamp: 'spfa 5/9/2006 14:39'!
selector: aSymbol

        ^ self selector: aSymbol arguments: #()! !

!LambdaSlot class methodsFor: 'API' stamp: 'spfa 5/10/2006 09:53'!
selector: aSymbol arguments: anArray

        ^ self selector: aSymbol arguments: anArray slotId: 'receiver'! !

!LambdaSlot class methodsFor: 'API' stamp: 'spfa 5/9/2006 22:39'!
selector: aSymbol arguments: anArray slotId: anObject

        ^ LambdaMessageSend receiver: (LambdaSlot id: anObject) selector: aSymbol arguments: anArray! !

!LambdaSlot class methodsFor: 'API' stamp: 'spfa 5/9/2006 14:39'!
selector: aSymbol argument: anObject

        ^ self selector: aSymbol arguments: {anObject}! !

!LambdaSlot class methodsFor: 'API' stamp: 'spfa 5/9/2006 22:40'!
selector: aSymbol argument: anObject slotId: bObject

        ^ self selector: aSymbol arguments: {anObject} slotId: bObject! !

!LambdaSlot class methodsFor: 'API' stamp: 'spfa 5/9/2006 22:41'!
selector: aSymbol  slotId: bObject

        ^ self selector: aSymbol arguments: #() slotId: bObject! !

!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: '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]]]]
! !

!LambdaSlot methodsFor: 'accessing' stamp: 'spfa 5/11/2006 15:35'!
slots

        ^ {self}! !

!LambdaMessageSend methodsFor: 'compilation' stamp: 'spfa 5/12/2006 14:28'!
storeDataOn: aDataStream

        self eraseCompiledForm.
        super storeDataOn: aDataStream.
        self compileAsBlock

! !

!AtomicLambdaMessageSend methodsFor: 'printing' stamp: 'spfa 5/14/2006 12:44'!
storeOn: aStream

        ^ receiver storeOn: aStream! !

!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: $)! !

!LambdaSlot methodsFor: 'printing' stamp: 'spfa 5/13/2006 20:46'!
storeOn: stream

        "specific usage. see #declareOn: "

        self printAsCodeOn: stream




! !

!Rectangle methodsFor: '*FunctionalTalk-unrelated-fix' stamp: 'spfa 5/12/2006 14:16'!
storeOn: aStream
       
        aStream nextPut: $(.
        self printOn: aStream.
        aStream nextPut: $)! !

!AtomicLambdaMessageSend methodsFor: 'reducting' stamp: 'spfa 5/14/2006 13:46'!
substitute: args

        ^ self reduceWithAll: args! !

!LambdaMessageSend methodsFor: 'reducting' stamp: 'spfa 5/14/2006 13:52'!
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: Lambda).
                        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
! !

!FunctionalTalkTest methodsFor: 'tests' stamp: 'spfa 5/13/2006 22:17'!
testArithmetic

        self assert: (2 + Lambda x) isLambda.
        self assert: (1/(Lambda x + 1)) isLambda.
        self assert: (1/Lambda x) isLambda! !

!FunctionalTalkTest methodsFor: 'tests' stamp: 'spfa 5/11/2006 18:38'!
testArity1

        | f g f2 ff sumf |

        f _ 56 lambda: #+ .
        g _ f sqrt.
        f2 _ f * 2.
        ff _ f * f.
        sumf _ ff + f2 + g.

        self assert: (sumf <~ 8) = 4232.
        self assert: (f <~ 4) = 60.
        self assert: (g <~ 8) = 8.
        self assert: (f2 <~ 4) = 120.
        self assert: (ff <~ 4) = 3600.

! !

!FunctionalTalkTest methodsFor: 'tests' stamp: 'spfa 5/11/2006 18:35'!
testArity2

        | f t |

        f _ 56 lambda: #+.
        t _ (f sqrt) lambda: #+.

        self assert: t lambdaArity = 2.
        self assert: (t <~~ {8 . 2}) = 10.
        self assert: (t+f) lambdaArity = 2.
        self assert: ((t + f) <~~ {8 . 2}) = 74.
! !

!FunctionalTalkTest methodsFor: 'tests' stamp: 'spfa 5/11/2006 18:50'!
testArity3

        | f g t h |

        f _ 56 lambda: #+.
        g _ 10 lambda: #-.
        t _ f + g.

        self assert: t lambdaArity = 2.
        self assert: (t <~~ {8 . 8}) = 66.

        h _ Point lambda: #x:y:.
        t _  h r.

        self assert: (t <~ 0 <~ 1) = 1.
        self assert: ((f + t) <~ 4 <~ 10 <~ 0) = 70
! !

!FunctionalTalkTest methodsFor: 'tests' stamp: 'spfa 5/11/2006 18:37'!
testArityPreservation

        | f t g |

        f _ LambdaSlot selector: #+ arguments: {56}.
        t _ (f sqrt) + 2.
        g _ ((f sqrt) + 2) * f.

        self assert: ((t <~ 8) closeTo: 10).
        self assert: ((g <~ 8) closeTo: 640).
        self assert: ((t <~ -56) closeTo: 2).
        self assert: ((g <~ -55) closeTo: 3).
! !

!FunctionalTalkTest methodsFor: 'documentation' stamp: 'spfa 5/11/2006 18:54'!
testBasics

        "defining a message send from an arbitrary object:"
        self assert: 5 lambda isMessageSend.
        self assert: 5 lambda value = 5.

        "defining a message send from an object and message:"
        self assert: (4 lambda + 1) isMessageSend.
        self assert: (4 lambda + 1) value = 5.

        "defining a lambda expression from an object and selector only"
        self assert: (4 lambda: #+) isLambda.
        "this can not be reduced: it is not a plain message send"
        self assert: (4 lambda: #+) value isLambda.
  "an argument can be provided:"
        self assert: ((4 lambda: #+) argument: 5) isMessageSend.
        "this can now be reduced:"
        self assert: ((4 lambda: #+) argument: 5) value = 9 .
        "note that the argument can itself be a lambda expression:"
        self assert: ((4 lambda: #+) argument: (2 lambda: #+)) isLambda.

        "giving an argument and getting the corresponding value is called reduction. this can be done in one step"
        self assert: ((4 lambda: #+) reduceWith: 5) = 9 .
        "shorter API :"
        self assert: ((4 lambda: #+) <~ 5) = 9 .

        "giving an argument without evaluating is called substitution"
        self assert: ((4 lambda: #+) substitute: {5}) printString = '(4 + 5)' .
        "there is also a shorter API :"
        self assert: ((4 lambda: #+) <@ 5) printString = '(4 + 5)' .! !

!FunctionalTalkTest methodsFor: 'documentation' stamp: 'spfa 5/11/2006 19:04'!
testBasics2

        | f g r |

        f _ 4 lambda: #+.

        "a lambda expression can be expanded by sending it any messages"
        g _ (f + 10) * 2.
        self assert: g isLambda.
        self assert: (g <~ 1) = 30.

        "it can be composed with another lambda expression"
        self assert: (f ~> g) isLambda.
        self assert: ((f ~> g) <~ 1) = 38.

        "actually ~> is just <~ the other way round"
        self assert: (g <~ f <~ 1) = 38.
        self assert: (1 ~> f ~> g) = 38.
        self assert: (f ~> g <~ 1) = 38.  

        "to see what (f ~> g) really is, print it"
        self assert: (f ~> g) printString = '(((4 + (4 + <1>)) + 10) * 2)'.

        self assert: f printString = '(4 + <1>)'.
        self assert: g printString = '(((4 + <1>) + 10) * 2)'.
        self assert: (g ~> f) printString = '(4 + (((4 + <1>) + 10) * 2))'.

        "<1>, <2>, .. are the default labels (id) for lambda slots
        it is possible to define arbitrary ids"
        f _ 4 lambda: #+ slotId: 'étonnant, non ?'.
        self assert: f printString = '(4 + <étonnant, non ?>)'.
        f _ 4 lambda: #+ slotId: Smalltalk.
        self assert: f printString = '(4 + <a SystemDictionary(lots of globals)>)'.

        "this is especially useful for expressions with several arguments"
        r  _ Rectangle lambda: #left:right:top:bottom:
                                        slotIds: #('left' 'right' 'top' 'bottom').
        self assert: r printString =
                 '(Rectangle left: <left> right: <right> top: <top> bottom: <bottom>)'.

        "we can reduce the number of arguments by providing values for specific slots, using slot ids"
        r _ r reduceWithSlots: {'left' -> 50 . 'right' -> 60}.
        self assert:
        r <~~ {0 . 100} = (Rectangle left: 50 right: 60 top: 0 bottom: 100).
        self assert:
        r printString = '(Rectangle left: 50 right: 60 top: <top> bottom: <bottom>)' .

        "we can substitute a lambda expression in a slot"
        r _ r reduceWithSlot: ('bottom' -> (100 lambda: #- slotId: 'bottom offset')).
        self assert:
        r slotIds = #('top' 'bottom offset').
        self assert:
        r <~~ {0 . 0} = (Rectangle left: 50 right: 60 top: 0 bottom: 100).
        self assert: r printString =
                '(Rectangle left: 50 right: 60 top: <top> bottom: (100 - <bottom offset>))' .

        "<<~ and <<~~ are shortcuts for reduceWithSlot: and reduceWithSlots:
you can also use the backward versions ~>> and ~~>>"
        r _ Rectangle lambda: #left:right:top:bottom:
                        slotIds: #('left' 'right' 'top' 'bottom').
        r _ r <<~ ('right' -> 60).
        r _ {'left' -> 50 . 'bottom' -> (100 lambda: #-)} ~~>> r.
        self assert:
        {0 . 0} ~~> r = (Rectangle left: 50 right: 60 top: 0 bottom: 100).
        ! !

!FunctionalTalkTest methodsFor: 'documentation' stamp: 'spfa 5/10/2006 16:38'!
testBasics3

        | f g h k j m |

        "lambda abstraction can be based on the receiver of an expression"
        f _ LambdaSlot + 5.
        self assert: (f <~ 1) = 6.
        self assert: f printString = '(<receiver> + 5)'.

        "we can also abstract both receiver and arguments at the same time"
        g _ (LambdaSlot lambda: #+) .
        self assert: (g <~~ {2 . 3}) = 5.
        self assert: g printString = '(<receiver> + <1>)'.

        "this is equivalent to"
        g _ LambdaMessageSend
                        receiver: (LambdaSlot id: 'receiver')
                        selector: #+
                        arguments: {LambdaSlot id: 'argument'}.
        self assert: (g <~~ {2 . 3}) = 5.

        "the selector can be abstracted too..."
        h _ 5 lambda: {5}.
        self assert: (h <~ #+) = 10.
        self assert: (h <~ #*) = 25.
        self assert: h printString = '(5 perform: <selector> withArguments: #(5))'.

        "abstracting both receiver and selector"
        j _ (LambdaSlot lambda: {5}) .
        self assert: (j <~~ {2 . #+}) = 7.
        self assert: (j <~~ {1 . #-}) = -4.
        self assert: j printString =
                 '(<receiver> perform: <selector> withArguments: #(5))'.

        "abstracting both selector and arguments"
        m _ 5 lambdaMessage.
        self assert: (m <~~ {#+ . {3}}) = 8.
        self assert: (m <~~ {#raisedTo: . {2}}) = 25.
        self assert: (m <~~ {#adaptToFraction:andSend: . {1/2 .  #+}}) = (11/2).
        self assert: m printString =
                 '(5 perform: <selector> withArguments: <arguments>)'.

        "here is the full monty"
        k _ LambdaSlot lambdaMessage.
        self assert: (k <~~ {2 . #+ . {3}}) = 5.
        self assert: (k <~~ {'hello' . #padded:to:with: . {#right . 10 . $!!}}) = 'hello!!!!!!!!!!'.
        self assert: k printString =
                 '(<receiver> perform: <selector> withArguments: <arguments>)'.

        "this is equivalent to"
        k _ LambdaMessageSend
                        receiver: (LambdaSlot id: 'receiver')
                        selector: (LambdaSlot id: 'selector')
                        arguments: (LambdaSlot id: 'arguments').
        self assert: (k <~~ {2 . #+ . {3}}) = 5.
! !

!FunctionalTalkTest methodsFor: 'documentation' stamp: 'spfa 5/11/2006 19:08'!
testBasics4

        | x f g h z p |

        "slots are shared by default when combining functions"
        x _ Lambda x.
        f _ x * (1+x).
        self assert: f lambdaArity = 1. "this means the two x above will take the same one argument"
        self assert: f slots printString= '#(<x> <x>)'.
        self assert: f rootSlots printString= '#(<x>)'.
        self assert: 10 ~> f = 110.
       
        "slots are not shared when copying"
        g _ x * (1+ x copy).
        self assert: g lambdaArity = 2. "theres is now TWO arguments"
        self assert: g slots printString = '#(<xz> <x>)'.
        self assert: g rootSlots printString= '#(<xz> <x>)'.
        self assert: {10 . 2} ~~> g = 30.

        "slots built independently stay independent"
        h _ Lambda y * (1+ Lambda y).
        self assert: h lambdaArity = 2.  "the two Lambda y define different slots"
        self assert: h slots printString= '#(<yz> <y>)'.
        self assert: h rootSlots printString= '#(<yz> <y>)'.
        self assert: {10 . 2} ~~> h = 30.

        "note that it is always possible to redefine the slots and change the arity"
        z _ Lambda z.
        p _ {z . z} ~~> h.
        self assert: p lambdaArity = 1.
        self assert: p slots printString = '#(<z> <z>)'.
        self assert: p rootSlots printString = '#(<z>)'.
        self assert: 10 ~> p = 110.

! !

!FunctionalTalkTest methodsFor: 'documentation' stamp: 'spfa 5/13/2006 19:56'!
testBenchmarks

        | bk x y f tblock fassert t |

        x _ Lambda x.
        y _ Lambda y.
        f _ ((x*x) + (y*y)) sqrt.
        f beFast.  "we allow internal compilation"

        bk _ [:a :b | ((a*a) + (b*b)) sqrt].

        "tblock is the duration taken by bk to evaluate 100000 times:"
        tblock _ [100000 timesRepeat: [bk value: 3 value: 4]] durationToRun.

        "fassert is a lambda function which compare a duration t with tblock
it succeeds if t is very roughly the same as tblock "
        t _ Lambda t.
        fassert _ self lambda: #assert: with: ((t * 1.4) > tblock) & ((t * 0.7) < tblock).

"
NOTE:
        in the following we replace all the usual  'self assert: ...' with invocation of our specialized fassert. this will provide an example of functional programming along with our benchmarks :)

        now let's proceed:
"

        "the default way to reduce a lambda expression is VERY slow:
        here it is about 5000 times slower than its equivalent block
        (although this does not make much sense as both do not perform the same operation at all)"
        fassert <~ [20 timesRepeat: [f <~~ {3 . Lambda}]] durationToRun.

        "now if we are not actually substituting but simply evaluating the lambda expression, it gets better.
        here we perform exactly the same operation as the block: it is roughly 50 times slower"
        fassert <~ [2000 timesRepeat: [f <~~ {3 . 4}]] durationToRun.

        "if the function is to be evaluated with plain, non-lambda arguments, as in our example, then it is much better to use //> instead of ~~> because some expensive checks gets disabled.
        we are now only 2 times slower than the block"
        fassert <~ [50000 timesRepeat: [f <// {3 . 4}]] durationToRun.  

        "even faster is the direct invocation of the compiled form of the function (which is a block itself): we eventually catch up with the block"
        fassert <~ [100000 timesRepeat: [f compiled value: 3 value: 4]] durationToRun. ! !

!FunctionalTalkTest methodsFor: 'documentation' stamp: 'spfa 5/11/2006 15:25'!
testBeware

        "lambda expressions expand by receiving message.
they do not expand when sent to other objects"
        self assert: ('abc' lambda, 'def') value = 'abcdef'.
        self should: [('abc', 'def' lambda) value] raise: Error.
        self assert: ('abc' lambda, 'def' lambda) value = 'abcdef'.

        "as an exception, arithmetic operations do allow more freedom"
        self assert: (77 + 5 lambda) isMessageSend.
        self assert: (77 + 5 lambda) value = 82.
! !

!FunctionalTalkTest methodsFor: 'documentation' stamp: 'spfa 5/11/2006 19:10'!
testBeware2

        | f g h |

        "slots ids are changed silently if a name clash happen
this allows further compilation of the function as a method or a block, where different arguments with the same name would not be accepted"

        f _ 5 lambda: #+ slotId: 'x'.
        g _ 1 lambda: #- slotId: 'x'.
        h _ f + g.
        self assert: h lambdaArity = 2.
        self assert: (h <~~ {5 . 1}) = 10.
        self assert:  h slotIds = {'xz' . 'x'}.             "a 'z' was appended"

! !

!FunctionalTalkTest methodsFor: 'tests' stamp: 'spfa 5/11/2006 11:02'!
testCompilation

        | cat |

        cat _  '--test leftover (remove it all)--'.

        ((Rectangle lambda: #left:right:top:bottom:)
                <<~~ {3 -> 500 . 4 -> 600})
                slotIds: {'gauche' . 'droite' };
                compileAs: #gauche:droite: in: Rectangle classified: cat.

        self assert: (Rectangle gauche: 45 droite: 177) =  (45@500 corner: 177@600).

        Rectangle class removeCategory: cat! !

!FunctionalTalkTest methodsFor: 'tests' stamp: 'spfa 5/11/2006 11:03'!
testCompilation2

        | cat |

        cat _  '--test leftover (remove it all)--'.

        ((Rectangle lambda: #left:right:top:bottom:)
                <<~~ {3 -> 500 . 4 -> 600})
                slotIds: {'gauche' . 'droite' };
                compileIn: Rectangle classified: cat.

        self assert: (Rectangle gauche: 45 droite: 177) =  (45@500 corner: 177@600).

        Rectangle class removeCategory: cat! !

!FunctionalTalkTest methodsFor: 'tests' stamp: 'spfa 5/10/2006 15:06'!
testCompilation3

        | g cat |

        cat _  '--compiled example (remove it if you want)--'.

        g _ LambdaMessageSend
                        receiver: (LambdaSlot id: 'receiver')
                        selector: (LambdaSlot id: 'selector')
                        arguments: {LambdaSlot id: 'argument'}.

        g compileIn: LambdaSlot classified: cat.

        self assert: (LambdaSlot receiver: 10 selector: #/ argument: 2) = 5.

        LambdaSlot class removeCategory: cat! !

!FunctionalTalkTest methodsFor: 'tests' stamp: 'spfa 5/10/2006 15:06'!
testCompilation4

        | cat |

        cat _  '--compiled example (remove it if you want)--'.

        LambdaSlot lambdaMessage compileIn: LambdaSlot classified: cat.

        self assert: (LambdaSlot receiver: 10 selector: #/ arguments: {2}) = 5.

        LambdaSlot class removeCategory: cat! !

!FunctionalTalkTest methodsFor: 'tests' stamp: 'spfa 5/13/2006 18:17'!
testCompiledForm

        | f g morph |

        f _ ((Lambda x raisedTo: 2) + (Lambda y raisedTo: 2)) sqrt.
        f beFast.
        self assert: f hasCompiledForm.
        self assert: f copy hasCompiledForm not.

        g _ f copy <<~ ('y' -> 0).
        self assert: g hasCompiledForm.

        self assert: (g <~ 2) = 2.
        self assert: (f <// {3 . 4}) = 5.

        "watch out --- there is a problem with compiled forms: ---"
        morph _ Morph new.
        f _ morph lambda: #position:.
        f beFast.
        self assert: f hasCompiledForm.
        "trouble is:"
        self deny: (f <~ (0@0)) == (f <~ (0@0)) .
        f <~ (55@12).        "we actually touch a temporary copy of morph"
        self deny: morph position = (55@12).
        "fix:"
        f bePure.       "do not use internal compilation - this is the default BTW"
        self deny: f hasCompiledForm.
        f <~ (55@12).
        self assert: morph position = (55@12).
        "deeper fix:
        pure functional programming does not use mutable variables and does not expect side-effects from the evaluation of a function.
        so the example above is just an example of bad practice :)"

! !

!FunctionalTalkTest methodsFor: 'tests' stamp: 'spfa 5/11/2006 17:03'!
testComposition

        | f g gf ggf gggf fgggf |

        f _ 56 lambda: #+ .
        g _ 10 lambda: #* .
        gf _ f ~> g.
        ggf _ gf ~> g.
        gggf _ f ~> g ~> g ~> g.
        fgggf _ f <~ g <~ ggf.

        self assert: ((4 ~> gf ) = 600).
        self assert: ((4 ~> ggf ) = 6000).
        self assert: ((4 ~> gggf ) = 60000).
        self assert: ((4 ~> fgggf ) = 60056)! !

!FunctionalTalkTest methodsFor: 'tests' stamp: 'spfa 5/11/2006 17:05'!
testComposition2

        | p mp |

        p _ Point lambda: #x:y: .
        p _ p <~~ {1 lambda: #+ slotIds: {1} . 2 lambda: #* slotIds: {2}}.

        self assert: p printString = '(Point x: (1 + <1>) y: (2 * <2>))'.
        self assert: (p <~~ {5 . 15}) = (6 @ 30).

        mp _ p <~~ {5 .  (Point lambda: #x:y:) r}.
        self assert: mp printString = '(Point x: 6 y: (2 * ((Point x: <1> y: <2>) r)))'.
        self assert: (mp <~~ {0 . 1}) = (6 @ 2)
! !

!FunctionalTalkTest methodsFor: 'tests' stamp: 'spfa 5/10/2006 16:16'!
testComposition3

        | f t y |

        f _ LambdaSlot selector: #+ arguments: {56}.
        t _ f <~~ {3 lambda: #-}.
        y _ t <~~ {LambdaSlot selector: #+ arguments: {10}}.

        self assert: t printString = '((3 - <1>) + 56)'.
        self assert: (t <~ 2) = 57.
        self assert: y printString = '((3 - (<receiver> + 10)) + 56)'.
        self assert: (y <~ 2) = 47.
! !

!FunctionalTalkTest methodsFor: 'tests' stamp: 'spfa 5/13/2006 21:27'!
testConstructor

        | x f g |

        x _ Lambda x.
        f _ 2+x.
        g _ x * x.

        self assert: (Compiler evaluate: (f + g) constructor) = (f + g)
! !

!FunctionalTalkTest methodsFor: 'tests' stamp: 'spfa 5/12/2006 09:49'!
testConversionAsMessageSend

        | f fx fy g h |

        fx _ Lambda x.
        fy _ Lambda y.
        f _ ((fx*fx) + (fy*fy)) sqrt.

        g _ f as: MessageSend.
        self assert: g value = f.
        self assert: g value <~~ {3. 4} = 5.

        h _ (f <~~ {3 . Lambda}) as: MessageSend.
        self assert: h value = (f <<~ ('x' -> 3)).
        self assert: h value <~ 4 = 5! !

!FunctionalTalkTest methodsFor: 'tests' stamp: 'spfa 5/12/2006 13:53'!
testCopy

        | f g |

        f _ ((Lambda x raisedTo: 2) + (Lambda y raisedTo: 2)) sqrt.
        g _ f copy.

        self deny: (f slots identityIncludes: g slots first).
        self deny: (f slots identityIncludes: g slots second).

        f _ BlobMorph new lambda yourself yourself yourself.
        self assert: f value == f value.
        g _ f copy.
        self assert: g value == f value.
        g _ f veryDeepCopy.
        self deny: g value == f value.
! !

!FunctionalTalkTest methodsFor: 'tests' stamp: 'spfa 5/14/2006 14:25'!
testEquality

        | f x y x2 xy g o oo s |

        x _ Lambda x.
        y _ Lambda y.

        self assert: x = LambdaSlot new.  
        "lambda slots are functionaly lambda atoms. All atoms are equivalent"
        self assert: x = y.  

        f _ ((x*x) + (y*y)) sqrt.

        x2 _ x*x.
        xy _ x*y.

        self deny: (x2+x2) sqrt = f.
        self deny: (xy+xy copy) sqrt = f.
        self assert: (x2+x2 copy) sqrt = f.
        self assert: (x2+(y*y)) sqrt = f.

        g _ {f . xy} ~~> (Point lambda: #x:y:).

        self assert: {3 . 4} ~~> g = (5@12).

        o _ (LambdaSlot lambda: #x:y:) <~~ {Lambda . (x2 + Lambda y2) sqrt . x*y}.
        s _ Lambda s.
        oo _  ('y2' -> (s * s)) ~>> (Point ~> o).

        self assert: (('s' ->y) ~>> oo) = g.
        self deny: (('s' ->Lambda z) ~>> oo) = g. ! !

!FunctionalTalkTest methodsFor: 'documentation' stamp: 'spfa 5/13/2006 14:33'!
testExample

        | x y f  g j |

        x _ Lambda x.
        y _ Lambda y.
        f _ ((x*x) + (y*y)) sqrt.
        self assert: f printString = '(((<x> * <x>) + (<y> * <y>)) sqrt)'.
        self assert: {3 . 4} ~~> f = 5.
        g := ('y' -> 0) ~>> f.
        self assert: g printString = '(((<x> * <x>) + 0) sqrt)' .
        self assert: 3 ~> g = 3.
        j := ('y' -> (Lambda z1 + Lambda z2)) ~>> f.
        self assert: j printString = '(((<x> * <x>) + ((<z1> + <z2>) * (<z1> + <z2>))) sqrt)' .
        self assert: {3 . 2 . 2} ~~> j = 5.
! !

!FunctionalTalkTest methodsFor: 'tests' stamp: 'spfa 5/14/2006 14:26'!
testLambda

        "Lambda acts as a shortcut for the creation of an AtomicLambdaMessageSend which a function wrapper for a LambdaSlot"

        | f |

        self assert: Lambda x <~ 4 = 4.
        self assert: {4} ~~> Lambda z = 4.
        self assert: Lambda x <@ 4 = 4.

        self assert: (Lambda x <@ Lambda y) printString = '<y>'.
        self assert: ({Lambda} ~~> Lambda z) printString = '<z>'.
        self assert: ({Lambda x} ~~> Lambda z) printString = '<x>'.

        self assert: ('x' -> 45) ~>> Lambda x = 45.
        self assert: Lambda x <<~ ('x' -> 45) = 45.

        f _ Lambda x * Lambda y.

        self assert: (f o: Lambda x) = f.
        self assert: (Lambda x o: f) = f.! !

!FunctionalTalkTest methodsFor: 'documentation' stamp: 'spfa 5/13/2006 18:25'!
testLambdaVsBlock

        | b f fx fy c g |

        "let's compare two ways to define a function of two variables"

        "1) with a block"
        b _ [:x :y | ((x*x) + (y*y)) sqrt].

        "2) with a lambda expression"
        fx _ Lambda x.                  "shortcut for LambdaSlot id: 'x'"
        fy _ Lambda y.
        f _ ((fx*fx) + (fy*fy)) sqrt.

        "they allow the same calculation"
        self assert: (b value: 3 value: 4) = (f <~~ {3 . 4}).

        "reducing the number of arguments"
        c _ [:x | b value: x value: 0].
        g _ f <<~ ('y' -> 0).
        self assert: (c value: 4) = (g <~ 4).

        "lambda function printing is completely transparent"
        self assert: c printString =
                 '[] in FunctionalTalkTest>>testLambdaVsBlock {[:x | b value: x value: 0]}'.
        self assert: g printString = '(((<x> * <x>) + 0) sqrt)'.

        "you can not add blocks"
        self should: [b+c] raise: Error.
        self assert: (f copy+g) isLambda.
        self assert: (f <~~ {3 . 4}) + (g <~ 4) = ((f copy+g) <~~ {3 . 4 . 4}).

        "a lambda function can be converted into a block"
        self assert: f compiled isBlock.
        self assert: (f compiled value: 3 value: 4) = 5.
! !

!FunctionalTalkTest methodsFor: 'documentation' stamp: 'spfa 5/12/2006 09:07'!
testLambdaVsBlock2

        "as far as local variables are concerned, lambda expressions are analogous to a block with #fixTemps sent"

        | b c f fx fy a |

        a _ 10.

        b _ [:x :y | a + ((x*x) + (y*y)) sqrt].
        c _ [:x :y | a + ((x*x) + (y*y)) sqrt] fixTemps.

        fx _ Lambda x.
        fy _ Lambda y.
        f _ a + ((fx*fx) + (fy*fy)) sqrt.

        self assert: (b value: 3 value: 4) = (f <~~ {3 . 4}).
        self assert: (c value: 3 value: 4) = (f <~~ {3 . 4}).
        a _ 0.
        self deny: (b value: 3 value: 4) = (f <~~ {3 . 4}).
        self assert: (c value: 3 value: 4) = (f <~~ {3 . 4}).! !

!FunctionalTalkTest methodsFor: 'documentation' stamp: 'spfa 5/13/2006 18:28'!
testLambdaVsBlock3

        | b f |

        "lambda expressions capture objects, not only code"

        b _ [BlobMorph new].
        f _ BlobMorph new lambda.
        self assert: f value == f value.
        self deny: b value == b value.

        "tricky consequence: the compiled form, which is a block, may not have the same semantic as the lambda expression"

        f beFast.
        self deny: f value == f compiled value.
        self deny: f compiled value == f compiled value.
! !

!FunctionalTalkTest methodsFor: 'tests' stamp: 'spfa 5/11/2006 18:47'!
testObfuscated

        | p mp |

        p _ Point lambda: #x:y: .
        p _ p <~~ {1 lambda: #+ slotIds: {1} . 2 lambda: #* slotIds: {2}}.

        self assert: p printString = '(Point x: (1 + <1>) y: (2 * <2>))'.
        self assert: {5 . 15} ~~> p = (6 @ 30).

        mp _ p <~~ {5 .  (Point lambda: #x:y: slotIds: {'x2' . 'y2'}) r}.
        self assert: mp printString = '(Point x: 6 y: (2 * ((Point x: <x2> y: <y2>) r)))'.
        self assert: {0 . 1} ~~> mp = (6 @ 2)
! !

!FunctionalTalkTest methodsFor: 'tests' stamp: 'spfa 5/10/2006 16:13'!
testPrinting1

        | f g |

        f _ LambdaSlot selector: #+ arguments: {56}.
        g _ ((f sqrt) + 2) * f.

        self assert: g printString = '((((<receiver> + 56) sqrt) + 2) * (<receiver> + 56))'

! !

!FunctionalTalkTest methodsFor: 'tests' stamp: 'spfa 5/10/2006 16:13'!
testPrinting2

        | f g f2 ff |

        f _ 56 lambda: #+ .
        g _ f sqrt.
        f2 _ f * 2.
        ff _ f * f.

        self assert: f printString = '(56 + <1>)'.
        self assert: g printString = '((56 + <1>) sqrt)'.
        self assert: f2 printString = '((56 + <1>) * 2)'.
        self assert: ff printString = '((56 + <1>) * (56 + <1>))'.

! !

!FunctionalTalkTest methodsFor: 'tests' stamp: 'spfa 5/10/2006 16:14'!
testPrinting3

        | p sp |

        p _ Point lambda: #x:y: .
        sp _ p <~~ {0 . LambdaSlot id: 1}.

        self assert: p printString = '(Point x: <1> y: <2>)'.
        self assert: sp printString = '(Point x: 0 y: <1>)'.
        p <~~ {1 . 2}.
        self assert: p printString = '(Point x: <1> y: <2>)'.
        sp <~ 10.
        self assert: sp printString = '(Point x: 0 y: <1>)'.
! !

!FunctionalTalkTest methodsFor: 'tests' stamp: 'spfa 5/11/2006 15:37'!
testRenameSlots

        | f |

        f _ Behavior lambda: #read:go:buy:cook:inviteForDinner:.
        f slotIds: #('recipe' 'shop' 'food' 'dish' 'girlfriend').

        self assert: f slots printString =
                '#(<recipe> <shop> <food> <dish> <girlfriend>)'.

        self assert: (f <<~ ('girlfriend' -> #bob)) slots printString =
                '#(<recipe> <shop> <food> <dish>)'.! !

!FunctionalTalkTest methodsFor: 'tests' stamp: 'spfa 5/11/2006 18:41'!
testSection

        | p sp a sa ssa sssa |

        p _ Point lambda: #x:y:.
        sp _ p <~~ {5 . Lambda}.

        self assert: (sp <~ 3) = (5@3).

        a _ Array lambda: #with:with:with:with:with:with:.
        sa _ a <~~ {Lambda . Lambda. Lambda . #hello . Lambda . Lambda}.
        ssa _ sa <~~ {Lambda . #two . Lambda . #five . Lambda}.
        sssa _ ssa <~~ {#a . #b . Lambda}.

        self assert: (sa lambdaArity = 5).
        self assert: (sa <~~ {1 . 2 . 3 . 4 . 5}) = {1 . 2 . 3 . #hello . 4 . 5}.

        self assert: (ssa lambdaArity = 3).
        self assert: (ssa <~~ {1 . 2 . 3}) = {1 . #two . 2 . #hello . #five . 3}.

        self assert: (sssa lambdaArity = 1).
        self assert: (sssa <~ 1) = {#a . #two . #b . #hello . #five . 1}.


       
        ! !

!FunctionalTalkTest methodsFor: 'tests' stamp: 'spfa 5/13/2006 18:20'!
testSerialization

        | f rs g |

        f _ Lambda x + Time lambda: #primSecondsClock.
        f beFast.
        rs _ SmartRefStream streamedRepresentationOf: f.
        g _ SmartRefStream objectFromStreamedRepresentation: rs.

        self assert: f hasCompiledForm.
        self deny: g hasCompiledForm.
        self assert: f = g.

        f _ BlobMorph new lambda: #openInWorld.
        f beFast.
        rs _ SmartRefStream streamedRepresentationOf: f.
        g _ SmartRefStream objectFromStreamedRepresentation: rs.

        self assert: f hasCompiledForm.
        self deny: g hasCompiledForm.
        self deny: f = g.! !

!FunctionalTalkTest methodsFor: 'tests' stamp: 'spfa 5/13/2006 21:25'!
testSerialization2

        | x f g rs a |

        x _ Lambda x.
        f _ 2+x.
        g _ x * x.

        rs _ SmartRefStream streamedRepresentationOf: {f . g}.
        a _ SmartRefStream objectFromStreamedRepresentation: rs.

        self assert: (a first + a second) lambdaArity = 1.
        self assert: (3 ~> (a first + a second)) = 14
! !

!FunctionalTalkTest methodsFor: 'documentation' stamp: 'spfa 5/13/2006 18:21'!
testShortAPI

        | f |

        "all arrow notations work in both direction, although parenthesis are needed in a chain from left to right when pointing to a non-lambda object"

        f _ Lambda x - Lambda y.

        self assert: (f <~~ {3 . 4}) = -1.
        self assert: ({3 . 4} ~~> f) = -1.

        self assert: (f <~ 3) printString = '(3 - <y>)'.
        self assert: (3 ~> f) printString = '(3 - <y>)'.

        self assert: (f <~ 3 <~ 4) = -1.
        self assert: (4 ~> (3 ~> f)) = -1.
        self should: [4 ~> 3 ~> f] raise: Error.

        self assert: (f <~~ {Lambda . 4}) printString = '(<x> - 4)'.
        self assert: ({Lambda . 4} ~~> f) printString = '(<x> - 4)'.

        self assert: (f <~~ {Lambda . 4} <~ 3) = -1.
        self assert: (3~> ({Lambda . 4} ~~> f)) = -1.

        self assert: (f <<~ ('y' -> 4)) printString = '(<x> - 4)'.
        self assert: (('y' -> 4) ~>> f) printString = '(<x> - 4)'.

        self assert: (f <<~~ {'y' -> 4 . 'x' -> 3}) = -1.
        self assert: ({'y' -> 4 . 'x' -> 3} ~~>> f) = -1.

        self assert: (f <@@ {3 . 4}) printString = '(3 - 4)'.
        self assert: ({3 . 4} @@> f) printString = '(3 - 4)'.

        self assert: (f <@ 3) printString = '(3 - <y>)'.
        self assert: (3 @> f) printString = '(3 - <y>)'.
       
        self assert: (f <@ 3 <@ 4) printString = '(3 - 4)'.
        self assert: (4 @> (3 @> f)) printString = '(3 - 4)'.
        self should: [4 @> 3 @> f] raise: Error.

        f beFast.
        self assert: (f <// {3 . 4}) = -1.
        self assert: ({3 . 4} //> f) = -1.
        self should: [f </ 3] raise: Error.! !

!FunctionalTalkTest methodsFor: 'tests' stamp: 'spfa 5/14/2006 13:50'!
testSlotVariableName

        self assert: (LambdaSlot id: 1) asVariableName =  'arg1'.
        self assert: (LambdaSlot id: Float pi) asVariableName = 'a3141592653589793'.
        self assert: (LambdaSlot id: 'le schtroumpf qui fait schtroumpf') asVariableName = 'leschtroumpfquifaitschtroumpf'.
        self assert: ((LambdaSlot id: BlobMorph new) asVariableName beginsWith: 'aBlobMorph').! !

!FunctionalTalkTest methodsFor: 'tests' stamp: 'spfa 5/9/2006 15:53'!
testSubstituteSlot

        | p sp a sa ssa sssa |

        p _ Point lambda: #x:y: slotIds: {'x' . 'y'}.
        sp _ p <<~ ('x' -> 5).

        self assert: (sp <~ 3) = (5@3).

        a _ Array lambda: #with:with:with:with:with:with:.
        sa _ a <<~ (4 -> #hello).
        ssa _ sa <<~~ {2 -> #two . 5 -> #five}.
        sssa _ ssa <<~~ {1 -> #a . 3 -> #b}.

        self assert: (sa lambdaArity = 5).
        self assert: (sa <~~ {1 . 2 . 3 . 4 . 5}) = {1 . 2 . 3 . #hello . 4 . 5}.

        self assert: (ssa lambdaArity = 3).
        self assert: (ssa <~~ {1 . 2 . 3}) = {1 . #two . 2 . #hello . #five . 3}.

        self assert: (sssa lambdaArity = 1).
        self assert: (sssa <~ 1) = {#a . #two . #b . #hello . #five . 1}.


       
        ! !

!FunctionalTalkTest methodsFor: 'tests' stamp: 'spfa 5/11/2006 18:44'!
testSubstituteSlot2

        | f sf ssf sssf |

        f _ Behavior lambda: #read:go:buy:cook:inviteForDinner:
                slotIds: #('recipe' 'shop' 'food' 'dish' 'girlfriend').

        sf _ ('recipe' -> (Preferences lambda: #cookbook: slotId: 'book')) ~>> f.

        ssf _ {
                        'shop' -> (Utilities lambda: #store:inCity: slotIds: {'store' . 'city'}).
                        'girlfriend' -> (Preferences lambda: #girlNamed: slotId: 'lovedOne')
                }~~>> sf.

        sssf _ {
                                'dish' -> 'couscous' .
                                 'food' -> (Utilities lambda: #allYouNeedForAGoodCouscous)
                }~~>> ssf.

        self assert:
        sf slots printString =  '#(<book> <shop> <food> <dish> <girlfriend>)'.
        self assert:
        ssf slots printString = '#(<book> <store> <city> <food> <dish> <lovedOne>)' .
        self assert:
        sssf slots printString = '#(<book> <store> <city> <lovedOne>)' .

        self assert:
        sssf printString = '(Behavior read: (Preferences cookbook: <book>) go: (Utilities store: <store> inCity: <city>) buy: (Utilities allYouNeedForAGoodCouscous) cook: ''couscous'' inviteForDinner: (Preferences girlNamed: <lovedOne>))'! !

!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: '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)'! !

!SequenceableCollection methodsFor: '*FunctionalTalk-API' stamp: 'spfa 5/11/2006 13:28'!
//> aLambdaMessageSend

        ^ aLambdaMessageSend reduceWithAllNonLambda: self! !

!Object methodsFor: '*FunctionalTalk-API' stamp: 'spfa 5/11/2006 13:28'!
/> aLambdaMessageSend

        ^ aLambdaMessageSend reduceWithNonLambda: self! !

!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

! !

!AtomicLambdaMessageSend methodsFor: 'testing' stamp: 'spfa 5/14/2006 13:54'!
= anObject

        ^ anObject isLambda and: [anObject isAtomicLambda]! !

!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]! !

!LambdaSlot methodsFor: 'testing' stamp: 'spfa 5/14/2006 14:04'!
= anObject

        ^ anObject isLambdaSlot! !

!Object methodsFor: '*FunctionalTalk-API' stamp: 'spfa 5/11/2006 13:26'!
@> aLambdaMessageSend

        ^ aLambdaMessageSend substitute: {self}! !

!SequenceableCollection methodsFor: '*FunctionalTalk-API' stamp: 'spfa 5/11/2006 13:26'!
@@> aLambdaMessageSend

        ^ aLambdaMessageSend substitute: self! !

!Object methodsFor: '*FunctionalTalk-API' stamp: 'spfa 5/11/2006 13:20'!
~> aLambdaMessageSend

        ^ aLambdaMessageSend reduceWith: self! !

!Association methodsFor: '*FunctionalTalk-API' stamp: 'spfa 5/11/2006 13:31'!
~>> aLambdaMessageSend

        ^ aLambdaMessageSend reduceWithSlot: self! !

!SequenceableCollection methodsFor: '*FunctionalTalk-API' stamp: 'spfa 5/11/2006 13:26'!
~~> aLambdaMessageSend

        ^ aLambdaMessageSend reduceWithAll: self! !

!SequenceableCollection methodsFor: '*FunctionalTalk-API' stamp: 'spfa 5/11/2006 13:30'!
~~>> aLambdaMessageSend

        ^ aLambdaMessageSend reduceWithSlots: self! !