[squeak-dev] The Trunk: Kernel-eem.1296.mcz

Eliot Miranda eliot.miranda at gmail.com
Wed Feb 19 18:35:13 UTC 2020


On Wed, Feb 19, 2020 at 10:30 AM Levente Uzonyi <leves at caesar.elte.hu>
wrote:

> Before 2010, #sorted: and #sorted didn't exist. #sort and #sort: were only
> implemented by ArrayedCollection but were rarely used.
> The most common ways to sort a collection was by the means of
> #asSortedCollection, #asSortedCollection:, #sortBy: and #asSortedArray.
> Since then, these senders have all been rewritten to use the newer
> methods.
>
> #(sort sorted sort: sorted:) collect: [ :each |
>         each -> (
>                 (SystemNavigation default allCallsOn: each) count: [ :ea |
>                         (ea actualClass inheritsFrom: TestCase) not  ]) ].
> {
>         #sort->123 .
>         #sorted->58 .
>         #sort:->111 .
>         #sorted:->62
> }
>
> The above distribution tells me that it's twice as common to sort the
> receiver than to sort a copy. But passing a custom sorter is about as
> common as using the default sorter.
>
> Before 2014, #asSortFunction didn't exist. You had to use a sorter block,
> a symbol, or nil.
> SortFunctions are much more comfortable to use than regular sort blocks,
> but they have some impact on performance. They are often times created by
> sending #ascending or #descending to a block or a symbol, which is another
> reason why #asSortFunction doesn't have too many senders.
>
> Anyway, it's no wonder why SortFunctions are not widely used: they are
> fairly new, and the complex sorters, where they really shine, are not that
> common.
>
>
> Levente
>
> P.S.: Since we're discussing #allMethodCategoriesIntegratedThrough:, it
> should use #withAllSuperclassesDo: instead of #withAllSuperclasses and
> #do:.
>

+1.  I just fixed the bug that I got bit by in the debugger by making the
most minimal changes I could think of.  i apologies for not giving this
more thought.


