The Trunk: Collections-eem.603.mcz

Previous Topic Next Topic
 
classic Classic list List threaded Threaded
10 messages Options
Reply | Threaded
Open this post in threaded view
|

The Trunk: Collections-eem.603.mcz

commits-2
Eliot Miranda uploaded a new version of Collections to project The Trunk:
http://source.squeak.org/trunk/Collections-eem.603.mcz

==================== Summary ====================

Name: Collections-eem.603
Author: eem
Time: 3 February 2015, 12:06:59.618 pm
UUID: 6521c82f-d8de-4c07-a754-3bc3a8667746
Ancestors: Collections-mt.602

Three fewer uses of isKindOf:

=============== Diff against Collections-mt.602 ===============

Item was changed:
  ----- Method: Dictionary>>= (in category 'comparing') -----
  = aDictionary
  "Two dictionaries are equal if
  (a) they are the same 'kind' of thing.
  (b) they have the same set of keys.
  (c) for each (common) key, they have the same value"
 
  self == aDictionary ifTrue: [ ^ true ].
+ aDictionary isDictionary ifFalse: [^false].
- (aDictionary isKindOf: Dictionary) ifFalse: [^false].
  self size = aDictionary size ifFalse: [^false].
  self associationsDo: [:assoc|
  (aDictionary at: assoc key ifAbsent: [^false]) = assoc value
  ifFalse: [^false]].
  ^true
 
  !

Item was changed:
  ----- Method: SequenceableCollection>>hasEqualElements: (in category 'comparing') -----
  hasEqualElements: otherCollection
  "Answer whether the receiver's size is the same as otherCollection's
  size, and each of the receiver's elements equal the corresponding
  element of otherCollection.
  This should probably replace the current definition of #= ."
 
  | size |
+ otherCollection isSequenceable ifFalse: [^ false].
- (otherCollection isKindOf: SequenceableCollection) ifFalse: [^ false].
  (size := self size) = otherCollection size ifFalse: [^ false].
  1 to: size do:
  [:index |
  (self at: index) = (otherCollection at: index) ifFalse: [^ false]].
  ^ true!

Item was changed:
  ----- Method: String>>subStrings: (in category 'converting') -----
  subStrings: separators
  "Answer an array containing the substrings in the receiver separated
  by the elements of separators."
  | char result sourceStream subString |
  #Collectn.
  "Changed 2000/04/08 For ANSI <readableString> protocol."
+ (separators isString or:[separators allSatisfy: [:element | element isCharacter]]) ifFalse:
+ [^ self error: 'separators must be Characters.'].
- (separators isString or:[separators allSatisfy: [:element | element isKindOf: Character]])
- ifFalse: [^ self error: 'separators must be Characters.'].
  sourceStream := ReadStream on: self.
  result := OrderedCollection new.
  subString := String new.
  [sourceStream atEnd]
  whileFalse:
  [char := sourceStream next.
  (separators includes: char)
  ifTrue: [subString notEmpty
  ifTrue:
  [result add: subString copy.
  subString := String new]]
  ifFalse: [subString := subString , (String with: char)]].
  subString notEmpty ifTrue: [result add: subString copy].
  ^ result asArray!


Reply | Threaded
Open this post in threaded view
|

Re: The Trunk: Collections-eem.603.mcz

Levente Uzonyi-2
On Tue, 3 Feb 2015, [hidden email] wrote:

