Paolo

why Iterable as a superclass of stream and collection?
Why not a trait?
Then I'm wondering why this would be faster.

Hi all, I would like to ask your opinion about adding the "Iterable"  
common
superclass of Collection and Stream to Pharo.  This is already in GNU
Smalltalk and is in my opinion a better alternative to the "lazy
collections" idea.

Here is how I did it:

1) Well, create the class and make Stream/Collection subclasses of it.

2) Push there from Collection #do: (abstract), #inject:into:, #fold: (if
you have it), #do:separatedBy:, #detect:, #detect:ifNone:, #count: (if  
you
have it), #allSatisfy:, #noneSatisfy:, #conform:, #contains: (if you  
have
the last two).

3) Add #nextPutAllOn:

     nextPutAllOn: aStream
         "Write all the objects in the receiver to aStream"
         self do: [ :each | aStream nextPut: each ]

4) Change Stream>>#nextPutAllOn: to use "source nextPutAllOn: self".

5) On top of this I added "filtering" streams to implement #select:,
#reject: and #collect:.  Here is a clean-room MIT implementation:

Stream >> select: block
        ^FilterStream new stream: source block: block result: true

Stream >> reject: block
        ^FilterStream new stream: source block: block result: false

Stream >> collect: block
        ^FilterStream new stream: source block: block

FilterStream >> atEnd
        atEnd isNil ifTrue: [
                [stream atEnd ifTrue: [^atEnd := true].
                next := stream next.
                (block value: next) == result] whileFalse.
                atEnd := false].
        ^atEnd

FilterStream >> next
        self atEnd ifTrue: [^pastEnd].
        atEnd := nil.
        ^next

CollectStream >> atEnd
        ^stream atEnd

CollectStream >> next
        ^block value: stream next



On Jul 16, 2009, at 9:57 AM, Paolo Bonzini wrote:

>
>> If people really want to be able to combine enumerator methods for
>> higher efficiently the Collection hierarchy should be fixed. Having
>> external iterator objects like in C++ and Java is not that bad after
>> all:
>>
>>    result := aCollection iterator
>>       select: [ :e | ... ];
>>       collect: [ :e | ... ];
>>       contents
>
> It's already there and it's called #readStream. :-)  It only lacks  
> #size.
>
> See http://code.google.com/p/pharo/issues/detail?id=958 for an outline
> of the implementation.
>
> Paolo
>
>
> _______________________________________________
> Pharo-project mailing list
> Pharo-project@lists.gforge.inria.fr
> http://lists.gforge.inria.fr/cgi-bin/mailman/listinfo/pharo-project


_______________________________________________
Pharo-project mailing list
Pharo-project@lists.gforge.inria.fr
http://lists.gforge.inria.fr/cgi-bin/mailman/listinfo/pharo-project

Reply via email to