>
>
> On Wed, 19 Feb 2020, John Pfersich via Squeak-dev wrote:
>
> > That snippet might be useful but it’s not used much in the code base.
> sorted: is only used 71 times, and asSortFunction is only used 9 times. And
> the combination is even rarer. So if you’re like most programmers, you
> wouldn’t
> > have seen either selector.
> >
> > /————————————————————/For encrypted mail use jgpfersich at protonmail.comGet
> a free account at ProtonMail.com
> > Web: https://objectnets.net and https://objectnets.org
> > https://datascilv.com https://datascilv.org
> >
> >
> >       On Feb 19, 2020, at 01:08, Thiede, Christoph <
> Christoph.Thiede at student.hpi.uni-potsdam.de> wrote:
> >
> >
> >       Hi Marcel,
> >
> >
> >       I did *not* mean:
> >
> > ^aColl asArray sorted: ...
> > I *did* mean:
> > ^aColl sorted: ...
> >
> > Very minor, but what else do we have #sorted: for? Law of Demeter and so
> on ... :-)
> >
> > Best,
> > Christoph
> >
> >
> _________________________________________________________________________________________________________________________________________________________________________________________________________________________________
> > Von: Squeak-dev <squeak-dev-bounces at lists.squeakfoundation.org> im
> Auftrag von Taeumel, Marcel
> > Gesendet: Mittwoch, 19. Februar 2020 09:52:34
> > An: John Pfersich via Squeak-dev; packages at lists.squeakfoundation.org
> > Betreff: Re: [squeak-dev] The Trunk: Kernel-eem.1296.mcz
> > Since #asArray did already a copy, there is no need to call #sorted:
> here.
> > Best,
> > Marcel
> >
> >       Am 19.02.2020 09:44:40 schrieb Thiede, Christoph <
> christoph.thiede at student.hpi.uni-potsdam.de>:
> >
> >       > +        ^aColl asArray sort: [:a :b | a asLowercase < b
> asLowercase]
> >
> >
> > Hm, shouldn't you prefer #sorted: here? :-)
> > aColl sorted: #asLowercase asSortFunction
> > Or maybe use a SortedCollection from the beginning ...
> >
> >
> _________________________________________________________________________________________________________________________________________________________________________________________________________________________________
> > Von: Squeak-dev <squeak-dev-bounces at lists.squeakfoundation.org> im
> Auftrag von commits at source.squeak.org <commits at source.squeak.org>
> > Gesendet: Mittwoch, 19. Februar 2020 04:43:19
> > An: squeak-dev at lists.squeakfoundation.org;
> packages at lists.squeakfoundation.org
> > Betreff: [squeak-dev] The Trunk: Kernel-eem.1296.mcz
> > Eliot Miranda uploaded a new version of Kernel to project The Trunk:
> > http://source.squeak.org/trunk/Kernel-eem.1296.mcz
> >
> > ==================== Summary ====================
> >
> > Name: Kernel-eem.1296
> > Author: eem
> > Time: 18 February 2020, 7:43:15.608431 pm
> > UUID: 78e95030-3521-4dd9-b26c-2c8c7939010b
> > Ancestors: Kernel-eem.1295, Kernel-tonyg.1293
> >
> > Fix a bug in allMethodCategoriesIntegratedThrough: which can cause an
> error in the Debugger when prompting to define a new method.
> >
> > Fix bugs in CompiledCode>>messagesDo:/selectorsDo: and define the former
> in terms of the latter (since the former is a misnomer).
> >
> > Fix a bug in the definition of CompiledMethod>>hasSameLiteralsAs: which
> should not be confused by the methodClass literal.
> >
> > Fix perform:with:with:with:with:with:'s comment.
> >
> > =============== Diff against Kernel-tonyg.1293 ===============
> >
> > Item was changed:
> >   ----- Method: Behavior>>instSpec (in category 'testing') -----
> >   instSpec
> >          "Answer the instance specification part of the format that
> defines what kind of object
> >           an instance of the receiver is.  The formats are
> >                          0       = 0 sized objects (UndefinedObject True
> False et al)
> >                          1       = non-indexable objects with inst vars
> (Point et al)
> >                          2       = indexable objects with no inst vars
> (Array et al)
> >                          3       = indexable objects with inst vars
> (Context BlockClosure AdditionalMethodState et al)
> >                          4       = weak indexable objects with inst vars
> (WeakArray et al)
> >                          5       = weak non-indexable objects with inst
> vars (ephemerons) (Ephemeron)
> >                          6       = unused
> >                          7       = immediates (SmallInteger, Character)
> >                          8       = unused
> > +                        9       = 64-bit indexable
> (DoubleWordArray et al)
> > +                10-11   = 32-bit indexable      (WordArray et
> al)                       (includes one odd bit, unused in 32-bit instances)
> > +                12-15   = 16-bit indexable      (DoubleByteArray et
> al)         (includes two odd bits, one unused in 32-bit instances)
> > +                16-23   = 8-bit indexable       (ByteArray et
> al)                       (includes three odd bits, one unused in 32-bit
> instances)
> > +                24-31   = compiled code (CompiledCode et al)
> (includes three odd bits, one unused in 32-bit instances)
> > +
> > -                        9       = 64-bit indexable
> > -                10-11   = 32-bit indexable
> (Bitmap)                                     (plus one odd bit, unused in
> 32-bits)
> > -                12-15   = 16-bit
> indexable                                                      (plus two
> odd bits, one unused in 32-bits)
> > -                16-23   = 8-bit
> indexable                                                       (plus three
> odd bits, one unused in 32-bits)
> > -                24-31   = compiled methods (CompiledMethod)     (plus
> three odd bits, one unused in 32-bits)
> >           Note that in the VM instances also have a 5 bit format field
> that relates to their class's format.
> >           Formats 11, 13-15, 17-23 & 25-31 are unused in classes but
> used in instances to define the
> >           number of elements missing up to the slot size.  For example,
> a 2-byte ByteString instance
> > +         has format 18 in 32 bits, since its size is one 32-bit slot -
> 2 bytes ((18 bitAnd: 3) = 2), and
> > +         22 in 64 bits, since its size is one 64-bit slot - 6 bytes
> ((22 bitAnd: 7) = 6).
> > +         Formats 24-31 are for compiled code which is a combination of
> pointers and bytes.  The number of pointers is
> > +         determined by literal count field of the method header, which
> is the first field of the object and must be a SmallInteger.
> > +         The literal count field occupies the least significant 15 bits
> of the method header, allowing up to 32,767 pointer fields,
> > +         not including the header."
> > -         has format 18 in 32-bits, since its size is one 32-bit slot -
> 2 bytes ((18 bitAnd: 3) = 2), and
> > -         22 in 64 bits, since its size is one 64-bit slot - 6 bytes
> ((22 bitAnd: 7) = 6)."
> >          ^(format bitShift: -16) bitAnd: 16r1F!
> >
> > Item was changed:
> >   ----- Method: ClassDescription>>allMethodCategoriesIntegratedThrough:
> (in category 'accessing method dictionary') -----
> >   allMethodCategoriesIntegratedThrough: mostGenericClass
> >          "Answer a list of all the method categories of the receiver and
> all its superclasses, up through mostGenericClass"
> >
> >          | aColl |
> > +        aColl := Set new.
> > -        aColl := OrderedCollection new.
> >          self withAllSuperclasses do:
> >                  [:aClass |
> > +                (aClass includesBehavior: mostGenericClass) ifTrue:
> > +                        [aColl addAll: aClass organization categories]].
> > -                        (aClass includesBehavior: mostGenericClass)
> > -                                ifTrue: [aColl addAll: aClass
> organization categories]].
> >          aColl remove: 'no messages' asSymbol ifAbsent: [].
> >
> > +        ^aColl asArray sort: [:a :b | a asLowercase < b asLowercase]
> > -        ^aColl asSet asArray sort: [:a :b | a asLowercase < b
> asLowercase]
> >
> >   "ColorTileMorph allMethodCategoriesIntegratedThrough: TileMorph"!
> >
> > Item was changed:
> >   ----- Method: CompiledCode>>messagesDo: (in category 'scanning') -----
> >   messagesDo: workBlock
> > +        "Evaluate aBlock with all the message selectors sent by me.
> Duplicate seletors are possible."
> > -        "Evaluate aBlock with all the message selectors sent by me.
> Duplicate sends possible."
> >
> > +        "If anything should be deprecated it is messagesDo:; it can be
> an extension in AST/Refactoring.
> > +         This method enumerates over selectors, not messages.  c.f.
> Behavior>>selectorsDo: etc"
> > +        ^self selectorsDo: workBlock!
> > -        | scanner selector  |
> > -        self isQuick ifTrue: [^ self].
> > -
> > -        self codeLiteralsDo: [:compiledCode |
> > -                scanner := InstructionStream on: compiledCode.
> > -                scanner scanFor: [ :x |
> > -                        (selector := scanner selectorToSendOrSelf) ==
> scanner
> > -                                ifFalse: [workBlock value: selector].
> > -                        false "keep scanning" ] ].!
> >
> > Item was added:
> > + ----- Method: CompiledCode>>selectorsDo: (in category 'scanning') -----
> > + selectorsDo: workBlock
> > +        "Evaluate aBlock with all the message selectors sent by me.
> Duplicate selectors are possible."
> > +
> > +        | encoderClass |
> > +        self isQuick ifTrue: [^self].
> > +        encoderClass := self encoderClass.
> > +        self codeLiteralsDo:
> > +                [:compiledCode | | scanner limit |
> > +                limit := compiledCode size - 1.
> > +                (scanner := InstructionStream on: compiledCode) scanFor:
> > +                        [:byte| | selector |
> > +                        (selector := scanner selectorToSendOrSelf) ~~
> scanner ifTrue:
> > +                                [workBlock value: selector].
> > +                        ((encoderClass isExtension: byte)
> > +                         and: [scanner pc < limit]) ifTrue:
> > +                                [scanner pc: scanner pc + (encoderClass
> bytecodeSize: (compiledCode at: scanner pc + 2))].
> > +                        false "keep scanning"]]!
> >
> > Item was changed:
> >   ----- Method: CompiledCode>>sendsMessage: (in category 'testing') -----
> > + sendsMessage: aSelector
> > +        "eem: this should be deprecated. This method does not check if
> a method sends a message;
> > +         it checks if a method sends a message with a particular
> selector."
> > +        self flag: #todo.
> > - sendsMessage: aSelector
> > -
> >          self messagesDo: [:selector |
> >                  selector = aSelector ifTrue: [^ true]].
> >          ^ false!
> >
> > Item was changed:
> >   ----- Method: CompiledCode>>sendsSelector: (in category 'testing')
> -----
> >   sendsSelector: aSelector
> > +        "Answer if the receiver sends a message whose selector is
> aSelector."
> >
> > +        self selectorsDo:
> > +                [:selector | selector = aSelector ifTrue: [^true]].
> > +        self flag: #todo. "The use of #= instead of #== is extremely
> dubious, and IMO erroneous. eem 2/18/2020"
> > +        ^false!
> > -        self flag: #todo. "mt: Deprecate? AST/Refactoring project needs
> it..."
> > -        ^ self sendsMessage: aSelector!
> >
> > Item was changed:
> >   ----- Method: CompiledMethod>>hasSameLiteralsAs: (in category
> 'comparing') -----
> >   hasSameLiteralsAs: aMethod
> >          "Answer whether the receiver has the same sequence of literals
> as the argument.
> >           Compare the last literal, which is the class association,
> specially so as not to
> >           differentiate between otherwise identical methods installed in
> different classes.
> >           Compare the first literal carefully if it is the binding
> informaiton for an FFI or
> >           external primitive call.  Don't compare all of the state so
> that linked and unlinked
> >           methods are still considered equal."
> >          | numLits |
> >          numLits := self numLiterals.
> >          numLits = aMethod numLiterals ifFalse: [^false].
> >          1 to: numLits do:
> >                  [:i| | lit1 lit2 |
> >                  lit1 := self literalAt: i.
> >                  lit2 := aMethod literalAt: i.
> >                  (lit1 == lit2 or: [lit1 literalEqual: lit2]) ifFalse:
> >                          [(i = 1 and: [#(117 120) includes: self
> primitive])
> >                                  ifTrue:
> >                                          [lit1 isArray
> >                                                  ifTrue:
> >                                                          [(lit2 isArray
> and: [(lit1 first: 2) = (lit2 first: 2)]) ifFalse:
> >
> [^false]]
> >                                                  ifFalse:
> "ExternalLibraryFunction"
> >                                                          [(lit1
> analogousCodeTo: lit2) ifFalse:
> >
> [^false]]]
> >                                  ifFalse:
> >                                          [i = (numLits - 1)
> >                                                  ifTrue: "properties"
> >                                                          [(self
> properties analogousCodeTo: aMethod properties)
> >
> ifFalse: [^false]]
> >                                                  ifFalse: "last literal
> (methodClassAssociation) of class-side methods is not unique"
> >                                                                  "last
> literal of CompiledBlock is outerMethod and may not be unique."
> >                                                          [(self
> isCompiledBlock
> >                                                            and: [lit1
> isCompiledCode
> >                                                            and: [lit2
> isCompiledCode]]) ifTrue:
> >                                                                  [^true].
> >                                                          (i = numLits
> > +                                                         and: [lit1
> isVariableBinding and: [lit1 value isBehavior
> > +                                                         and: [lit2
> isVariableBinding and: [lit2 value isBehavior]]]]) ifFalse:
> > -                                                         and: [lit1
> isVariableBinding
> > -                                                         and: [lit2
> isVariableBinding
> > -                                                         and: [lit1 key
> == lit2 key
> > -                                                         and: [lit1
> value == lit2 value]]]]) ifFalse:
> >
> [^false]]]]].
> >          ^true!
> >
> > Item was changed:
> >   ----- Method: Object>>perform:with:with:with:with:with: (in category
> 'message handling') -----
> >   perform: aSymbol with: firstObject with: secondObject with:
> thirdObject with: fourthObject with: fifthObject
> >          "Send the selector, aSymbol, to the receiver with the given
> arguments.
> > +        Fail if the number of arguments expected by the selector is not
> five.
> > -        Fail if the number of arguments expected by the selector is not
> four.
> >          Primitive. Optional. See Object documentation whatIsAPrimitive."
> >
> >          <primitive: 83>
> >          ^ self perform: aSymbol withArguments: { firstObject.
> secondObject. thirdObject. fourthObject. fifthObject }!
> >
> >
> >
> >
> >
>
>

-- 
_,,,^..^,,,_
best, Eliot
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://lists.squeakfoundation.org/pipermail/squeak-dev/attachments/20200219/dd00ad83/attachment.html>


More information about the Squeak-dev mailing list