> Eliot Miranda uploaded a new version of Collections to project The Trunk:
> http://source.squeak.org/trunk/Collections-eem.603.mcz
>
> ==================== Summary ====================
>
> Name: Collections-eem.603
> Author: eem
> Time: 3 February 2015, 12:06:59.618 pm
> UUID: 6521c82f-d8de-4c07-a754-3bc3a8667746
> Ancestors: Collections-mt.602
>
> Three fewer uses of isKindOf:
>
> =============== Diff against Collections-mt.602 ===============
>
> Item was changed:
>  ----- Method: Dictionary>>= (in category 'comparing') -----
>  = aDictionary
>   "Two dictionaries are equal if
>   (a) they are the same 'kind' of thing.
>   (b) they have the same set of keys.
>   (c) for each (common) key, they have the same value"
>
>   self == aDictionary ifTrue: [ ^ true ].
> + aDictionary isDictionary ifFalse: [^false].
> - (aDictionary isKindOf: Dictionary) ifFalse: [^false].
>   self size = aDictionary size ifFalse: [^false].
>   self associationsDo: [:assoc|
>   (aDictionary at: assoc key ifAbsent: [^false]) = assoc value
>   ifFalse: [^false]].
>   ^true
>
>  !
>
> Item was changed:
>  ----- Method: SequenceableCollection>>hasEqualElements: (in category 'comparing') -----
>  hasEqualElements: otherCollection
>   "Answer whether the receiver's size is the same as otherCollection's
>   size, and each of the receiver's elements equal the corresponding
>   element of otherCollection.
>   This should probably replace the current definition of #= ."
>
>   | size |
> + otherCollection isSequenceable ifFalse: [^ false].
> - (otherCollection isKindOf: SequenceableCollection) ifFalse: [^ false].

This should either include an #isCollection check, or #isSequenceable
should be moved up to Object.


Levente

>   (size := self size) = otherCollection size ifFalse: [^ false].
>   1 to: size do:
>   [:index |
>   (self at: index) = (otherCollection at: index) ifFalse: [^ false]].
>   ^ true!
>
> Item was changed:
>  ----- Method: String>>subStrings: (in category 'converting') -----
>  subStrings: separators
>   "Answer an array containing the substrings in the receiver separated
>   by the elements of separators."
>   | char result sourceStream subString |
>   #Collectn.
>   "Changed 2000/04/08 For ANSI <readableString> protocol."
> + (separators isString or:[separators allSatisfy: [:element | element isCharacter]]) ifFalse:
> + [^ self error: 'separators must be Characters.'].
> - (separators isString or:[separators allSatisfy: [:element | element isKindOf: Character]])
> - ifFalse: [^ self error: 'separators must be Characters.'].
>   sourceStream := ReadStream on: self.
>   result := OrderedCollection new.
>   subString := String new.
>   [sourceStream atEnd]
>   whileFalse:
>   [char := sourceStream next.
>   (separators includes: char)
>   ifTrue: [subString notEmpty
>   ifTrue:
>   [result add: subString copy.
>   subString := String new]]
>   ifFalse: [subString := subString , (String with: char)]].
>   subString notEmpty ifTrue: [result add: subString copy].
>   ^ result asArray!
>
>
>

Reply | Threaded
Open this post in threaded view
|

Re: The Trunk: Collections-eem.603.mcz

Eliot Miranda-2


On Tue, Feb 3, 2015 at 12:22 PM, Levente Uzonyi <[hidden email]> wrote:
On Tue, 3 Feb 2015, [hidden email] wrote:

Eliot Miranda uploaded a new version of Collections to project The Trunk:
http://source.squeak.org/trunk/Collections-eem.603.mcz

==================== Summary ====================

Name: Collections-eem.603
Author: eem
Time: 3 February 2015, 12:06:59.618 pm
UUID: 6521c82f-d8de-4c07-a754-3bc3a8667746
Ancestors: Collections-mt.602

Three fewer uses of isKindOf:

=============== Diff against Collections-mt.602 ===============

Item was changed:
 ----- Method: Dictionary>>= (in category 'comparing') -----
 = aDictionary
        "Two dictionaries are equal if
         (a) they are the same 'kind' of thing.
         (b) they have the same set of keys.
         (c) for each (common) key, they have the same value"

        self == aDictionary ifTrue: [ ^ true ].
+       aDictionary isDictionary ifFalse: [^false].
-       (aDictionary isKindOf: Dictionary) ifFalse: [^false].
        self size = aDictionary size ifFalse: [^false].
        self associationsDo: [:assoc|
                (aDictionary at: assoc key ifAbsent: [^false]) = assoc value
                        ifFalse: [^false]].
        ^true

 !

