Nicolas Cellier uploaded a new version of Collections to project The Trunk:
http://source.squeak.org/trunk/Collections-nice.768.mcz
==================== Summary ====================
Name: Collections-nice.768
Author: nice
Time: 26 November 2017, 10:39:18.783084 pm
UUID: 3431c5cc-a7a1-4317-b07d-24a59bd26bb0
Ancestors: Collections-eem.767, Collections-nice.767
Merge (revised SortFunction + Transcript characterLimit)
=============== Diff against Collections-eem.767 ===============
Item was changed:
SystemOrganization addCategory: #'Collections-Abstract'!
SystemOrganization addCategory: #'Collections-Arrayed'!
SystemOrganization addCategory: #'Collections-Cache'!
SystemOrganization addCategory: #'Collections-Exceptions'!
SystemOrganization addCategory: #'Collections-Heap'!
SystemOrganization addCategory: #'Collections-Sequenceable'!
+ SystemOrganization addCategory: #'Collections-SortFunctions'!
SystemOrganization addCategory: #'Collections-Stack'!
SystemOrganization addCategory: #'Collections-Streams'!
SystemOrganization addCategory: #'Collections-Strings'!
SystemOrganization addCategory: #'Collections-Support'!
SystemOrganization addCategory: #'Collections-Text'!
SystemOrganization addCategory: #'Collections-Unordered'!
SystemOrganization addCategory: #'Collections-Weak'!
Item was changed:
+ ----- Method: BlockClosure>>asSortFunction (in category '*Collections-SortFunctions-converting') -----
- ----- Method: BlockClosure>>asSortFunction (in category '*Collections-Support-sorting') -----
asSortFunction
+ "Return a SortFunction around the receiver. If the receiver is a 2 arg block, it is assumed it will do the collation directly itself, returning -1, 0, or 1. If the receiver is a one arg block, it will be evaluated for each a and b and of the sort input, and the result of sending <=> to those will be used"
+
+ self numArgs = 1 ifTrue: [^PropertySortFunction property: self].
+ self numArgs = 2 ifTrue: [^CollatorBlockFunction usingBlock: self].
+ self error: 'Cant be converted to sort function. It should has one or two args' !
- ^self ascending!
Item was changed:
+ ----- Method: BlockClosure>>ascending (in category '*Collections-SortFunctions-converting') -----
- ----- Method: BlockClosure>>ascending (in category '*Collections-Support-sorting') -----
ascending
"Return a SortFunction around the receiver. If the receiver is a 2 arg block, it is assumed it will do the collation directly itself, returning -1, 0, or 1. If the receiver is a one arg block, it will be evaluated for each a and b and of the sort input, and the result of sending <=> to those will be used."
+ ^self asSortFunction!
- | function |
- function := SortFunction ascend.
- self numArgs = 1 ifTrue: [function monadicBlock: self].
- self numArgs = 2 ifTrue: [function collator: self].
- ^function!
Item was added:
+ ----- Method: BlockClosure>>collatedBy: (in category '*Collections-SortFunctions-converting') -----
+ collatedBy: aSortFunction
+ "Return a SortFunction around the receiver. If the receiver is a 2 arg block, it is assumed it will do the collation directly itself, returning -1, 0, or 1. If the receiver is a one arg block, it will be evaluated for each a and b and of the sort input, and the result of using aSortFunction on those will be used"
+
+ self numArgs = 1 ifTrue: [^PropertySortFunction property: self collatedWith: aSortFunction asSortFunction].
+ self error: 'Cant be converted to sort function. It should hava one arg' !
Item was changed:
+ ----- Method: BlockClosure>>descending (in category '*Collections-SortFunctions-converting') -----
- ----- Method: BlockClosure>>descending (in category '*Collections-Support-sorting') -----
descending
"Opposite direction as ascending."
+ ^self asSortFunction reversed!
- ^self ascending toggleDirection!
Item was changed:
+ ComposedSortFunction subclass: #ChainedSortFunction
+ instanceVariableNames: 'nextFunction'
- SortFunction subclass: #ChainedSortFunction
- instanceVariableNames: 'next'
classVariableNames: ''
poolDictionaries: ''
+ category: 'Collections-SortFunctions'!
- category: 'Collections-Support'!
+ !ChainedSortFunction commentStamp: 'nice 11/7/2017 22:14' prior: 0!
+ I add to my parent the idea of a "next" function to use when two objects are equal by my primary sort function.
- !ChainedSortFunction commentStamp: 'nice 3/13/2014 22:25' prior: 0!
- I add to my parent the idea of a "next" function to use when two objects are equal by my particular collator.
Usage
SortFunctions can be chained together in primary, secondary, tertiary, etc order using the comma method. Consider a sequence of customer objects, where each customer object responds to the messages firstName, lastName, and age. If we want to sort them lastName first, then firstName, and finally oldest first, we would use an expression like:
customers sort: #lastName ascending, #firstName ascending, #age descending
As noted in my super's comment, unary symbols or single arg blocks can be used. One can omit the the ascending methods on arguments (not the receiver), it will default blocks or symbols to be ascending if none is specified. In other words, the above expression could be simplified slightly as
customers sort: #lastName ascending, #firstName, #age descending
(note the missing ascending on the #firstName argument)
Instance Variables
+ baseSortFunction <SortFunction> the primary SortFunction to collate given objects
+ next Function <SortFunction> the next SortFunction to evaluate in the event primary collation results are equal values!
- next <SortFunction> the next SortFunction to evaluate in the event my evaluator results in equal values.
-
- !
Item was added:
+ ----- Method: ChainedSortFunction class>>startWith:then: (in category 'instance creation') -----
+ startWith: aSortFunction then: nextSortFunction
+ ^self new
+ baseSortFunction: aSortFunction;
+ nextFunction: nextSortFunction!
Item was changed:
----- Method: ChainedSortFunction>>, (in category 'converting') -----
, aSortFunction
+ ^self class startWith: baseSortFunction then: nextFunction , aSortFunction!
- self next: next , aSortFunction!
Item was added:
+ ----- Method: ChainedSortFunction>>= (in category 'comparing') -----
+ = anObject
+ "Answer whether the receiver and anObject represent the same object."
+
+ self == anObject
+ ifTrue: [ ^ true ].
+ self class = anObject class
+ ifFalse: [ ^ false ].
+ ^ baseSortFunction = anObject baseSortFunction
+ and: [ nextFunction = anObject nextFunction ]!
Item was added:
+ ----- Method: ChainedSortFunction>>collate:with: (in category 'evaluating') -----
+ collate: anObject1 with: anObject2
+ "If the result of current function is 0, then pass on to the next function to work it out"
+
+ | result |
+ result := baseSortFunction collate: anObject1 with: anObject2.
+ ^result isZero
+ ifTrue: [nextFunction collate: anObject1 with: anObject2.]
+ ifFalse: [result]!
Item was added:
+ ----- Method: ChainedSortFunction>>hash (in category 'comparing') -----
+ hash
+ "Answer an integer value that is related to the identity of the receiver."
+
+ ^ super hash + nextFunction hash!
Item was removed:
- ----- Method: ChainedSortFunction>>next: (in category 'initialize-release') -----
- next: anObject
-
- next := anObject!
Item was added:
+ ----- Method: ChainedSortFunction>>nextFunction (in category 'accessing') -----
+ nextFunction
+ ^nextFunction!
Item was added:
+ ----- Method: ChainedSortFunction>>nextFunction: (in category 'accessing') -----
+ nextFunction: aSortFunction
+ nextFunction := aSortFunction!
Item was removed:
- ----- Method: ChainedSortFunction>>value:value: (in category 'evaluating') -----
- value: anObject value: bObject
- "Refinement of the parent behavior. If the result of my collator is 0, then pass on to the next variable to work it out."
-
- | result |
- result := (collator value: anObject value: bObject) * direction.
- ^result isZero
- ifTrue: [next value: anObject value: bObject]
- ifFalse: [result < 0]!
Item was added:
+ SortFunction subclass: #CollatorBlockFunction
+ instanceVariableNames: 'collatorBlock'
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'Collections-SortFunctions'!
+
+ !CollatorBlockFunction commentStamp: 'nice 11/5/2017 22:57' prior: 0!
+ A CollatorBlockFunction is a special SortFunction using a dyadic block to collate objects.
+
+ Instance Variables
+
+ collator <Block> a dyadic block that must return a -1, 0, or 1.!
Item was added:
+ ----- Method: CollatorBlockFunction class>>usingBlock: (in category 'instance creation') -----
+ usingBlock: twoArgsBlock
+ ^self new
+ collatorBlock: twoArgsBlock!
Item was added:
+ ----- Method: CollatorBlockFunction>>= (in category 'comparing') -----
+ = anObject
+ "Answer whether the receiver and anObject represent the same object."
+
+ self == anObject
+ ifTrue: [ ^ true ].
+ self class = anObject class
+ ifFalse: [ ^ false ].
+ ^collatorBlock = anObject collatorBlock!
Item was added:
+ ----- Method: CollatorBlockFunction>>collate:with: (in category 'evaluating') -----
+ collate: anObject1 with: anObject2
+
+ ^collatorBlock value: anObject1 value: anObject2 !
Item was added:
+ ----- Method: CollatorBlockFunction>>collatorBlock (in category 'accessing') -----
+ collatorBlock
+ ^collatorBlock!
Item was added:
+ ----- Method: CollatorBlockFunction>>collatorBlock: (in category 'accessing') -----
+ collatorBlock: aBlock
+ collatorBlock := aBlock!
Item was added:
+ ----- Method: CollatorBlockFunction>>hash (in category 'comparing') -----
+ hash
+ "Answer an integer value that is related to the identity of the receiver."
+
+ ^ collatorBlock hash!
Item was removed:
- ----- Method: Collection>>median (in category 'math functions') -----
- median
- ^ self asSortedCollection median!
Item was added:
+ SortFunction subclass: #ComposedSortFunction
+ instanceVariableNames: 'baseSortFunction'
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'Collections-SortFunctions'!
+
+ !ComposedSortFunction commentStamp: 'nice 11/7/2017 22:13' prior: 0!
+ A ComposedSortFunction is an abstract class wrapping over another SortFunction for the sake of composition.
+
+ Subclasses have to define the composition behavior via collate:with: message.
+
+ Instances variables:
+ baseSortFunction <SortFunction> the wrapped sort function!
Item was added:
+ ----- Method: ComposedSortFunction class>>on: (in category 'instance creation') -----
+ on: aSortFunction
+ ^self new baseSortFunction: aSortFunction!
Item was added:
+ ----- Method: ComposedSortFunction>>= (in category 'comparing') -----
+ = aSortFunction
+ self == aSortFunction ifTrue: [ ^true ].
+ ^self class = aSortFunction class and: [ baseSortFunction = aSortFunction baseSortFunction ]!
Item was added:
+ ----- Method: ComposedSortFunction>>baseSortFunction (in category 'accessing') -----
+ baseSortFunction
+ ^baseSortFunction!
Item was added:
+ ----- Method: ComposedSortFunction>>baseSortFunction: (in category 'accessing') -----
+ baseSortFunction: aSortFunction
+ baseSortFunction := aSortFunction!
Item was added:
+ ----- Method: ComposedSortFunction>>hash (in category 'comparing') -----
+ hash
+ ^baseSortFunction hash hashMultiply!
Item was added:
+ ----- Method: ComposedSortFunction>>initialize (in category 'initailize-release') -----
+ initialize
+ super initialize.
+ baseSortFunction := self class default!
Item was added:
+ SortFunction subclass: #DefaultSortFunction
+ instanceVariableNames: ''
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'Collections-SortFunctions'!
+
+ !DefaultSortFunction commentStamp: 'nice 11/7/2017 23:43' prior: 0!
+ A DefaultSortFunction is a collator using the default <=> operator.
+ It is known to work on String and Magnitude.
+
+ It is generally not usefull to create a new instance, and the recommended pattern is to use the single instance available by sending the message SortFunction default .
+
+ For other objects that don't understand threeWayCompareTo: it is necessary to use a custom SortFunction rather than the default one.
+ !
Item was added:
+ ----- Method: DefaultSortFunction class>>initialize (in category 'class initialization') -----
+ initialize
+ Default := self new!
Item was added:
+ ----- Method: DefaultSortFunction class>>new (in category 'instance creation') -----
+ new
+ ^UniqueInstance ifNil: [self basicNew initialize]!
Item was added:
+ ----- Method: DefaultSortFunction>>collate:with: (in category 'evaluating') -----
+ collate: anObject with: anotherObject
+ ^anObject <=> anotherObject!
Item was added:
+ ComposedSortFunction subclass: #PropertySortFunction
+ instanceVariableNames: 'property'
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'Collections-SortFunctions'!
+
+ !PropertySortFunction commentStamp: 'nice 11/5/2017 22:36' prior: 0!
+ A PropertySortFunction is a SortFunction for sorting by a specific property.
+
+ Instance Variables
+ collator <SortFunction> the SortFunction to be used for sorting the properties
+ property <Symbol | Block> a valuable returning the value of property for objects to be sorted!
Item was added:
+ ----- Method: PropertySortFunction class>>property: (in category 'instance creation') -----
+ property: selectorOrOneArgBlock
+ ^self new
+ property: selectorOrOneArgBlock!
Item was added:
+ ----- Method: PropertySortFunction class>>property:collatedWith: (in category 'instance creation') -----
+ property: selectorOrOneArgBlock collatedWith: aSortFunction
+ ^self new
+ property: selectorOrOneArgBlock;
+ baseSortFunction: aSortFunction!
Item was added:
+ ----- Method: PropertySortFunction>>= (in category 'comparing') -----
+ = anObject
+ "Answer whether the receiver and anObject represent the same object."
+
+ self == anObject
+ ifTrue: [ ^ true ].
+ self class = anObject class
+ ifFalse: [ ^ false ].
+ ^ baseSortFunction = anObject baseSortFunction
+ and: [ property = anObject property ]!
Item was added:
+ ----- Method: PropertySortFunction>>collate:with: (in category 'evaluating') -----
+ collate: anObject with: another
+ "Answer the collation order of anObject and another based on the property."
+ ^ baseSortFunction collate: (property value: anObject) with: (property value: another)!
Item was added:
+ ----- Method: PropertySortFunction>>hash (in category 'comparing') -----
+ hash
+ "Answer an integer value that is related to the identity of the receiver."
+
+ ^ super hash bitXor: property hash!
Item was added:
+ ----- Method: PropertySortFunction>>property (in category 'accessing') -----
+ property
+ ^ property!
Item was added:
+ ----- Method: PropertySortFunction>>property: (in category 'accessing') -----
+ property: aValuable
+ property := aValuable!
Item was added:
+ ----- Method: PropertySortFunction>>undefinedFirst (in category 'converting') -----
+ undefinedFirst
+ "apply on the property"
+ ^self class
+ property: property
+ collatedWith: baseSortFunction undefinedFirst!
Item was added:
+ ----- Method: PropertySortFunction>>undefinedLast (in category 'converting') -----
+ undefinedLast
+ "apply on the property"
+ ^self class
+ property: property
+ collatedWith: baseSortFunction undefinedLast!
Item was added:
+ ComposedSortFunction subclass: #ReverseSortFunction
+ instanceVariableNames: ''
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'Collections-SortFunctions'!
+
+ !ReverseSortFunction commentStamp: 'nice 11/6/2017 21:54' prior: 0!
+ A ReverseSortFunction wraps over another SortFunction so as to sort in reverse order.!
Item was added:
+ ----- Method: ReverseSortFunction>>collate:with: (in category 'evaluating') -----
+ collate: anObject with: another
+ ^(baseSortFunction collate: anObject with: another) negated!
Item was added:
+ ----- Method: ReverseSortFunction>>reversed (in category 'converting') -----
+ reversed
+ ^baseSortFunction!
Item was added:
+ ----- Method: ReverseSortFunction>>toggleDirection (in category 'converting') -----
+ toggleDirection
+ ^collator!
Item was added:
+ ----- Method: ReverseSortFunction>>undefinedFirst (in category 'converting') -----
+ undefinedFirst
+ "apply on the original"
+ ^baseSortFunction undefinedLast reversed!
Item was added:
+ ----- Method: ReverseSortFunction>>undefinedLast (in category 'converting') -----
+ undefinedLast
+ "apply on the original"
+ ^baseSortFunction undefinedFirst reversed!
Item was changed:
Object subclass: #SortFunction
+ instanceVariableNames: ''
+ classVariableNames: 'Default'
- instanceVariableNames: 'direction collator'
- classVariableNames: ''
poolDictionaries: ''
+ category: 'Collections-SortFunctions'!
- category: 'Collections-Support'!
+ !SortFunction commentStamp: 'nice 11/5/2017 22:52' prior: 0!
- !SortFunction commentStamp: 'nice 3/13/2014 22:24' prior: 0!
I am intended to be used in place of two arg sort blocks.
Usage
In the following example, an ascending SortFunction is created based on the result of the #first message send to each object.
#(#(1 2) #(2 3) #(0 0)) sorted: #first ascending.
To sort by the #last element, but descending, the following would be used:
#(#(1 2) #(2 3) #(0 0)) sorted: #last descending.
One can use blocks as well. The following sorts in descending order, the sub elements based on the sum of their values.
| sumBlock |
sumBlock := [:sequence | sequence inject: 0 into: [:sum :each | sum + each]].
#(#(1 2) #(2 3) #(0 0)) sorted: sumBlock descending.
One can even use 2 arg blocks, for those cases where the function isn't expressible with objects that respond to < and =. The only catch, is that such a function has to return not true and false, but instead a collation order, values of -1 (for before), 0 (the same) or 1 (to follow). For example:
| oddBlock |
oddBlock :=
[:a :b |
a odd = b odd ifTrue: [0] ifFalse: [a odd ifTrue: [-1] ifFalse: [1]]].
#(1 5 1 3 2 7 9 4 6) asSortedCollection: oddBlock descending
Instance Variables
+ collator <SortFunction> This is the object responsible for collating objetcs, generally a SortFunction.
- collator <BlockClosure> This is the collation function that must return a -1, 0, or 1. It is usually composed by an initialization method such as sendMessage: or monadicBlock:, but may be set directly.
- direction <SmallInteger> 1 for ascending, -1 for descending
!
Item was removed:
- ----- Method: SortFunction class>>ascend (in category 'instance creation') -----
- ascend
-
- ^self new ascend!
Item was added:
+ ----- Method: SortFunction class>>default (in category 'accessing') -----
+ default
+ ^Default!
Item was removed:
- ----- Method: SortFunction class>>descend (in category 'instance creation') -----
- descend
-
- ^self new descend!
Item was changed:
----- Method: SortFunction>>, (in category 'converting') -----
, aSortFunction
"Return a new SortFunction which is the concatenation of aSortFunction to me, I will be the primary sort, but if I compare equal, I will defer to the argument."
+ ^ChainedSortFunction startWith: self then: aSortFunction asSortFunction!
- ^(ChainedSortFunction new)
- collator: collator;
- direction: direction;
- next: aSortFunction asSortFunction!
Item was removed:
- ----- Method: SortFunction>>ascend (in category 'initailize-release') -----
- ascend
-
- direction := 1!
Item was added:
+ ----- Method: SortFunction>>collate:with: (in category 'evaluating') -----
+ collate: value1 with: value2
+ "answer the collation order for the two values -1,0 or 1"
+
+ ^self subclassResponsibility!
Item was removed:
- ----- Method: SortFunction>>collator: (in category 'initailize-release') -----
- collator: a2ArgBlock
- "a2ArgBlock MUST return the collation order, -1, 0, or 1"
-
- collator := a2ArgBlock!
Item was removed:
- ----- Method: SortFunction>>descend (in category 'initailize-release') -----
- descend
-
- direction := -1!
Item was removed:
- ----- Method: SortFunction>>direction: (in category 'initailize-release') -----
- direction: anInteger
-
- direction := anInteger!
Item was removed:
- ----- Method: SortFunction>>isAscending (in category 'testing') -----
- isAscending
-
- ^direction = 1!
Item was removed:
- ----- Method: SortFunction>>isDescending (in category 'testing') -----
- isDescending
-
- ^direction = -1!
Item was removed:
- ----- Method: SortFunction>>monadicBlock: (in category 'initailize-release') -----
- monadicBlock: aSingleArgBlock
- "Initialze the receiver's collation block to compare the results of evaluating aSingleArgBlock with each argument, and then collate the return values with the <=> method."
-
- collator := [:a :b | (aSingleArgBlock value: a) <=> (aSingleArgBlock value: b)]!
Item was added:
+ ----- Method: SortFunction>>reversed (in category 'converting') -----
+ reversed
+ "Return new sort function with reverse sort order."
+
+ ^ReverseSortFunction on: self!
Item was removed:
- ----- Method: SortFunction>>sendMessage: (in category 'initailize-release') -----
- sendMessage: aUnarySymbol
- "Initialze the receiver's collation block to compare the results of sending aUnarySymbol to each argument, and then collate them with the <=> method."
-
- collator := [:a :b | (a perform: aUnarySymbol) <=> (b perform: aUnarySymbol)]!
Item was removed:
- ----- Method: SortFunction>>toggleDirection (in category 'converting') -----
- toggleDirection
- "Invert my current direction, if I'm currently ascending, this will cause me to be descending now, and vice-versa."
-
- direction := direction * -1!
Item was added:
+ ----- Method: SortFunction>>undefinedFirst (in category 'converting') -----
+ undefinedFirst
+ "Return a new SortFunction that sort all the nil first, an non nil with myself."
+ ^(UndefinedSortFunction on: self) undefinedFirst!
Item was added:
+ ----- Method: SortFunction>>undefinedLast (in category 'converting') -----
+ undefinedLast
+ "Return a new SortFunction that sort all the nil last, an non nil with myself."
+ ^(UndefinedSortFunction on: self) undefinedLast!
Item was changed:
----- Method: SortFunction>>value:value: (in category 'evaluating') -----
value: anObject value: bObject
"Masquerade as a two argument block, used by many of the sorting APIs, by returning whether anObject should be placed before bObject or not."
| result |
+ result := (self collate: anObject with: bObject).
- result := (collator value: anObject value: bObject) * direction.
^result <= 0!
Item was changed:
+ ----- Method: Symbol>>asSortFunction (in category '*Collections-SortFunctions-converting') -----
- ----- Method: Symbol>>asSortFunction (in category 'sorting') -----
asSortFunction
+ "Return a SortFunction around the receiver, where the receiver will be used as a unary message to send to both a and b during sorting, and then the result of said send will be collated in ascending order using the <=> method."
+ "#('abc' 'de' 'fghi') sorted: #size ascending >>> #('de' 'abc' 'fghi')"
+ ^PropertySortFunction property: self!
- ^self ascending!
Item was changed:
+ ----- Method: Symbol>>ascending (in category '*Collections-SortFunctions-converting') -----
- ----- Method: Symbol>>ascending (in category 'sorting') -----
ascending
"Return a SortFunction around the receiver, where the receiver will be used as a unary message to send to both a and b during sorting, and then the result of said send will be collated in ascending order using the <=> method."
+ "#('abc' 'de' 'fghi') sorted: #size ascending >>> #('de' 'abc' 'fghi')"
- "Example: #('abc' 'de' 'fghi') sorted: #size asscending"
+ ^self asSortFunction !
- ^SortFunction ascend sendMessage: self!
Item was added:
+ ----- Method: Symbol>>collatedBy: (in category '*Collections-SortFunctions-converting') -----
+ collatedBy: aSortFunction
+ "Return a SortFunction around the receiver, where the receiver will be used as a unary message to send to both a and b during sorting, and then the result of said send will be collated iusing aSortFunction."
+ "#('abc' 'de' 'fghi') sorted: (#size collatedWith: [:e|e bitAnd: 1]) , #size >>> #( 'de' 'fghi' 'abc')"
+
+ ^PropertySortFunction property: self collatedWith: aSortFunction asSortFunction!
Item was changed:
+ ----- Method: Symbol>>descending (in category '*Collections-SortFunctions-converting') -----
- ----- Method: Symbol>>descending (in category 'sorting') -----
descending
"Return a SortFunction around the receiver, where the receiver will be used as a unary message to send to both a and b during sorting, and then the result of said send will be collated in descending order using the <=> method."
+ "#('abc' 'de' 'fghi') sorted: #size ascending >>> #('fghi' 'abc' 'de')"
- "Example: #('abc' 'de' 'fghi') sorted: #size descending"
+ ^self asSortFunction reversed!
- ^SortFunction descend sendMessage: self!
Item was added:
+ ComposedSortFunction subclass: #UndefinedSortFunction
+ instanceVariableNames: 'direction'
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'Collections-SortFunctions'!
+
+ !UndefinedSortFunction commentStamp: 'nice 11/7/2017 22:16' prior: 0!
+ An UndefinedSortFunction is a specialization usefull for sorting undefined objects (nil), either first or last according to direction.
+ The non nil objects are sorted according to the baseSortFunction defined in superclass.
+
+ instance variables:
+ direction <Integer> -1 for sorting nil first, 1 for sorting nil last!
Item was added:
+ ----- Method: UndefinedSortFunction>>= (in category 'comparing') -----
+ = anObject
+ "Answer whether the receiver and anObject represent the same object."
+
+ self == anObject
+ ifTrue: [ ^ true ].
+ self class = anObject class
+ ifFalse: [ ^ false ].
+ ^ baseSortFunction = anObject baseSortFunction
+ and: [ direction = anObject direction ]!
Item was added:
+ ----- Method: UndefinedSortFunction>>collate:with: (in category 'evaluating') -----
+ collate: anObject with: another
+ "Answer the collation order of anObject and another, with nil first or last according to direction"
+ anObject ifNil: [^another ifNil: [0] ifNotNil: [direction]].
+ another ifNil: [^direction negated].
+ ^baseSortFunction collate: anObject with: another!
Item was added:
+ ----- Method: UndefinedSortFunction>>direction (in category 'accessing') -----
+ direction
+ ^direction!
Item was added:
+ ----- Method: UndefinedSortFunction>>hash (in category 'comparing') -----
+ hash
+ "Answer an integer value that is related to the identity of the receiver."
+
+ ^ super hash bitXor: direction hash!
Item was added:
+ ----- Method: UndefinedSortFunction>>initialize (in category 'initailize-release') -----
+ initialize
+ super initialize.
+ direction := -1!
Item was added:
+ ----- Method: UndefinedSortFunction>>undefinedFirst (in category 'initailize-release') -----
+ undefinedFirst
+ direction := -1!
Item was added:
+ ----- Method: UndefinedSortFunction>>undefinedLast (in category 'initailize-release') -----
+ undefinedLast
+ direction := 1!
Nicolas Cellier uploaded a new version of Collections to project The Trunk:
http://source.squeak.org/trunk/Collections-nice.767.mcz
==================== Summary ====================
Name: Collections-nice.767
Author: nice
Time: 8 November 2017, 12:46:38.73749 am
UUID: a3d23745-3d89-423e-9f25-a4d2dbf9864c
Ancestors: Collections-nice.766
Continue SortFunction refactoring
=============== Diff against Collections-nice.766 ===============
Item was changed:
SystemOrganization addCategory: #'Collections-Abstract'!
SystemOrganization addCategory: #'Collections-Arrayed'!
SystemOrganization addCategory: #'Collections-Cache'!
SystemOrganization addCategory: #'Collections-Exceptions'!
SystemOrganization addCategory: #'Collections-Heap'!
SystemOrganization addCategory: #'Collections-Sequenceable'!
+ SystemOrganization addCategory: #'Collections-SortFunctions'!
SystemOrganization addCategory: #'Collections-Stack'!
SystemOrganization addCategory: #'Collections-Streams'!
SystemOrganization addCategory: #'Collections-Strings'!
SystemOrganization addCategory: #'Collections-Support'!
SystemOrganization addCategory: #'Collections-Text'!
SystemOrganization addCategory: #'Collections-Unordered'!
SystemOrganization addCategory: #'Collections-Weak'!
Item was changed:
+ ----- Method: BlockClosure>>asSortFunction (in category '*Collections-SortFunctions-converting') -----
- ----- Method: BlockClosure>>asSortFunction (in category '*Collections-Support-sorting') -----
asSortFunction
+ "Return a SortFunction around the receiver. If the receiver is a 2 arg block, it is assumed it will do the collation directly itself, returning -1, 0, or 1. If the receiver is a one arg block, it will be evaluated for each a and b and of the sort input, and the result of sending <=> to those will be used"
+
+ self numArgs = 1 ifTrue: [^PropertySortFunction property: self].
+ self numArgs = 2 ifTrue: [^CollatorBlockFunction usingBlock: self].
+ self error: 'Cant be converted to sort function. It should has one or two args' !
- ^self ascending!
Item was changed:
+ ----- Method: BlockClosure>>ascending (in category '*Collections-SortFunctions-converting') -----
- ----- Method: BlockClosure>>ascending (in category '*Collections-Support-sorting') -----
ascending
"Return a SortFunction around the receiver. If the receiver is a 2 arg block, it is assumed it will do the collation directly itself, returning -1, 0, or 1. If the receiver is a one arg block, it will be evaluated for each a and b and of the sort input, and the result of sending <=> to those will be used."
+ ^self asSortFunction!
- self numArgs = 1 ifTrue: [^PropertySortFunction property: self].
- self numArgs = 2 ifTrue: [^CollatorBlockFunction new collator: self].
- self error: 'a block for sorting should have 1 or 2 parameters'!
Item was added:
+ ----- Method: BlockClosure>>collatedBy: (in category '*Collections-SortFunctions-converting') -----
+ collatedBy: aSortFunction
+ "Return a SortFunction around the receiver. If the receiver is a 2 arg block, it is assumed it will do the collation directly itself, returning -1, 0, or 1. If the receiver is a one arg block, it will be evaluated for each a and b and of the sort input, and the result of using aSortFunction on those will be used"
+
+ self numArgs = 1 ifTrue: [^PropertySortFunction property: self collatedWith: aSortFunction asSortFunction].
+ self error: 'Cant be converted to sort function. It should hava one arg' !
Item was changed:
+ ----- Method: BlockClosure>>descending (in category '*Collections-SortFunctions-converting') -----
- ----- Method: BlockClosure>>descending (in category '*Collections-Support-sorting') -----
descending
"Opposite direction as ascending."
+ ^self asSortFunction reversed!
- ^self ascending toggleDirection!
Item was removed:
- ----- Method: BlockClosure>>sortedWith: (in category '*Collections-Support-sorting') -----
- sortedWith: aSortFunction
- "Return a SortFunction around the receiver.
- The receiver is a one arg block.
- It will be evaluated for each a and b and of the sort input, and answer the result of collating those with aSortFunction."
-
- self numArgs = 1 ifTrue: [^PropertySortFunction property: self sortedWith: aSortFunction asSortFunction].
- self error: 'a block for sorting should have 1 or 2 parameters'!
Item was changed:
+ ComposedSortFunction subclass: #ChainedSortFunction
+ instanceVariableNames: 'nextFunction'
- SortFunction subclass: #ChainedSortFunction
- instanceVariableNames: 'next'
classVariableNames: ''
poolDictionaries: ''
+ category: 'Collections-SortFunctions'!
- category: 'Collections-Support'!
+ !ChainedSortFunction commentStamp: 'nice 11/7/2017 22:14' prior: 0!
+ I add to my parent the idea of a "next" function to use when two objects are equal by my primary sort function.
- !ChainedSortFunction commentStamp: 'nice 11/5/2017 22:35' prior: 0!
- I add to my parent the idea of a "next" function to use when two objects are equal by my particular collator.
Usage
SortFunctions can be chained together in primary, secondary, tertiary, etc order using the comma method. Consider a sequence of customer objects, where each customer object responds to the messages firstName, lastName, and age. If we want to sort them lastName first, then firstName, and finally oldest first, we would use an expression like:
customers sort: #lastName ascending, #firstName ascending, #age descending
As noted in my super's comment, unary symbols or single arg blocks can be used. One can omit the the ascending methods on arguments (not the receiver), it will default blocks or symbols to be ascending if none is specified. In other words, the above expression could be simplified slightly as
customers sort: #lastName ascending, #firstName, #age descending
(note the missing ascending on the #firstName argument)
Instance Variables
+ baseSortFunction <SortFunction> the primary SortFunction to collate given objects
+ next Function <SortFunction> the next SortFunction to evaluate in the event primary collation results are equal values!
- collator <SortFunction> the first SortFunction.
- next <SortFunction> the next SortFunction to evaluate in the event the first results in equal values.
-
- !
Item was added:
+ ----- Method: ChainedSortFunction class>>startWith:then: (in category 'instance creation') -----
+ startWith: aSortFunction then: nextSortFunction
+ ^self new
+ baseSortFunction: aSortFunction;
+ nextFunction: nextSortFunction!
Item was changed:
----- Method: ChainedSortFunction>>, (in category 'converting') -----
, aSortFunction
+ ^self class startWith: baseSortFunction then: nextFunction , aSortFunction!
- ^self copy next: next , aSortFunction!
Item was added:
+ ----- Method: ChainedSortFunction>>= (in category 'comparing') -----
+ = anObject
+ "Answer whether the receiver and anObject represent the same object."
+
+ self == anObject
+ ifTrue: [ ^ true ].
+ self class = anObject class
+ ifFalse: [ ^ false ].
+ ^ baseSortFunction = anObject baseSortFunction
+ and: [ nextFunction = anObject nextFunction ]!
Item was changed:
----- Method: ChainedSortFunction>>collate:with: (in category 'evaluating') -----
+ collate: anObject1 with: anObject2
+ "If the result of current function is 0, then pass on to the next function to work it out"
- collate: anObject with: bObject
- "Refinement of the parent behavior. If the result of my collator is 0, then pass on to the next variable to work it out."
| result |
+ result := baseSortFunction collate: anObject1 with: anObject2.
- result := (collator collate: anObject with: bObject).
^result isZero
+ ifTrue: [nextFunction collate: anObject1 with: anObject2.]
- ifTrue: [next collate: anObject with: bObject]
ifFalse: [result]!
Item was added:
+ ----- Method: ChainedSortFunction>>hash (in category 'comparing') -----
+ hash
+ "Answer an integer value that is related to the identity of the receiver."
+
+ ^ super hash + nextFunction hash!
Item was removed:
- ----- Method: ChainedSortFunction>>next: (in category 'initialize-release') -----
- next: anObject
-
- next := anObject!
Item was added:
+ ----- Method: ChainedSortFunction>>nextFunction (in category 'accessing') -----
+ nextFunction
+ ^nextFunction!
Item was added:
+ ----- Method: ChainedSortFunction>>nextFunction: (in category 'accessing') -----
+ nextFunction: aSortFunction
+ nextFunction := aSortFunction!
Item was changed:
SortFunction subclass: #CollatorBlockFunction
+ instanceVariableNames: 'collatorBlock'
- instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
+ category: 'Collections-SortFunctions'!
- category: 'Collections-Support'!
!CollatorBlockFunction commentStamp: 'nice 11/5/2017 22:57' prior: 0!
A CollatorBlockFunction is a special SortFunction using a dyadic block to collate objects.
Instance Variables
collator <Block> a dyadic block that must return a -1, 0, or 1.!
Item was added:
+ ----- Method: CollatorBlockFunction class>>usingBlock: (in category 'instance creation') -----
+ usingBlock: twoArgsBlock
+ ^self new
+ collatorBlock: twoArgsBlock!
Item was added:
+ ----- Method: CollatorBlockFunction>>= (in category 'comparing') -----
+ = anObject
+ "Answer whether the receiver and anObject represent the same object."
+
+ self == anObject
+ ifTrue: [ ^ true ].
+ self class = anObject class
+ ifFalse: [ ^ false ].
+ ^collatorBlock = anObject collatorBlock!
Item was changed:
----- Method: CollatorBlockFunction>>collate:with: (in category 'evaluating') -----
+ collate: anObject1 with: anObject2
+
+ ^collatorBlock value: anObject1 value: anObject2 !
- collate: value1 with: value2
- ^collator value: value1 value: value2!
Item was added:
+ ----- Method: CollatorBlockFunction>>collatorBlock (in category 'accessing') -----
+ collatorBlock
+ ^collatorBlock!
Item was added:
+ ----- Method: CollatorBlockFunction>>collatorBlock: (in category 'accessing') -----
+ collatorBlock: aBlock
+ collatorBlock := aBlock!
Item was added:
+ ----- Method: CollatorBlockFunction>>hash (in category 'comparing') -----
+ hash
+ "Answer an integer value that is related to the identity of the receiver."
+
+ ^ collatorBlock hash!
Item was added:
+ SortFunction subclass: #ComposedSortFunction
+ instanceVariableNames: 'baseSortFunction'
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'Collections-SortFunctions'!
+
+ !ComposedSortFunction commentStamp: 'nice 11/7/2017 22:13' prior: 0!
+ A ComposedSortFunction is an abstract class wrapping over another SortFunction for the sake of composition.
+
+ Subclasses have to define the composition behavior via collate:with: message.
+
+ Instances variables:
+ baseSortFunction <SortFunction> the wrapped sort function!
Item was added:
+ ----- Method: ComposedSortFunction class>>on: (in category 'instance creation') -----
+ on: aSortFunction
+ ^self new baseSortFunction: aSortFunction!
Item was added:
+ ----- Method: ComposedSortFunction>>= (in category 'comparing') -----
+ = aSortFunction
+ self == aSortFunction ifTrue: [ ^true ].
+ ^self class = aSortFunction class and: [ baseSortFunction = aSortFunction baseSortFunction ]!
Item was added:
+ ----- Method: ComposedSortFunction>>baseSortFunction (in category 'accessing') -----
+ baseSortFunction
+ ^baseSortFunction!
Item was added:
+ ----- Method: ComposedSortFunction>>baseSortFunction: (in category 'accessing') -----
+ baseSortFunction: aSortFunction
+ baseSortFunction := aSortFunction!
Item was added:
+ ----- Method: ComposedSortFunction>>hash (in category 'comparing') -----
+ hash
+ ^baseSortFunction hash hashMultiply!
Item was added:
+ ----- Method: ComposedSortFunction>>initialize (in category 'initailize-release') -----
+ initialize
+ super initialize.
+ baseSortFunction := self class default!
Item was changed:
SortFunction subclass: #DefaultSortFunction
instanceVariableNames: ''
+ classVariableNames: ''
- classVariableNames: 'UniqueInstance'
poolDictionaries: ''
+ category: 'Collections-SortFunctions'!
- category: 'Collections-Support'!
+ !DefaultSortFunction commentStamp: 'nice 11/7/2017 23:43' prior: 0!
- !DefaultSortFunction commentStamp: 'nice 11/5/2017 21:45' prior: 0!
A DefaultSortFunction is a collator using the default <=> operator.
It is known to work on String and Magnitude.
+ It is generally not usefull to create a new instance, and the recommended pattern is to use the single instance available by sending the message SortFunction default .
+
+ For other objects that don't understand threeWayCompareTo: it is necessary to use a custom SortFunction rather than the default one.
!
Item was added:
+ ----- Method: DefaultSortFunction class>>initialize (in category 'class initialization') -----
+ initialize
+ Default := self new!
Item was changed:
----- Method: DefaultSortFunction>>collate:with: (in category 'evaluating') -----
+ collate: anObject with: anotherObject
+ ^anObject <=> anotherObject!
- collate: value1 with: value2
- ^value1 <=> value2!
Item was removed:
- ----- Method: DefaultSortFunction>>initialize (in category 'initailize-release') -----
- initialize
- collator := #<=>!
Item was changed:
+ ComposedSortFunction subclass: #PropertySortFunction
- SortFunction subclass: #PropertySortFunction
instanceVariableNames: 'property'
classVariableNames: ''
poolDictionaries: ''
+ category: 'Collections-SortFunctions'!
- category: 'Collections-Support'!
!PropertySortFunction commentStamp: 'nice 11/5/2017 22:36' prior: 0!
A PropertySortFunction is a SortFunction for sorting by a specific property.
Instance Variables
collator <SortFunction> the SortFunction to be used for sorting the properties
property <Symbol | Block> a valuable returning the value of property for objects to be sorted!
Item was changed:
----- Method: PropertySortFunction class>>property: (in category 'instance creation') -----
+ property: selectorOrOneArgBlock
+ ^self new
+ property: selectorOrOneArgBlock!
- property: aValuable
- ^self new property: aValuable!
Item was added:
+ ----- Method: PropertySortFunction class>>property:collatedWith: (in category 'instance creation') -----
+ property: selectorOrOneArgBlock collatedWith: aSortFunction
+ ^self new
+ property: selectorOrOneArgBlock;
+ baseSortFunction: aSortFunction!
Item was removed:
- ----- Method: PropertySortFunction class>>property:sortedWith: (in category 'instance creation') -----
- property: aValuable sortedWith: aSortFunction
- ^self new property: aValuable; collator: aSortFunction!
Item was added:
+ ----- Method: PropertySortFunction>>= (in category 'comparing') -----
+ = anObject
+ "Answer whether the receiver and anObject represent the same object."
+
+ self == anObject
+ ifTrue: [ ^ true ].
+ self class = anObject class
+ ifFalse: [ ^ false ].
+ ^ baseSortFunction = anObject baseSortFunction
+ and: [ property = anObject property ]!
Item was changed:
----- Method: PropertySortFunction>>collate:with: (in category 'evaluating') -----
+ collate: anObject with: another
+ "Answer the collation order of anObject and another based on the property."
+ ^ baseSortFunction collate: (property value: anObject) with: (property value: another)!
- collate: value1 with: value2
- ^collator collate: (property value: value1) with: (property value: value2)!
Item was added:
+ ----- Method: PropertySortFunction>>hash (in category 'comparing') -----
+ hash
+ "Answer an integer value that is related to the identity of the receiver."
+
+ ^ super hash bitXor: property hash!
Item was added:
+ ----- Method: PropertySortFunction>>property (in category 'accessing') -----
+ property
+ ^ property!
Item was changed:
+ ----- Method: PropertySortFunction>>property: (in category 'accessing') -----
- ----- Method: PropertySortFunction>>property: (in category 'initailize-release') -----
property: aValuable
property := aValuable!
Item was changed:
----- Method: PropertySortFunction>>undefinedFirst (in category 'converting') -----
undefinedFirst
"apply on the property"
^self class
property: property
+ collatedWith: baseSortFunction undefinedFirst!
- sortedWith: (UndefinedSortFunction new collator: collator) undefinedFirst!
Item was changed:
----- Method: PropertySortFunction>>undefinedLast (in category 'converting') -----
undefinedLast
"apply on the property"
^self class
property: property
+ collatedWith: baseSortFunction undefinedLast!
- sortedWith: (UndefinedSortFunction new collator: collator) undefinedLast!
Item was changed:
+ ComposedSortFunction subclass: #ReverseSortFunction
- SortFunction subclass: #ReverseSortFunction
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
+ category: 'Collections-SortFunctions'!
- category: 'Collections-Support'!
+ !ReverseSortFunction commentStamp: 'nice 11/6/2017 21:54' prior: 0!
+ A ReverseSortFunction wraps over another SortFunction so as to sort in reverse order.!
- !ReverseSortFunction commentStamp: 'nice 11/5/2017 22:40' prior: 0!
- A ReverseSortFunction is reversing the order of original sortFunction
-
- Instance Variables
- collator <SortFunction> the original SortFunction.
- !
Item was changed:
----- Method: ReverseSortFunction>>collate:with: (in category 'evaluating') -----
+ collate: anObject with: another
+ ^(baseSortFunction collate: anObject with: another) negated!
- collate: value1 with: value2
- ^(collator collate: value1 with: value2) negated!
Item was added:
+ ----- Method: ReverseSortFunction>>reversed (in category 'converting') -----
+ reversed
+ ^baseSortFunction!
Item was changed:
----- Method: ReverseSortFunction>>undefinedFirst (in category 'converting') -----
undefinedFirst
"apply on the original"
+ ^baseSortFunction undefinedLast reversed!
- ^collator undefinedFirst toggleDirection!
Item was changed:
----- Method: ReverseSortFunction>>undefinedLast (in category 'converting') -----
undefinedLast
"apply on the original"
+ ^baseSortFunction undefinedFirst reversed!
- ^collator undefinedLast toggleDirection!
Item was changed:
Object subclass: #SortFunction
+ instanceVariableNames: ''
+ classVariableNames: 'Default'
- instanceVariableNames: 'collator'
- classVariableNames: ''
poolDictionaries: ''
+ category: 'Collections-SortFunctions'!
- category: 'Collections-Support'!
!SortFunction commentStamp: 'nice 11/5/2017 22:52' prior: 0!
I am intended to be used in place of two arg sort blocks.
Usage
In the following example, an ascending SortFunction is created based on the result of the #first message send to each object.
#(#(1 2) #(2 3) #(0 0)) sorted: #first ascending.
To sort by the #last element, but descending, the following would be used:
#(#(1 2) #(2 3) #(0 0)) sorted: #last descending.
One can use blocks as well. The following sorts in descending order, the sub elements based on the sum of their values.
| sumBlock |
sumBlock := [:sequence | sequence inject: 0 into: [:sum :each | sum + each]].
#(#(1 2) #(2 3) #(0 0)) sorted: sumBlock descending.
One can even use 2 arg blocks, for those cases where the function isn't expressible with objects that respond to < and =. The only catch, is that such a function has to return not true and false, but instead a collation order, values of -1 (for before), 0 (the same) or 1 (to follow). For example:
| oddBlock |
oddBlock :=
[:a :b |
a odd = b odd ifTrue: [0] ifFalse: [a odd ifTrue: [-1] ifFalse: [1]]].
#(1 5 1 3 2 7 9 4 6) asSortedCollection: oddBlock descending
Instance Variables
collator <SortFunction> This is the object responsible for collating objetcs, generally a SortFunction.
!
Item was added:
+ ----- Method: SortFunction class>>default (in category 'accessing') -----
+ default
+ ^Default!
Item was changed:
----- Method: SortFunction>>, (in category 'converting') -----
, aSortFunction
"Return a new SortFunction which is the concatenation of aSortFunction to me, I will be the primary sort, but if I compare equal, I will defer to the argument."
+ ^ChainedSortFunction startWith: self then: aSortFunction asSortFunction!
- ^(ChainedSortFunction new)
- collator: self;
- next: aSortFunction asSortFunction!
Item was removed:
- ----- Method: SortFunction>>collator: (in category 'initailize-release') -----
- collator: aSortFunction
- "Used by subclasses for composition."
-
- collator := aSortFunction!
Item was removed:
- ----- Method: SortFunction>>initialize (in category 'initailize-release') -----
- initialize
- "set the default collator"
-
- collator := DefaultSortFunction new!
Item was added:
+ ----- Method: SortFunction>>reversed (in category 'converting') -----
+ reversed
+ "Return new sort function with reverse sort order."
+
+ ^ReverseSortFunction on: self!
Item was removed:
- ----- Method: SortFunction>>toggleDirection (in category 'converting') -----
- toggleDirection
- ^ReverseSortFunction new collator: self!
Item was changed:
----- Method: SortFunction>>undefinedFirst (in category 'converting') -----
undefinedFirst
+ "Return a new SortFunction that sort all the nil first, an non nil with myself."
+ ^(UndefinedSortFunction on: self) undefinedFirst!
- ^(UndefinedSortFunction new collator: self) undefinedFirst!
Item was changed:
----- Method: SortFunction>>undefinedLast (in category 'converting') -----
undefinedLast
+ "Return a new SortFunction that sort all the nil last, an non nil with myself."
+ ^(UndefinedSortFunction on: self) undefinedLast!
- ^(UndefinedSortFunction new collator: self) undefinedLast!
Item was changed:
+ ----- Method: Symbol>>asSortFunction (in category '*Collections-SortFunctions-converting') -----
- ----- Method: Symbol>>asSortFunction (in category 'sorting') -----
asSortFunction
+ "Return a SortFunction around the receiver, where the receiver will be used as a unary message to send to both a and b during sorting, and then the result of said send will be collated in ascending order using the <=> method."
+ "#('abc' 'de' 'fghi') sorted: #size ascending >>> #('de' 'abc' 'fghi')"
+ ^PropertySortFunction property: self!
- ^self ascending!
Item was changed:
+ ----- Method: Symbol>>ascending (in category '*Collections-SortFunctions-converting') -----
- ----- Method: Symbol>>ascending (in category 'sorting') -----
ascending
"Return a SortFunction around the receiver, where the receiver will be used as a unary message to send to both a and b during sorting, and then the result of said send will be collated in ascending order using the <=> method."
+ "#('abc' 'de' 'fghi') sorted: #size ascending >>> #('de' 'abc' 'fghi')"
- "Example: #('abc' 'de' 'fghi') sorted: #size asscending"
+ ^self asSortFunction !
- ^PropertySortFunction property: self!
Item was added:
+ ----- Method: Symbol>>collatedBy: (in category '*Collections-SortFunctions-converting') -----
+ collatedBy: aSortFunction
+ "Return a SortFunction around the receiver, where the receiver will be used as a unary message to send to both a and b during sorting, and then the result of said send will be collated iusing aSortFunction."
+ "#('abc' 'de' 'fghi') sorted: (#size collatedWith: [:e|e bitAnd: 1]) , #size >>> #( 'de' 'fghi' 'abc')"
+
+ ^PropertySortFunction property: self collatedWith: aSortFunction asSortFunction!
Item was changed:
+ ----- Method: Symbol>>descending (in category '*Collections-SortFunctions-converting') -----
- ----- Method: Symbol>>descending (in category 'sorting') -----
descending
"Return a SortFunction around the receiver, where the receiver will be used as a unary message to send to both a and b during sorting, and then the result of said send will be collated in descending order using the <=> method."
+ "#('abc' 'de' 'fghi') sorted: #size ascending >>> #('fghi' 'abc' 'de')"
- "Example: #('abc' 'de' 'fghi') sorted: #size descending"
+ ^self asSortFunction reversed!
- ^(PropertySortFunction property: self) toggleDirection!
Item was removed:
- ----- Method: Symbol>>sortedWith: (in category 'sorting') -----
- sortedWith: aSortFunction
- "Return a SortFunction around the receiver, where the receiver will be used as a unary message to send to both a and b during sorting, and then the result of said send will be collated in descending order using the aSortFunction."
- "Example: #('abc' 'de' 'fghi') sorted: (#size collatedBy: #<=> asSortFunction)"
-
- ^PropertySortFunction property: self sortedWith: aSortFunction asSortFunction!
Item was changed:
+ ComposedSortFunction subclass: #UndefinedSortFunction
- SortFunction subclass: #UndefinedSortFunction
instanceVariableNames: 'direction'
classVariableNames: ''
poolDictionaries: ''
+ category: 'Collections-SortFunctions'!
- category: 'Collections-Support'!
+ !UndefinedSortFunction commentStamp: 'nice 11/7/2017 22:16' prior: 0!
+ An UndefinedSortFunction is a specialization usefull for sorting undefined objects (nil), either first or last according to direction.
+ The non nil objects are sorted according to the baseSortFunction defined in superclass.
- !UndefinedSortFunction commentStamp: 'nice 11/5/2017 23:18' prior: 0!
- An UndefinedSortFunction is a specialization of SortFunction for sorting UndefinedObject either first or last.
+ instance variables:
+ direction <Integer> -1 for sorting nil first, 1 for sorting nil last!
- Instance Variables
- collator <SortFunction> the SortFunction to be used for non nil values
- direction: <Integer> -1 if nil is sorted first, 1 if sorted last
- !
Item was added:
+ ----- Method: UndefinedSortFunction>>= (in category 'comparing') -----
+ = anObject
+ "Answer whether the receiver and anObject represent the same object."
+
+ self == anObject
+ ifTrue: [ ^ true ].
+ self class = anObject class
+ ifFalse: [ ^ false ].
+ ^ baseSortFunction = anObject baseSortFunction
+ and: [ direction = anObject direction ]!
Item was changed:
----- Method: UndefinedSortFunction>>collate:with: (in category 'evaluating') -----
+ collate: anObject with: another
+ "Answer the collation order of anObject and another, with nil first or last according to direction"
+ anObject ifNil: [^another ifNil: [0] ifNotNil: [direction]].
+ another ifNil: [^direction negated].
+ ^baseSortFunction collate: anObject with: another!
- collate: value1 with: value2
- value1 ifNil: [^value2 ifNil: [0] ifNotNil: [direction]].
- value2 ifNil: [^direction negated].
- ^collator collate: value1 with: value2!
Item was added:
+ ----- Method: UndefinedSortFunction>>direction (in category 'accessing') -----
+ direction
+ ^direction!
Item was added:
+ ----- Method: UndefinedSortFunction>>hash (in category 'comparing') -----
+ hash
+ "Answer an integer value that is related to the identity of the receiver."
+
+ ^ super hash bitXor: direction hash!
Nicolas Cellier uploaded a new version of Collections to project The Trunk:
http://source.squeak.org/trunk/Collections-nice.766.mcz
==================== Summary ====================
Name: Collections-nice.766
Author: nice
Time: 5 November 2017, 11:52:17.600192 pm
UUID: 0008f12f-55e5-4c73-abcd-0e082a6013d1
Ancestors: Collections-bp.765
Revisit the SortFunction in the spirit of refactorings started by Denis Kudriashov in Pharo, but pushing them further.
SortFunction are by nature composable.
So make SortFunction abstract, and add different subclasses for different kind of composition.
Add the ability of sorting by properties with an odd collator rather than default <=>, which was missing in original implementation
Also add the ability to sort undefinedFirst as proposed by Denis.
Reversing the direction is now implemented with a subclass.
And the main SortFunction message is now collate:with: which must answer the collation order (-1,0,1).
=============== Diff against Collections-bp.765 ===============
Item was changed:
----- Method: BlockClosure>>ascending (in category '*Collections-Support-sorting') -----
ascending
"Return a SortFunction around the receiver. If the receiver is a 2 arg block, it is assumed it will do the collation directly itself, returning -1, 0, or 1. If the receiver is a one arg block, it will be evaluated for each a and b and of the sort input, and the result of sending <=> to those will be used."
+ self numArgs = 1 ifTrue: [^PropertySortFunction property: self].
+ self numArgs = 2 ifTrue: [^CollatorBlockFunction new collator: self].
+ self error: 'a block for sorting should have 1 or 2 parameters'!
- | function |
- function := SortFunction ascend.
- self numArgs = 1 ifTrue: [function monadicBlock: self].
- self numArgs = 2 ifTrue: [function collator: self].
- ^function!
Item was added:
+ ----- Method: BlockClosure>>sortedWith: (in category '*Collections-Support-sorting') -----
+ sortedWith: aSortFunction
+ "Return a SortFunction around the receiver.
+ The receiver is a one arg block.
+ It will be evaluated for each a and b and of the sort input, and answer the result of collating those with aSortFunction."
+
+ self numArgs = 1 ifTrue: [^PropertySortFunction property: self sortedWith: aSortFunction asSortFunction].
+ self error: 'a block for sorting should have 1 or 2 parameters'!
Item was changed:
SortFunction subclass: #ChainedSortFunction
instanceVariableNames: 'next'
classVariableNames: ''
poolDictionaries: ''
category: 'Collections-Support'!
+ !ChainedSortFunction commentStamp: 'nice 11/5/2017 22:35' prior: 0!
- !ChainedSortFunction commentStamp: 'nice 3/13/2014 22:25' prior: 0!
I add to my parent the idea of a "next" function to use when two objects are equal by my particular collator.
Usage
SortFunctions can be chained together in primary, secondary, tertiary, etc order using the comma method. Consider a sequence of customer objects, where each customer object responds to the messages firstName, lastName, and age. If we want to sort them lastName first, then firstName, and finally oldest first, we would use an expression like:
customers sort: #lastName ascending, #firstName ascending, #age descending
As noted in my super's comment, unary symbols or single arg blocks can be used. One can omit the the ascending methods on arguments (not the receiver), it will default blocks or symbols to be ascending if none is specified. In other words, the above expression could be simplified slightly as
customers sort: #lastName ascending, #firstName, #age descending
(note the missing ascending on the #firstName argument)
Instance Variables
+ collator <SortFunction> the first SortFunction.
+ next <SortFunction> the next SortFunction to evaluate in the event the first results in equal values.
- next <SortFunction> the next SortFunction to evaluate in the event my evaluator results in equal values.
!
Item was changed:
----- Method: ChainedSortFunction>>, (in category 'converting') -----
, aSortFunction
+ ^self copy next: next , aSortFunction!
- self next: next , aSortFunction!
Item was added:
+ ----- Method: ChainedSortFunction>>collate:with: (in category 'evaluating') -----
+ collate: anObject with: bObject
+ "Refinement of the parent behavior. If the result of my collator is 0, then pass on to the next variable to work it out."
+
+ | result |
+ result := (collator collate: anObject with: bObject).
+ ^result isZero
+ ifTrue: [next collate: anObject with: bObject]
+ ifFalse: [result]!
Item was removed:
- ----- Method: ChainedSortFunction>>value:value: (in category 'evaluating') -----
- value: anObject value: bObject
- "Refinement of the parent behavior. If the result of my collator is 0, then pass on to the next variable to work it out."
-
- | result |
- result := (collator value: anObject value: bObject) * direction.
- ^result isZero
- ifTrue: [next value: anObject value: bObject]
- ifFalse: [result < 0]!
Item was added:
+ SortFunction subclass: #CollatorBlockFunction
+ instanceVariableNames: ''
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'Collections-Support'!
+
+ !CollatorBlockFunction commentStamp: 'nice 11/5/2017 22:57' prior: 0!
+ A CollatorBlockFunction is a special SortFunction using a dyadic block to collate objects.
+
+ Instance Variables
+
+ collator <Block> a dyadic block that must return a -1, 0, or 1.!
Item was added:
+ ----- Method: CollatorBlockFunction>>collate:with: (in category 'evaluating') -----
+ collate: value1 with: value2
+ ^collator value: value1 value: value2!
Item was removed:
- ----- Method: Collection>>median (in category 'math functions') -----
- median
- ^ self asSortedCollection median!
Item was added:
+ SortFunction subclass: #DefaultSortFunction
+ instanceVariableNames: ''
+ classVariableNames: 'UniqueInstance'
+ poolDictionaries: ''
+ category: 'Collections-Support'!
+
+ !DefaultSortFunction commentStamp: 'nice 11/5/2017 21:45' prior: 0!
+ A DefaultSortFunction is a collator using the default <=> operator.
+ It is known to work on String and Magnitude.
+
+ !
Item was added:
+ ----- Method: DefaultSortFunction class>>new (in category 'instance creation') -----
+ new
+ ^UniqueInstance ifNil: [self basicNew initialize]!
Item was added:
+ ----- Method: DefaultSortFunction>>collate:with: (in category 'evaluating') -----
+ collate: value1 with: value2
+ ^value1 <=> value2!
Item was added:
+ ----- Method: DefaultSortFunction>>initialize (in category 'initailize-release') -----
+ initialize
+ collator := #<=>!
Item was added:
+ SortFunction subclass: #PropertySortFunction
+ instanceVariableNames: 'property'
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'Collections-Support'!
+
+ !PropertySortFunction commentStamp: 'nice 11/5/2017 22:36' prior: 0!
+ A PropertySortFunction is a SortFunction for sorting by a specific property.
+
+ Instance Variables
+ collator <SortFunction> the SortFunction to be used for sorting the properties
+ property <Symbol | Block> a valuable returning the value of property for objects to be sorted!
Item was added:
+ ----- Method: PropertySortFunction class>>property: (in category 'instance creation') -----
+ property: aValuable
+ ^self new property: aValuable!
Item was added:
+ ----- Method: PropertySortFunction class>>property:sortedWith: (in category 'instance creation') -----
+ property: aValuable sortedWith: aSortFunction
+ ^self new property: aValuable; collator: aSortFunction!
Item was added:
+ ----- Method: PropertySortFunction>>collate:with: (in category 'evaluating') -----
+ collate: value1 with: value2
+ ^collator collate: (property value: value1) with: (property value: value2)!
Item was added:
+ ----- Method: PropertySortFunction>>property: (in category 'initailize-release') -----
+ property: aValuable
+ property := aValuable!
Item was added:
+ ----- Method: PropertySortFunction>>undefinedFirst (in category 'converting') -----
+ undefinedFirst
+ "apply on the property"
+ ^self class
+ property: property
+ sortedWith: (UndefinedSortFunction new collator: collator) undefinedFirst!
Item was added:
+ ----- Method: PropertySortFunction>>undefinedLast (in category 'converting') -----
+ undefinedLast
+ "apply on the property"
+ ^self class
+ property: property
+ sortedWith: (UndefinedSortFunction new collator: collator) undefinedLast!
Item was added:
+ SortFunction subclass: #ReverseSortFunction
+ instanceVariableNames: ''
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'Collections-Support'!
+
+ !ReverseSortFunction commentStamp: 'nice 11/5/2017 22:40' prior: 0!
+ A ReverseSortFunction is reversing the order of original sortFunction
+
+ Instance Variables
+ collator <SortFunction> the original SortFunction.
+ !
Item was added:
+ ----- Method: ReverseSortFunction>>collate:with: (in category 'evaluating') -----
+ collate: value1 with: value2
+ ^(collator collate: value1 with: value2) negated!
Item was added:
+ ----- Method: ReverseSortFunction>>toggleDirection (in category 'converting') -----
+ toggleDirection
+ ^collator!
Item was added:
+ ----- Method: ReverseSortFunction>>undefinedFirst (in category 'converting') -----
+ undefinedFirst
+ "apply on the original"
+ ^collator undefinedFirst toggleDirection!
Item was added:
+ ----- Method: ReverseSortFunction>>undefinedLast (in category 'converting') -----
+ undefinedLast
+ "apply on the original"
+ ^collator undefinedLast toggleDirection!
Item was changed:
Object subclass: #SortFunction
+ instanceVariableNames: 'collator'
- instanceVariableNames: 'direction collator'
classVariableNames: ''
poolDictionaries: ''
category: 'Collections-Support'!
+ !SortFunction commentStamp: 'nice 11/5/2017 22:52' prior: 0!
- !SortFunction commentStamp: 'nice 3/13/2014 22:24' prior: 0!
I am intended to be used in place of two arg sort blocks.
Usage
In the following example, an ascending SortFunction is created based on the result of the #first message send to each object.
#(#(1 2) #(2 3) #(0 0)) sorted: #first ascending.
To sort by the #last element, but descending, the following would be used:
#(#(1 2) #(2 3) #(0 0)) sorted: #last descending.
One can use blocks as well. The following sorts in descending order, the sub elements based on the sum of their values.
| sumBlock |
sumBlock := [:sequence | sequence inject: 0 into: [:sum :each | sum + each]].
#(#(1 2) #(2 3) #(0 0)) sorted: sumBlock descending.
One can even use 2 arg blocks, for those cases where the function isn't expressible with objects that respond to < and =. The only catch, is that such a function has to return not true and false, but instead a collation order, values of -1 (for before), 0 (the same) or 1 (to follow). For example:
| oddBlock |
oddBlock :=
[:a :b |
a odd = b odd ifTrue: [0] ifFalse: [a odd ifTrue: [-1] ifFalse: [1]]].
#(1 5 1 3 2 7 9 4 6) asSortedCollection: oddBlock descending
Instance Variables
+ collator <SortFunction> This is the object responsible for collating objetcs, generally a SortFunction.
- collator <BlockClosure> This is the collation function that must return a -1, 0, or 1. It is usually composed by an initialization method such as sendMessage: or monadicBlock:, but may be set directly.
- direction <SmallInteger> 1 for ascending, -1 for descending
!
Item was removed:
- ----- Method: SortFunction class>>ascend (in category 'instance creation') -----
- ascend
-
- ^self new ascend!
Item was removed:
- ----- Method: SortFunction class>>descend (in category 'instance creation') -----
- descend
-
- ^self new descend!
Item was changed:
----- Method: SortFunction>>, (in category 'converting') -----
, aSortFunction
"Return a new SortFunction which is the concatenation of aSortFunction to me, I will be the primary sort, but if I compare equal, I will defer to the argument."
^(ChainedSortFunction new)
+ collator: self;
- collator: collator;
- direction: direction;
next: aSortFunction asSortFunction!
Item was removed:
- ----- Method: SortFunction>>ascend (in category 'initailize-release') -----
- ascend
-
- direction := 1!
Item was added:
+ ----- Method: SortFunction>>collate:with: (in category 'evaluating') -----
+ collate: value1 with: value2
+ "answer the collation order for the two values -1,0 or 1"
+
+ ^self subclassResponsibility!
Item was changed:
----- Method: SortFunction>>collator: (in category 'initailize-release') -----
+ collator: aSortFunction
+ "Used by subclasses for composition."
- collator: a2ArgBlock
- "a2ArgBlock MUST return the collation order, -1, 0, or 1"
+ collator := aSortFunction!
- collator := a2ArgBlock!
Item was removed:
- ----- Method: SortFunction>>descend (in category 'initailize-release') -----
- descend
-
- direction := -1!
Item was removed:
- ----- Method: SortFunction>>direction: (in category 'initailize-release') -----
- direction: anInteger
-
- direction := anInteger!
Item was added:
+ ----- Method: SortFunction>>initialize (in category 'initailize-release') -----
+ initialize
+ "set the default collator"
+
+ collator := DefaultSortFunction new!
Item was removed:
- ----- Method: SortFunction>>isAscending (in category 'testing') -----
- isAscending
-
- ^direction = 1!
Item was removed:
- ----- Method: SortFunction>>isDescending (in category 'testing') -----
- isDescending
-
- ^direction = -1!
Item was removed:
- ----- Method: SortFunction>>monadicBlock: (in category 'initailize-release') -----
- monadicBlock: aSingleArgBlock
- "Initialze the receiver's collation block to compare the results of evaluating aSingleArgBlock with each argument, and then collate the return values with the <=> method."
-
- collator := [:a :b | (aSingleArgBlock value: a) <=> (aSingleArgBlock value: b)]!
Item was removed:
- ----- Method: SortFunction>>sendMessage: (in category 'initailize-release') -----
- sendMessage: aUnarySymbol
- "Initialze the receiver's collation block to compare the results of sending aUnarySymbol to each argument, and then collate them with the <=> method."
-
- collator := [:a :b | (a perform: aUnarySymbol) <=> (b perform: aUnarySymbol)]!
Item was changed:
----- Method: SortFunction>>toggleDirection (in category 'converting') -----
toggleDirection
+ ^ReverseSortFunction new collator: self!
- "Invert my current direction, if I'm currently ascending, this will cause me to be descending now, and vice-versa."
-
- direction := direction * -1!
Item was added:
+ ----- Method: SortFunction>>undefinedFirst (in category 'converting') -----
+ undefinedFirst
+ ^(UndefinedSortFunction new collator: self) undefinedFirst!
Item was added:
+ ----- Method: SortFunction>>undefinedLast (in category 'converting') -----
+ undefinedLast
+ ^(UndefinedSortFunction new collator: self) undefinedLast!
Item was changed:
----- Method: SortFunction>>value:value: (in category 'evaluating') -----
value: anObject value: bObject
"Masquerade as a two argument block, used by many of the sorting APIs, by returning whether anObject should be placed before bObject or not."
| result |
+ result := (self collate: anObject with: bObject).
- result := (collator value: anObject value: bObject) * direction.
^result <= 0!
Item was changed:
----- Method: Symbol>>ascending (in category 'sorting') -----
ascending
"Return a SortFunction around the receiver, where the receiver will be used as a unary message to send to both a and b during sorting, and then the result of said send will be collated in ascending order using the <=> method."
"Example: #('abc' 'de' 'fghi') sorted: #size asscending"
+ ^PropertySortFunction property: self!
- ^SortFunction ascend sendMessage: self!
Item was changed:
----- Method: Symbol>>descending (in category 'sorting') -----
descending
"Return a SortFunction around the receiver, where the receiver will be used as a unary message to send to both a and b during sorting, and then the result of said send will be collated in descending order using the <=> method."
"Example: #('abc' 'de' 'fghi') sorted: #size descending"
+ ^(PropertySortFunction property: self) toggleDirection!
- ^SortFunction descend sendMessage: self!
Item was added:
+ ----- Method: Symbol>>sortedWith: (in category 'sorting') -----
+ sortedWith: aSortFunction
+ "Return a SortFunction around the receiver, where the receiver will be used as a unary message to send to both a and b during sorting, and then the result of said send will be collated in descending order using the aSortFunction."
+ "Example: #('abc' 'de' 'fghi') sorted: (#size collatedBy: #<=> asSortFunction)"
+
+ ^PropertySortFunction property: self sortedWith: aSortFunction asSortFunction!
Item was added:
+ SortFunction subclass: #UndefinedSortFunction
+ instanceVariableNames: 'direction'
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'Collections-Support'!
+
+ !UndefinedSortFunction commentStamp: 'nice 11/5/2017 23:18' prior: 0!
+ An UndefinedSortFunction is a specialization of SortFunction for sorting UndefinedObject either first or last.
+
+ Instance Variables
+ collator <SortFunction> the SortFunction to be used for non nil values
+ direction: <Integer> -1 if nil is sorted first, 1 if sorted last
+ !
Item was added:
+ ----- Method: UndefinedSortFunction>>collate:with: (in category 'evaluating') -----
+ collate: value1 with: value2
+ value1 ifNil: [^value2 ifNil: [0] ifNotNil: [direction]].
+ value2 ifNil: [^direction negated].
+ ^collator collate: value1 with: value2!
Item was added:
+ ----- Method: UndefinedSortFunction>>initialize (in category 'initailize-release') -----
+ initialize
+ super initialize.
+ direction := -1!
Item was added:
+ ----- Method: UndefinedSortFunction>>undefinedFirst (in category 'initailize-release') -----
+ undefinedFirst
+ direction := -1!
Item was added:
+ ----- Method: UndefinedSortFunction>>undefinedLast (in category 'initailize-release') -----
+ undefinedLast
+ direction := 1!
Nicolas Cellier uploaded a new version of Graphics to project The Trunk:
http://source.squeak.org/trunk/Graphics-nice.385.mcz
==================== Summary ====================
Name: Graphics-nice.385
Author: nice
Time: 26 November 2017, 5:01:45.616725 pm
UUID: 307c6d82-1236-45e1-9a86-c8973901c9f1
Ancestors: Graphics-dtl.384
Fix bad inference of variable type in MiscPrimitivePlugin
=============== Diff against Graphics-dtl.384 ===============
Item was changed:
----- Method: Bitmap>>decompress:fromByteArray:at: (in category 'filing') -----
decompress: bm fromByteArray: ba at: index
"Decompress the body of a byteArray encoded by compressToByteArray (qv)...
The format is simply a sequence of run-coded pairs, {N D}*.
N is a run-length * 4 + data code.
D, the data, depends on the data code...
0 skip N words, D is absent
(could be used to skip from one raster line to the next)
1 N words with all 4 bytes = D (1 byte)
2 N words all = D (4 bytes)
3 N words follow in D (4N bytes)
S and N are encoded as follows (see decodeIntFrom:)...
0-223 0-223
224-254 (0-30)*256 + next byte (0-7935)
255 next 4 bytes"
"NOTE: If fed with garbage, this routine could read past the end of ba, but it should fail before writing past the ned of bm."
| i code n anInt data end k pastEnd |
<primitive: 'primitiveDecompressFromByteArray' module: 'MiscPrimitivePlugin'>
+ <var: #bm type: 'int *'>
+ <var: #ba type: 'unsigned char *'>
+ <var: #anInt type: 'unsigned int'> "Force the type, otherwise it is inferred as unsigned char because assigned from ba"
+ <var: #data type: 'unsigned int'>
- <var: #bm declareC: 'int *bm'>
- <var: #ba declareC: 'unsigned char *ba'>
i := index. "byteArray read index"
end := ba size.
k := 1. "bitmap write index"
pastEnd := bm size + 1.
[i <= end] whileTrue:
["Decode next run start N"
anInt := ba at: i. i := i+1.
anInt <= 223 ifFalse:
[anInt <= 254
ifTrue: [anInt := (anInt-224)*256 + (ba at: i). i := i+1]
ifFalse: [anInt := 0.
1 to: 4 do: [:j | anInt := (anInt bitShift: 8) + (ba at: i). i := i+1]]].
n := anInt >> 2.
(k + n) > pastEnd ifTrue: [^ self primitiveFail].
code := anInt bitAnd: 3.
code = 0 ifTrue: ["skip"].
code = 1 ifTrue: ["n consecutive words of 4 bytes = the following byte"
data := ba at: i. i := i+1.
data := data bitOr: (data bitShift: 8).
data := data bitOr: (data bitShift: 16).
1 to: n do: [:j | bm at: k put: data. k := k+1]].
code = 2 ifTrue: ["n consecutive words = 4 following bytes"
data := 0.
1 to: 4 do: [:j | data := (data bitShift: 8) bitOr: (ba at: i). i := i+1].
1 to: n do: [:j | bm at: k put: data. k := k+1]].
code = 3 ifTrue: ["n consecutive words from the data..."
1 to: n do:
[:m | data := 0.
1 to: 4 do: [:j | data := (data bitShift: 8) bitOr: (ba at: i). i := i+1].
bm at: k put: data. k := k+1]]]!
David T. Lewis uploaded a new version of System to project The Trunk:
http://source.squeak.org/trunk/System-dtl.979.mcz
==================== Summary ====================
Name: System-dtl.979
Author: dtl
Time: 24 November 2017, 6:12:53.864262 pm
UUID: 7572e3df-ab0e-4ad2-a89b-ee101e2a821c
Ancestors: System-dtl.978
Remove unnecessary references to global World.
=============== Diff against System-dtl.978 ===============
Item was changed:
----- Method: NativeImageSegment>>copySmartRootsExport: (in category 'read/write segment') -----
copySmartRootsExport: rootArray
"Use SmartRefStream to find the object. Make them all roots. Create the segment in memory. Project should be in first five objects in rootArray."
+ | newRoots segSize symbolHolder replacements naughtyBlocks allClasses sizeHint proj dummy world |
- | newRoots segSize symbolHolder replacements naughtyBlocks allClasses sizeHint proj dummy |
"self halt."
+ world := Project current world.
symbolHolder := Symbol allSymbols. "Hold onto Symbols with strong pointers,
so they will be in outPointers"
dummy := ReferenceStream on: (DummyStream on: nil).
"Write to a fake Stream, not a file"
"Collect all objects"
dummy insideASegment: true. "So Uniclasses will be traced"
dummy rootObject: rootArray. "inform him about the root"
dummy nextPut: rootArray.
(proj :=dummy project) ifNotNil: [self dependentsSave: dummy].
allClasses := SmartRefStream new uniClassInstVarsRefs: dummy.
"catalog the extra objects in UniClass inst vars. Put into dummy"
allClasses do: [:cls |
dummy references at: cls class put: false. "put Player5 class in roots"
dummy blockers removeKey: cls class ifAbsent: []].
"refs := dummy references."
arrayOfRoots := self smartFillRoots: dummy. "guaranteed none repeat"
self savePlayerReferences: dummy references. "for shared References table"
replacements := dummy blockers.
dummy project "recompute it" ifNil: [self error: 'lost the project!!'].
dummy project class == DiskProxy ifTrue: [self error: 'saving the wrong project'].
dummy := nil. "Allow dummy to be GC'ed below (bytesLeft)."
naughtyBlocks := arrayOfRoots select: [ :each |
each isContext and: [each hasInstVarRef]].
"since the caller switched ActiveWorld, put the real one back temporarily"
naughtyBlocks isEmpty ifFalse: [
+ world becomeActiveDuring: [world firstHand becomeActiveDuring: [ | goodToGo |
- World becomeActiveDuring: [World firstHand becomeActiveDuring: [ | goodToGo |
goodToGo := (UIManager default
chooseFrom: #('keep going' 'stop and take a look')
title:
'Some block(s) which reference instance variables
are included in this segment. These may fail when
the segment is loaded if the class has been reshaped.
What would you like to do?') = 1.
goodToGo ifFalse: [
naughtyBlocks inspect.
self error: 'Here are the bad blocks'].
]].
].
"Creation of the segment happens here"
"try using one-quarter of memory min: four megs to publish (will get bumped up later if needed)"
sizeHint := (Smalltalk bytesLeft // 4 // 4) min: 1024*1024.
self copyFromRoots: arrayOfRoots sizeHint: sizeHint areUnique: true.
segSize := segment size.
[(newRoots := self rootsIncludingBlockMethods) == nil] whileFalse:
[arrayOfRoots := newRoots.
self copyFromRoots: arrayOfRoots sizeHint: segSize areUnique: true].
"with methods pointed at from outside"
[(newRoots := self rootsIncludingBlocks) == nil] whileFalse:
[arrayOfRoots := newRoots.
self copyFromRoots: arrayOfRoots sizeHint: segSize areUnique: true].
"with methods, blocks from outPointers"
1 to: outPointers size do: [:ii | | outPointer |
outPointer := outPointers at: ii.
(outPointer isBlock
or: [outPointer isContext]) ifTrue: [outPointers at: ii put: nil].
"substitute new object in outPointers"
(replacements includesKey: outPointer) ifTrue:
[outPointers at: ii put: (replacements at: outPointer)]].
proj ifNotNil: [self dependentsCancel: proj].
symbolHolder. "hold onto symbolHolder until the last."!
Item was changed:
----- Method: Preferences class>>loadPreferencesFrom: (in category 'initialization - save/load') -----
loadPreferencesFrom: aFile
| stream params dict desktopColor |
stream := ReferenceStream fileNamed: aFile.
params := stream next.
self assert: (params isKindOf: IdentityDictionary).
params removeKey: #PersonalDictionaryOfPreferences.
dict := stream next.
self assert: (dict isKindOf: IdentityDictionary).
desktopColor := stream next.
stream close.
dict keysAndValuesDo:
[:key :value | (self preferenceAt: key ifAbsent: [nil]) ifNotNil:
[:pref | [pref preferenceValue: value preferenceValue] on: Error do: [ : err | "Ignore preferences which may not be supported anymore."]]].
params keysAndValuesDo: [ :key :value | self setParameter: key to: value ].
Smalltalk isMorphic
+ ifTrue: [ Project current world fillStyle: desktopColor ]
- ifTrue: [ World fillStyle: desktopColor ]
ifFalse: [ self desktopColor: desktopColor. ScheduledControllers updateGray ]!
Item was changed:
----- Method: Preferences class>>mouseOverHalosChanged (in category 'updating - system') -----
mouseOverHalosChanged
+ Project current world wantsMouseOverHalos: self mouseOverHalos!
- World wantsMouseOverHalos: self mouseOverHalos!
Item was changed:
----- Method: Project>>validateProjectNameIfOK: (in category 'menu messages') -----
validateProjectNameIfOK: aBlock
| details |
details := world valueOfProperty: #ProjectDetails.
details ifNotNil: ["ensure project info matches real project name"
details at: 'projectname' put: self name.
].
self doWeWantToRename ifFalse: [^ aBlock value: details].
(Smalltalk at: #EToyProjectDetailsMorph) ifNotNil: [:etpdm |
etpdm
getFullInfoFor: self
ifValid: [:d |
+ Project current world displayWorldSafely.
- World displayWorldSafely.
aBlock value: d
]
expandedFormat: false]
!
Item was changed:
----- Method: ProjectLauncher>>hideSplashMorph (in category 'running') -----
hideSplashMorph
SplashMorph ifNil:[^self].
self showSplash
ifFalse: [^self].
SplashMorph delete.
+ Project current world submorphs do:[:m| m visible: true]. "show all"
- World submorphs do:[:m| m visible: true]. "show all"
!
Item was changed:
----- Method: ProjectLauncher>>prepareForLogin (in category 'eToy login') -----
prepareForLogin
"Prepare for login - e.g., hide everything so only the login morph is visible."
+ | world |
+ world := Project current world.
+ world submorphsDo:[:m|
- World submorphsDo:[:m|
m isLocked ifFalse:[m hide]]. "hide all those guys"
+ world displayWorldSafely.
- World displayWorldSafely.
!
Item was changed:
----- Method: ProjectLauncher>>proceedWithLogin (in category 'eToy login') -----
proceedWithLogin
eToyAuthentificationServer := nil.
+ Project current world submorphsDo:[:m| m show].
- World submorphsDo:[:m| m show].
WorldState addDeferredUIMessage: [self startUpAfterLogin].!
Item was changed:
----- Method: ProjectLauncher>>showSplashMorph (in category 'running') -----
showSplashMorph
+ | world |
SplashMorph ifNil:[^self].
self showSplash
ifFalse: [^self].
+ world := Project current world.
+ world submorphs do:[:m| m visible: false]. "hide all"
+ world addMorphCentered: SplashMorph.
+ world displayWorldSafely.!
- World submorphs do:[:m| m visible: false]. "hide all"
- World addMorphCentered: SplashMorph.
- World displayWorldSafely.!
Item was changed:
----- Method: ResourceManager>>loadCachedResources (in category 'loading') -----
loadCachedResources
"Load all the resources that we have cached locally"
self class reloadCachedResources.
self prioritizedUnloadedResources do:[:loc|
self class lookupCachedResource: loc urlString ifPresentDo:[:stream|
| resource |
resource := resourceMap at: loc ifAbsent:[nil].
self installResource: resource
from: stream
locator: loc.
(resource isForm) ifTrue:[
self formChangedReminder value.
+ Project current world displayWorldSafely].
- World displayWorldSafely].
].
].!
Item was changed:
----- Method: SARInstaller>>fileInMCVersion:withBootstrap: (in category 'private') -----
fileInMCVersion: member withBootstrap: mcBootstrap
"This will use the MCBootstrapLoader to load a (non-compressed) Monticello file (.mc or .mcv)"
| newCS |
self class withCurrentChangeSetNamed: member localFileName
do: [ :cs |
newCS := cs.
mcBootstrap loadStream: member contentStream ascii ].
newCS isEmpty ifTrue: [ ChangeSet removeChangeSet: newCS ].
+ Project current world doOneCycle.
- World doOneCycle.
self installed: member.!
Item was changed:
----- Method: SARInstaller>>fileInMonticelloPackageNamed: (in category 'client services') -----
fileInMonticelloPackageNamed: memberName
"This is to be used from preamble/postscript code to file in zip
members as Monticello packages (.mc)."
| member file mcPackagePanel mcRevisionInfo mcSnapshot mcFilePackageManager mcPackage mcBootstrap newCS |
mcPackagePanel := Smalltalk at: #MCPackagePanel ifAbsent: [ ].
mcRevisionInfo := Smalltalk at: #MCRevisionInfo ifAbsent: [ ].
mcSnapshot := Smalltalk at: #MCSnapshot ifAbsent: [ ].
mcFilePackageManager := Smalltalk at: #MCFilePackageManager ifAbsent: [ ].
mcPackage := Smalltalk at: #MCPackage ifAbsent: [ ].
member := self memberNamed: memberName.
member ifNil: [ ^self errorNoSuchMember: memberName ].
"We are missing MCInstaller, Monticello and/or MonticelloCVS.
If the bootstrap is present, use it. Otherwise interact with the user."
({ mcPackagePanel. mcRevisionInfo. mcSnapshot. mcFilePackageManager. mcPackage } includes: nil)
ifTrue: [
mcBootstrap := self getMCBootstrapLoaderClass.
mcBootstrap ifNotNil: [ ^self fileInMCVersion: member withBootstrap: mcBootstrap ].
(self confirm: ('Monticello support is not installed, but must be to load member named ', memberName, '.
Load it from SqueakMap?'))
ifTrue: [ self class loadMonticello; loadMonticelloCVS.
^self fileInMonticelloPackageNamed: memberName ]
ifFalse: [ ^false ] ].
member extractToFileNamed: member localFileName inDirectory: self directory.
file := (Smalltalk at: #MCFile)
name: member localFileName
directory: self directory.
self class withCurrentChangeSetNamed: file name do: [ :cs | | snapshot info |
newCS := cs.
file readStreamDo: [ :stream |
info := mcRevisionInfo readFrom: stream nextChunk.
snapshot := mcSnapshot fromStream: stream ].
snapshot install.
(mcFilePackageManager forPackage:
(mcPackage named: info packageName))
file: file
].
newCS isEmpty ifTrue: [ ChangeSet removeChangeSet: newCS ].
mcPackagePanel allSubInstancesDo: [ :ea | ea refresh ].
+ Project current world doOneCycle.
- World doOneCycle.
self installed: member.
!
Item was changed:
----- Method: SARInstaller>>fileInMonticelloVersionNamed: (in category 'client services') -----
fileInMonticelloVersionNamed: memberName
"This is to be used from preamble/postscript code to file in zip
members as Monticello version (.mcv) files."
| member newCS mcMcvReader |
mcMcvReader := Smalltalk at: #MCMcvReader ifAbsent: [].
member := self memberNamed: memberName.
member ifNil: [^self errorNoSuchMember: memberName].
"If we don't have Monticello, offer to get it."
mcMcvReader ifNil: [
(self confirm: 'Monticello is not installed, but must be to load member named ', memberName , '.
Load it from SqueakMap?')
ifTrue: [ self class loadMonticello.
^self fileInMonticelloVersionNamed: memberName]
ifFalse: [^false]].
self class withCurrentChangeSetNamed: member localFileName
do:
[:cs |
newCS := cs.
(mcMcvReader versionFromStream: member contentStream ascii) load ].
newCS isEmpty ifTrue: [ChangeSet removeChangeSet: newCS].
+ Project current world doOneCycle.
- World doOneCycle.
self installed: member!
Item was changed:
----- Method: SARInstaller>>fileInMonticelloZipVersionNamed: (in category 'client services') -----
fileInMonticelloZipVersionNamed: memberName
"This is to be used from preamble/postscript code to file in zip
members as Monticello version (.mcz) files."
| member mczInstaller newCS mcMczReader |
mcMczReader := Smalltalk at: #MCMczReader ifAbsent: [].
mczInstaller := Smalltalk at: #MczInstaller ifAbsent: [].
member := self memberNamed: memberName.
member ifNil: [^self errorNoSuchMember: memberName].
"If we don't have Monticello, but have the bootstrap, use it silently."
mcMczReader ifNil: [
mczInstaller ifNotNil: [ ^mczInstaller installStream: member contentStream ].
(self confirm: 'Monticello is not installed, but must be to load member named ', memberName , '.
Load it from SqueakMap?')
ifTrue: [ self class loadMonticello.
^self fileInMonticelloZipVersionNamed: memberName]
ifFalse: [^false]].
self class withCurrentChangeSetNamed: member localFileName
do:
[:cs |
newCS := cs.
(mcMczReader versionFromStream: member contentStream) load ].
newCS isEmpty ifTrue: [ChangeSet removeChangeSet: newCS].
+ Project current world doOneCycle.
- World doOneCycle.
self installed: member!
Item was changed:
----- Method: SARInstaller>>fileInTrueTypeFontNamed: (in category 'client services') -----
fileInTrueTypeFontNamed: memberOrName
| member description |
member := self memberNamed: memberOrName.
member ifNil: [^self errorNoSuchMember: memberOrName].
description := TTFontDescription addFromTTStream: member contentStream.
TTCFont newTextStyleFromTT: description.
+ Project current world doOneCycle.
- World doOneCycle.
self installed: member!
Item was changed:
----- Method: SmalltalkImage>>shrinkAndCleanDesktop (in category 'shrinking') -----
shrinkAndCleanDesktop
+ | world |
+ world := Project current world.
+ world removeAllMorphs.
- World removeAllMorphs.
self shrink.
MorphicProject defaultFill: (Color gray: 0.9).
+ world color: (Color gray: 0.9)!
- World color: (Color gray: 0.9)!
David T. Lewis uploaded a new version of Services-Base to project The Trunk:
http://source.squeak.org/trunk/Services-Base-dtl.63.mcz
==================== Summary ====================
Name: Services-Base-dtl.63
Author: dtl
Time: 24 November 2017, 6:09:46.207676 pm
UUID: 5d6623aa-6db1-45f3-9e1a-2bf881e75ccf
Ancestors: Services-Base-ul.62
Remove unnecessary references to global World.
=============== Diff against Services-Base-ul.62 ===============
Item was changed:
----- Method: Requestor>>getMethodBody (in category 'requests') -----
getMethodBody
+ | m world |
- | m |
m := FillInTheBlankMorph new.
m setQuery: 'Please enter the full body of the method you want to define'
initialAnswer: self class sourceCodeTemplate
answerExtent: 500@250
acceptOnCR: false.
+ world := Project current world.
+ world addMorph: m centeredNear: world activeHand position.
- World addMorph: m centeredNear: World activeHand position.
^ m getUserResponse.!
Item was changed:
----- Method: Requestor>>getSelection (in category 'requests') -----
getSelection
"Sorry to feedle with fillInTheBlankMorph innards, but I had to"
+ | text m world |
- | text m |
text := (MethodReference class: self getClass selector: self getSelector) sourceCode.
m := FillInTheBlankMorph new.
m setQuery: 'Highlight a part of the source code, and accept' initialAnswer: text
answerExtent: 500@250
acceptOnCR: true.
+ world := Project current world.
+ world addMorph: m centeredNear: world activeHand position.
- World addMorph: m centeredNear: World activeHand position.
m getUserResponse.
^ m selection!
Item was changed:
----- Method: ServiceAction>>execute (in category 'executing') -----
execute
+ ^ action valueWithRequestor: Project current world focusedRequestor!
- ^ action valueWithRequestor: World focusedRequestor!
Item was changed:
----- Method: ServiceAction>>executeCondition (in category 'executing') -----
executeCondition
+ ^ [condition valueWithRequestor: Project current world focusedRequestor]
- ^ [condition valueWithRequestor: World focusedRequestor]
on: Error
do: [false]!