You should ask Norberto Manzanos, he implemented an IdentitySolver which mitigates the lack of these "philosophical" objects in Smalltalk. Besides he has real experience working with objects difficult to identify and compare. I don't think he's willing to share it with the Pharo community, but who knows...

Cheers,

Hernán

El 19/11/2012 21:20, Hernan Wilkinson escribió:
I think the problem is related to the fact that different objects can
represent the same thing, as 1/2 that represents the same "final" number
as 2/4, but you could also say that they are different, or 1 meter and
100 centimeters and different measures that represent the same distance,
and so on.
So, an empty collection represents an empty collection no matter if it
is a sorted one or not, and a SortedCollection with 1, 2 and 3 and
sortblock a<b represents the same collection of elements as a
SortedCollection with 1, 2 and 3 and block a<=b.
The problem is that the message #= is not enough. We should have more
messages to represent the different "equivalent relationship" where
equality is one of it. For example, one message could be
#representsSameEntityAs: where 1 meter and 100 centimeter would return
true, but 1 meter = 100 centimiter would return false (but I would not
use the #= message for that, it is confusing).

Anyway, going back to the current problem, it is my opinion that with
the current implementation of BlockClosure>>#= I would change how
SortedCollection>>#= is implemented and use super #=
implementation, because currently ((SortedCollection sortBlock: [:a :b |
a < b ]) add: 1; add: 2; yourself) = ((SortedCollection sortBlock: [:a
:b | a < b ]) add: 1; add: 2; yourself) returns false that is
really really astonishing.... and least in other smalltalks returns true.

Hernan.


On Mon, Nov 19, 2012 at 8:27 PM, Camillo Bruni <camillobr...@gmail.com
<mailto:camillobr...@gmail.com>> wrote:

    maybe I am just too naive, but to me this equality check is fairly
    simple:

    - compare inner collection
    - compare block

    now of course we don't have a block compare, so I wrote a simple
    approximation:

    - compare block args / temp size
    - compare temps
    - compare block byte codes
    - check if the blocks are Clean (no outside references)

    in this case it is pretty safe to assume that the blocks are equal.

    On 2012-11-19, at 20:15, Nicolas Cellier
    <nicolas.cellier.aka.n...@gmail.com
    <mailto:nicolas.cellier.aka.n...@gmail.com>> wrote:

     > Certainly, but whether this behavior was designed on purpose or
     > casually due to difficulty of implementing closure equality is
    hard to
     > tell.
     >
     > Even, with a "better" implementation of block closure, the notion of
     > equality is not that clear...
     > For example take
     >    (SortedCollection sortBlock: [:a :b l a < b]) = (SortedCollection
     > sortBlock: [:a :b l b > a]).
     > It might well answer false, even if they will sort any Interval
    the same.
     >
     > What I wanted to emphasize was more "is there a natural/canocical
     > definition of object equality"
     > If yes, I'm very interested, but I don't think so.
     > If not, then we happen to have a collection of arbitrary definitions
     > of equality.
     > So, the question whether one definition is better than the other is
     > difficult to answer.
     > That's what I call interesting.
     > I doubt we have explicit rationale, well written tests or
    standards (I
     > didn't check ANSI) specifying the behaviour...
     > We just have principles of least astonishment and principles of
     > utility (is it used in the image, is it vital, etc...).
     >
     > Nicolas
     >
     > 2012/11/19 Frank Shearar <frank.shea...@gmail.com
    <mailto:frank.shea...@gmail.com>>:
     >> I would guess because there is no general equality for anonymous
    functions.
     >> If the two collections used the same block (as opposed to
    equivalent blocks)
     >> I'd expect them to be =.
     >>
     >> frank
     >>
     >> On 19 Nov 2012, at 21:59, Hernan Wilkinson
    <hernan.wilkin...@10pines.com <mailto:hernan.wilkin...@10pines.com>>
     >> wrote:
     >>
     >> Interesting...
     >>
     >> But then why (SortedCollection sortBlock: [ :a :b | a < b ]) =
     >> (SortedCollection sortBlock: [ :a :b | a < b ]) should return false?
     >>
     >> Hernan
     >>
     >>
     >> On Mon, Nov 19, 2012 at 5:54 PM, Nicolas Cellier
     >> <nicolas.cellier.aka.n...@gmail.com
    <mailto:nicolas.cellier.aka.n...@gmail.com>> wrote:
     >>>
     >>> Interesting...
     >>>
     >>> We could ask such questions too with definition of
     >>> - Heap equality (since they are partially sorted...)
     >>>    (Heap withAll: (1 to: 10) asArray) = (Heap withAll: (1 to: 10)
     >>> asArray shuffled).
     >>> - Interval equality, could you tell me which one is true?
     >>>    (3 to: 2) = (2 to: 1).
     >>>    (1 to: 7 by: 2) = (1 to: 8 by: 2).
     >>>    (1 to: 2 by: 2) = (1 to: 2 by: 3).
     >>>
     >>> Nicolas
     >>>
     >>> 2012/11/19 Hernan Wilkinson <hernan.wilkin...@10pines.com
    <mailto:hernan.wilkin...@10pines.com>>:
     >>>> Hi,
     >>>> I'm a little surprised with the current SortedCollection #=
     >>>> implementation... it is:
     >>>>
     >>>> = aSortedCollection
     >>>> "Answer true if my and aSortedCollection's species are the same,
     >>>> and if our blocks are the same, and if our elements are the same."
     >>>>
     >>>> self species = aSortedCollection species ifFalse: [^ false].
     >>>> sortBlock = aSortedCollection sortBlock
     >>>> ifTrue: [^ super = aSortedCollection]
     >>>> ifFalse: [^ false]
     >>>>
     >>>> and my surprise is because it compares the sortBlocks that
    makes the
     >>>> simplest case to fail like this one:
     >>>>
     >>>> (SortedCollection sortBlock: [ :a :b | a < b ]) =
    (SortedCollection
     >>>> sortBlock: [ :a :b | a < b ])
     >>>>
     >>>> One could argue that if we remove the sortBlock comparison then :
     >>>>
     >>>> (SortedCollection sortBlock: [ :a :b | a < b ]) =
    (SortedCollection
     >>>> sortBlock: [ :a :b | a > b ])
     >>>>
     >>>> would return true... but is that wrong? ... or is the
    philosophy to use
     >>>> the
     >>>> message #hasEqualElements: on this cases?
     >>>>
     >>>> BTW, VisualWorks implementation is the same as pharo, but the
     >>>> BlockClosure>>= is different and that's why it works as at least I
     >>>> expected
     >>>> :-)
     >>>>
     >>>> Bye,
     >>>> Hernan
     >>>>
     >>>> --
     >>>> Hernán Wilkinson
     >>>> Agile Software Development, Teaching & Coaching
     >>>> Phone: +54 - 011 - 6091 - 3125
     >>>> Mobile: +54 - 911 - 4470 - 7207
     >>>> email: hernan.wilkin...@10pines.com
     >>>> site: http://www.10Pines.com
     >>>> Address: Alem 693, Floor 5 B, Buenos Aires, Argentina
     >>>>
     >>>
     >>
     >>
     >>
     >> --
     >> Hernán Wilkinson
     >> Agile Software Development, Teaching & Coaching
     >> Phone: +54 - 011 - 6091 - 3125
     >> Mobile: +54 - 911 - 4470 - 7207
     >> email: hernan.wilkin...@10pines.com
     >> site: http://www.10Pines.com
     >> Address: Alem 693, Floor 5 B, Buenos Aires, Argentina
     >>
     >





--
*Hernán Wilkinson
Agile Software Development, Teaching & Coaching*
*Phone: +54 - 011 - *6091 - 3125*
Mobile: +54 - 911 - 4470 - 7207
email: hernan.wilkin...@10pines.com
site: http://www.10Pines.com <http://www.10pines.com/>*
Address: Alem 693, Floor 5 B, Buenos Aires, Argentina



Reply via email to