Item was changed:
 ----- Method: SequenceableCollection>>hasEqualElements: (in category 'comparing') -----
 hasEqualElements: otherCollection
        "Answer whether the receiver's size is the same as otherCollection's
        size, and each of the receiver's elements equal the corresponding
        element of otherCollection.
        This should probably replace the current definition of #= ."

        | size |
+       otherCollection isSequenceable ifFalse: [^ false].
-       (otherCollection isKindOf: SequenceableCollection) ifFalse: [^ false].

This should either include an #isCollection check, or #isSequenceable should be moved up to Object.

Oops.  Good catch.  Which would you do?  I favour the latter.

Levente


        (size := self size) = otherCollection size ifFalse: [^ false].
        1 to: size do:
                [:index |
                (self at: index) = (otherCollection at: index) ifFalse: [^ false]].
        ^ true!

Item was changed:
 ----- Method: String>>subStrings: (in category 'converting') -----
 subStrings: separators
        "Answer an array containing the substrings in the receiver separated
        by the elements of separators."
        | char result sourceStream subString |
        #Collectn.
        "Changed 2000/04/08 For ANSI <readableString> protocol."
+       (separators isString or:[separators allSatisfy: [:element | element isCharacter]]) ifFalse:
+               [^ self error: 'separators must be Characters.'].
-       (separators isString or:[separators allSatisfy: [:element | element isKindOf: Character]])
-               ifFalse: [^ self error: 'separators must be Characters.'].
        sourceStream := ReadStream on: self.
        result := OrderedCollection new.
        subString := String new.
        [sourceStream atEnd]
                whileFalse:
                        [char := sourceStream next.
                        (separators includes: char)
                                ifTrue: [subString notEmpty
                                                ifTrue:
                                                        [result add: subString copy.
                                                        subString := String new]]
                                ifFalse: [subString := subString , (String with: char)]].
        subString notEmpty ifTrue: [result add: subString copy].
        ^ result asArray!







--
best,
Eliot


Reply | Threaded
Open this post in threaded view
|

Re: The Trunk: Collections-eem.603.mcz

Chris Muller-3
isSequenceable is a term that refers to a particular *kind* of
Collection, a sequenceable one.

Therefore, IMO, I am unable to think of any more clear and explicit
way of expressing that than "isKindOf: SequenceableCollection"...


On Tue, Feb 3, 2015 at 8:59 PM, Eliot Miranda <[hidden email]> wrote:

