On Wed, Dec 23, 2009 at 10:41 AM, <[email protected]> wrote:

> Em 23/12/2009 16:10, Eliot Miranda < [email protected] > escreveu:
>
> >
> >  Core.SequenceableCollection comparing
> >  isSameSequenceAs: 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."
> >
> >  | size |
> >  (size := self size) = otherCollection size ifFalse: [^false].
> >  1 to: size do: [:index |
> >  (self at: index) = (otherCollection at: index) ifFalse: [^false]].
> >  ^true
> >
> >  i.e.   trust  the   caller   is  providing   a   sequence  and   if
> > otherCollection  doesn't  implement at:  there  will  be a  run-time
> > error, hence any otherCollection isKindOf: SequenceableCollection is
> > just wasted cycles.
> >
>
> I don't think that "trusting the caller" makes sense in this case, so
> I propose instead that you implementation be complemented by:
>
> Object>>isSameSequenceAs: otherCollection
> ^false
>

We're talking about the argument otherCollection not the receiver.  i.e.
leaving out isKindOf: in
isSameSequenceAs: 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."

         | size |
         (otherCollection isKindOf: SequenceableCollection) ifFalse:
[^false]. "this is a horrible wart"
         (size := self size) = otherCollection size ifFalse: [^false].
         1 to: size do: [:index |
                 (self at: index) = (otherCollection at: index) ifFalse:
[^false]].
         ^true

You could use double dispatching:

SequenceableCollection>>isSameSequenceAs: otherThing
    ^otherThing isSameSequenceAsSequence: self

SequenceableCollection>> isSameSequenceAsSequence: aSequenceableCollection
    aSequenceableCollection size ~= self size ifTrue: [^false].
    etc

Object isSameSequenceAsSequence: aSequenceableCollection
    ^false

but I think in this case it's overkill.


> --
> Cesar Rabak
>
> _______________________________________________
> Pharo-project mailing list
> [email protected]
> http://lists.gforge.inria.fr/cgi-bin/mailman/listinfo/pharo-project
>
_______________________________________________
Pharo-project mailing list
[email protected]
http://lists.gforge.inria.fr/cgi-bin/mailman/listinfo/pharo-project

Reply via email to