>
>
> On Tue, Feb 3, 2015 at 12:22 PM, Levente Uzonyi <[hidden email]> wrote:
>>
>> On Tue, 3 Feb 2015, [hidden email] wrote:
>>
>>> Eliot Miranda uploaded a new version of Collections to project The Trunk:
>>> http://source.squeak.org/trunk/Collections-eem.603.mcz
>>>
>>> ==================== Summary ====================
>>>
>>> Name: Collections-eem.603
>>> Author: eem
>>> Time: 3 February 2015, 12:06:59.618 pm
>>> UUID: 6521c82f-d8de-4c07-a754-3bc3a8667746
>>> Ancestors: Collections-mt.602
>>>
>>> Three fewer uses of isKindOf:
>>>
>>> =============== Diff against Collections-mt.602 ===============
>>>
>>> Item was changed:
>>>  ----- Method: Dictionary>>= (in category 'comparing') -----
>>>  = aDictionary
>>>         "Two dictionaries are equal if
>>>          (a) they are the same 'kind' of thing.
>>>          (b) they have the same set of keys.
>>>          (c) for each (common) key, they have the same value"
>>>
>>>         self == aDictionary ifTrue: [ ^ true ].
>>> +       aDictionary isDictionary ifFalse: [^false].
>>> -       (aDictionary isKindOf: Dictionary) ifFalse: [^false].
>>>         self size = aDictionary size ifFalse: [^false].
>>>         self associationsDo: [:assoc|
>>>                 (aDictionary at: assoc key ifAbsent: [^false]) = assoc
>>> value
>>>                         ifFalse: [^false]].
>>>         ^true
>>>
>>>  !
>>>
>>> Item was changed:
>>>  ----- Method: SequenceableCollection>>hasEqualElements: (in category
>>> 'comparing') -----
>>>  hasEqualElements: otherCollection
>>>         "Answer whether the receiver's size is the same as
>>> otherCollection's
>>>         size, and each of the receiver's elements equal the corresponding
>>>         element of otherCollection.
>>>         This should probably replace the current definition of #= ."
>>>
>>>         | size |
>>> +       otherCollection isSequenceable ifFalse: [^ false].
>>> -       (otherCollection isKindOf: SequenceableCollection) ifFalse: [^
>>> false].
>>
>>
>> This should either include an #isCollection check, or #isSequenceable
>> should be moved up to Object.
>
>
> Oops.  Good catch.  Which would you do?  I favour the latter.
>
>> Levente
>>
>>
>>>         (size := self size) = otherCollection size ifFalse: [^ false].
>>>         1 to: size do:
>>>                 [:index |
>>>                 (self at: index) = (otherCollection at: index) ifFalse:
>>> [^ false]].
>>>         ^ true!
>>>
>>> Item was changed:
>>>  ----- Method: String>>subStrings: (in category 'converting') -----
>>>  subStrings: separators
>>>         "Answer an array containing the substrings in the receiver
>>> separated
>>>         by the elements of separators."
>>>         | char result sourceStream subString |
>>>         #Collectn.
>>>         "Changed 2000/04/08 For ANSI <readableString> protocol."
>>> +       (separators isString or:[separators allSatisfy: [:element |
>>> element isCharacter]]) ifFalse:
>>> +               [^ self error: 'separators must be Characters.'].
>>> -       (separators isString or:[separators allSatisfy: [:element |
>>> element isKindOf: Character]])
>>> -               ifFalse: [^ self error: 'separators must be
>>> Characters.'].
>>>         sourceStream := ReadStream on: self.
>>>         result := OrderedCollection new.
>>>         subString := String new.
>>>         [sourceStream atEnd]
>>>                 whileFalse:
>>>                         [char := sourceStream next.
>>>                         (separators includes: char)
>>>                                 ifTrue: [subString notEmpty
>>>                                                 ifTrue:
>>>                                                         [result add:
>>> subString copy.
>>>                                                         subString :=
>>> String new]]
>>>                                 ifFalse: [subString := subString ,
>>> (String with: char)]].
>>>         subString notEmpty ifTrue: [result add: subString copy].
>>>         ^ result asArray!
>>>
>>>
>>>
>>
>
>
>
> --
> best,
> Eliot
>
>
>

Reply | Threaded
Open this post in threaded view
|

Re: The Trunk: Collections-eem.603.mcz

Eliot Miranda-2


On Wed, Feb 4, 2015 at 9:07 AM, Chris Muller <[hidden email]> wrote:
isSequenceable is a term that refers to a particular *kind* of
Collection, a sequenceable one.

Therefore, IMO, I am unable to think of any more clear and explicit
way of expressing that than "isKindOf: SequenceableCollection"...

self isCollection and: [self isSequenceable]  is better.  isKinfOf: is a) not object-oriented as it forces an argument to be in a particular hierarchy rather than having a particular interface, and b) is horribly inefficient, causing a potentially long search of an object's class hierarchy.  isKindOf: doesn't just smell, it stinks.

So what do you prefer Chris, making isSequenceable an Object method too, or using self isCollection and: [self isSequenceable]?  I like the former because its simple, but you might have valid objections to extending Object.  That's why I'm canvassing opinions.  I wont stop nuking isKindOf:'s as I see them though ;-)



On Tue, Feb 3, 2015 at 8:59 PM, Eliot Miranda <[hidden email]> wrote:
>
>
> On Tue, Feb 3, 2015 at 12:22 PM, Levente Uzonyi <[hidden email]> wrote:
>>
>> On Tue, 3 Feb 2015, [hidden email] wrote:
>>
>>> Eliot Miranda uploaded a new version of Collections to project The Trunk:
>>> http://source.squeak.org/trunk/Collections-eem.603.mcz
>>>
>>> ==================== Summary ====================
>>>
>>> Name: Collections-eem.603
>>> Author: eem
>>> Time: 3 February 2015, 12:06:59.618 pm
>>> UUID: 6521c82f-d8de-4c07-a754-3bc3a8667746
>>> Ancestors: Collections-mt.602
>>>
>>> Three fewer uses of isKindOf:
>>>
>>> =============== Diff against Collections-mt.602 ===============
>>>
>>> Item was changed:
>>>  ----- Method: Dictionary>>= (in category 'comparing') -----
>>>  = aDictionary
>>>         "Two dictionaries are equal if
>>>          (a) they are the same 'kind' of thing.
>>>          (b) they have the same set of keys.
>>>          (c) for each (common) key, they have the same value"
>>>
>>>         self == aDictionary ifTrue: [ ^ true ].
>>> +       aDictionary isDictionary ifFalse: [^false].
>>> -       (aDictionary isKindOf: Dictionary) ifFalse: [^false].
>>>         self size = aDictionary size ifFalse: [^false].
>>>         self associationsDo: [:assoc|
>>>                 (aDictionary at: assoc key ifAbsent: [^false]) = assoc
>>> value
>>>                         ifFalse: [^false]].
>>>         ^true
>>>
>>>  !
>>>
>>> Item was changed:
>>>  ----- Method: SequenceableCollection>>hasEqualElements: (in category
>>> 'comparing') -----
>>>  hasEqualElements: otherCollection
>>>         "Answer whether the receiver's size is the same as
>>> otherCollection's
>>>         size, and each of the receiver's elements equal the corresponding
>>>         element of otherCollection.
>>>         This should probably replace the current definition of #= ."
>>>
>>>         | size |
>>> +       otherCollection isSequenceable ifFalse: [^ false].
>>> -       (otherCollection isKindOf: SequenceableCollection) ifFalse: [^
>>> false].
>>
>>
>> This should either include an #isCollection check, or #isSequenceable
>> should be moved up to Object.
>
>
> Oops.  Good catch.  Which would you do?  I favour the latter.
>
>> Levente
>>
>>
>>>         (size := self size) = otherCollection size ifFalse: [^ false].
>>>         1 to: size do:
>>>                 [:index |
>>>                 (self at: index) = (otherCollection at: index) ifFalse:
>>> [^ false]].
>>>         ^ true!
>>>
>>> Item was changed:
>>>  ----- Method: String>>subStrings: (in category 'converting') -----
>>>  subStrings: separators
>>>         "Answer an array containing the substrings in the receiver
>>> separated
>>>         by the elements of separators."
>>>         | char result sourceStream subString |
>>>         #Collectn.
>>>         "Changed 2000/04/08 For ANSI <readableString> protocol."
>>> +       (separators isString or:[separators allSatisfy: [:element |
>>> element isCharacter]]) ifFalse:
>>> +               [^ self error: 'separators must be Characters.'].
>>> -       (separators isString or:[separators allSatisfy: [:element |
>>> element isKindOf: Character]])
>>> -               ifFalse: [^ self error: 'separators must be
>>> Characters.'].
>>>         sourceStream := ReadStream on: self.
>>>         result := OrderedCollection new.
>>>         subString := String new.
>>>         [sourceStream atEnd]
>>>                 whileFalse:
>>>                         [char := sourceStream next.
>>>                         (separators includes: char)
>>>                                 ifTrue: [subString notEmpty
>>>                                                 ifTrue:
>>>                                                         [result add:
>>> subString copy.
>>>                                                         subString :=
>>> String new]]
>>>                                 ifFalse: [subString := subString ,
>>> (String with: char)]].
>>>         subString notEmpty ifTrue: [result add: subString copy].
>>>         ^ result asArray!
>>>
>>>
>>>
>>
>
>
>
> --
> best,
> Eliot
>
>
>



--
best,
Eliot


Reply | Threaded
Open this post in threaded view
|

Re: The Trunk: Collections-eem.603.mcz

marcel.taeumel (old)
In reply to this post by Chris Muller-3
I vote for:

"... xx isCollection and: [xx isSequenceable] ..."

Best,
Marcel
Reply | Threaded
Open this post in threaded view
|

Re: The Trunk: Collections-eem.603.mcz

Tobias Pape
In reply to this post by Eliot Miranda-2

On 04.02.2015, at 18:17, Eliot Miranda <[hidden email]> wrote:

> isKindOf: doesn't just smell, it stinks.

ACK.

Reply | Threaded
Open this post in threaded view
|

Re: The Trunk: Collections-eem.603.mcz

timrowledge
In reply to this post by marcel.taeumel (old)

On 04-02-2015, at 9:20 AM, Marcel Taeumel <[hidden email]> wrote:

> I vote for:
>
> "... xx isCollection and: [xx isSequenceable] …"

And I’d prefer a simple isSequenceableCollection over that. I don’t actually like any of them because there is almost always A Better Way(™) hidden in there somewhere, but at least a very specific method is easy to track down and replace when said better way is discovered. They’re all over the place in nuScratch but the performance improvements simply from removing multiple isKindOf: sends within large loops are well worth the slight stinkiness.

tim
--
tim Rowledge; [hidden email]; http://www.rowledge.org/tim
"How many Slavers does it take to change a lightbulb?”
"Dunno. How susceptible are lightbulbs to telepathy?"




Reply | Threaded
Open this post in threaded view
|

Re: The Trunk: Collections-eem.603.mcz

Chris Muller-4
In reply to this post by Eliot Miranda-2
> On Wed, Feb 4, 2015 at 9:07 AM, Chris Muller <[hidden email]> wrote:
>>
>> isSequenceable is a term that refers to a particular *kind* of
>> Collection, a sequenceable one.
>>
>> Therefore, IMO, I am unable to think of any more clear and explicit
>> way of expressing that than "isKindOf: SequenceableCollection"...
>
>
> self isCollection and: [self isSequenceable]  is better.  isKinfOf: is a)
> not object-oriented as it forces an argument to be in a particular hierarchy
> rather than having a particular interface, and b) is horribly inefficient,
> causing a potentially long search of an object's class hierarchy.  isKindOf:
> doesn't just smell, it stinks.

Yes, and class-testing via #class as well, for the same reasons.  But
sometimes we really do want to know whether we have a _particular
implementation_ of a Dictionary, not just dictionary behaviors and
API's.

I'm not saying I'm against your change, I'm just saying that I feel
this kind of "cleaning" should be done with deliberation and careful
consideration, not whimsically.  Today all of the #= implementations
in the system are based on type coherence, except for this one which
was just changed.  It's easier than it seems for semantics to be
subtly changed.

For example, I have several of my own dictionary implementations which
do not inherit from Dictionary; but if they implement #isDictionary
for a different reason, I will now get a different answer from #=
depending on which I ask it; (aDictionary = theirSpecialDictionary)
vs. (theirSpecialDictionary = aDictionary) might produce different
results if SpecialDictionary is doing the conventional "type" check.

> So what do you prefer Chris, making isSequenceable an Object method too, or
> using self isCollection and: [self isSequenceable]?  I like the former
> because its simple, but you might have valid objections to extending Object.
> That's why I'm canvassing opinions.  I wont stop nuking isKindOf:'s as I see
> them though ;-)

I prefer the latter because its asking if its a particular sub-types
require a super-type check first.  I think if you want simplicity you
should implement #isSequenceableCollection on Object to return the
"self isCollection and: [self isSequenceable]".

Because another consideration is consumption of the method namespace
on Object with simple terms that then become unavailable to
applications.  The most egregious example I can think of is
Object>>#name.  It means an app implement #name without overriding the
one in Object.  But every app has things that have #names.  There is a
remote possibility that an app might want to implement the
#isSequenceable for a application-specific purpose..

Reply | Threaded
Open this post in threaded view
|

Re: The Trunk: Collections-eem.603.mcz

Levente Uzonyi-2
In reply to this post by Eliot Miranda-2
On Tue, 3 Feb 2015, Eliot Miranda wrote:

> Oops.  Good catch.  Which would you do?  I favour the latter.

I would not do the latter, because #isSequenceable is too general for
Object. I would either add a new method - #isSequenceableCollection - or
use the combination of #isCollection and #isSequenceable.

Levente