Squeak-dev June 2016

squeak-dev@lists.squeakfoundation.org

39 participants
202 discussions

The Trunk: Morphic-ul.1158.mcz
by commits＠source.squeak.org 02 Jun '16

02 Jun '16

Levente Uzonyi uploaded a new version of Morphic to project The Trunk: http://source.squeak.org/trunk/Morphic-ul.1158.mcz ==================== Summary ==================== Name: Morphic-ul.1158 Author: ul Time: 2 June 2016, 8:25:53.664006 pm UUID: 875c3c7f-2813-4bc5-9c85-8ed8eb6f02cb Ancestors: Morphic-mt.1157 - use #sort instead of #fullySort =============== Diff against Morphic-mt.1157 =============== Item was changed: ----- Method: MorphicAlarmQueue>>nextSequenceNumber (in category 'private') ----- nextSequenceNumber (sequenceNumber := sequenceNumber + 1) = 16r3FFFFFFF ifTrue: [ "Sequence number overflow... reassign sequence numbers starting at 1." + heap sort. - heap fullySort. 1 to: heap size do: [ :index | (heap at: index) sequenceNumber: index ]. sequenceNumber := heap size + 1 ]. ^sequenceNumber!

1 0

The Trunk: ToolBuilder-Morphic-mt.166.mcz
by commits＠source.squeak.org 02 Jun '16

02 Jun '16

Marcel Taeumel uploaded a new version of ToolBuilder-Morphic to project The Trunk: http://source.squeak.org/trunk/ToolBuilder-Morphic-mt.166.mcz ==================== Summary ==================== Name: ToolBuilder-Morphic-mt.166 Author: mt Time: 2 June 2016, 6:33:08.27467 pm UUID: f4e7d7b4-c3ba-cf48-aba0-0bf40d5c88eb Ancestors: ToolBuilder-Morphic-mt.165 Fixes tool opening for non-windows. Fixes debugger opening for errors that occur in invisible worlds' event processing chain. Required for writing tests for user input event processing. Always use the project's world to show debuggers. =============== Diff against ToolBuilder-Morphic-mt.165 =============== Item was changed: ----- Method: MorphicToolBuilder>>open:label: (in category 'opening') ----- open: anObject label: aString + "Build an open the object, labeling it appropriately if it is a window. Answer the widget opened." + + | morph | + morph := self open: anObject. + morph isSystemWindow + ifTrue: [morph setLabel: aString] + ifFalse: [morph name: aString]. + ^ morph! - "Build an open the object, labeling it appropriately. Answer the widget opened." - | window | - window := self open: anObject. - window setLabel: aString. - ^window! Item was added: + ----- Method: MorphicToolBuilder>>openDebugger: (in category 'opening') ----- + openDebugger: aSpec + + | morph | + morph := self build: aSpec. + morph openInWorld: Project current world extent: morph extent. + ^ morph! Item was added: + ----- Method: MorphicToolBuilder>>openDebugger:label: (in category 'opening') ----- + openDebugger: aSpec label: aString + + | morph | + morph := self openDebugger: aSpec. + morph isSystemWindow + ifTrue: [morph setLabel: aString] + ifFalse: [morph name: aString]. + ^ morph!

1 0

The Trunk: CollectionsTests-ul.263.mcz
by commits＠source.squeak.org 02 Jun '16

02 Jun '16

Levente Uzonyi uploaded a new version of CollectionsTests to project The Trunk: http://source.squeak.org/trunk/CollectionsTests-ul.263.mcz ==================== Summary ==================== Name: CollectionsTests-ul.263 Author: ul Time: 2 June 2016, 5:49:02.940363 pm UUID: caaf5382-04e8-47fb-9db3-9b5e97cb3aed Ancestors: CollectionsTests-mt.262 - added a few more heap tests =============== Diff against CollectionsTests-mt.262 =============== Item was changed: ----- Method: HeapTest>>heapSortExample (in category 'examples') ----- + heapSortExample + "Sort a random collection of Floats and compare the results with #quicksort and #sort (using the merge-sort algorithm)." + "HeapTest new heapSortExample" + + | arrayToSort n rnd array time | + Smalltalk garbageCollectMost. + n := 50000. "# of elements to sort" - heapSortExample "HeapTest new heapSortExample" - "Sort a random collection of Floats and compare the results with - SortedCollection (using the quick-sort algorithm) and - ArrayedCollection>>mergeSortFrom:to:by: (using the merge-sort algorithm)." - | n rnd array time sorted | - n := 10000. "# of elements to sort" rnd := Random new. + array := Array new: n. + 1 to: n do: [ :index | array at: index put: rnd next ]. + arrayToSort := array copy. - array := (1 to: n) collect:[:i| rnd next]. "First, the heap version" + self deny: arrayToSort isSorted. + time := [ (Heap on: arrayToSort) sort ] timeToRun. + self assert: arrayToSort isSorted. + Transcript cr; show: 'Time for heap-sort: ', time printString,' msecs'. - time := Time millisecondsToRun:[ - sorted := Heap withAll: array. - 1 to: n do:[:i| sorted removeFirst]. - ]. - Transcript cr; show:'Time for heap-sort: ', time printString,' msecs'. "The quicksort version" + arrayToSort copyFrom: array. + self deny: arrayToSort isSorted. + time := [ arrayToSort quickSort ] timeToRun. + self assert: arrayToSort isSorted. + Transcript cr; show: 'Time for quick-sort: ', time printString,' msecs'. - time := Time millisecondsToRun:[ - sorted := SortedCollection withAll: array. - ]. - Transcript cr; show:'Time for quick-sort: ', time printString,' msecs'. "The merge-sort version" + arrayToSort copyFrom: array. + self deny: arrayToSort isSorted. + time := [ arrayToSort sort ] timeToRun. + self assert: arrayToSort isSorted. + Transcript cr; show: 'Time for merge-sort: ', time printString,' msecs'! - time := Time millisecondsToRun:[ - array mergeSortFrom: 1 to: array size by: [:v1 :v2| v1 <= v2]. - ]. - Transcript cr; show:'Time for merge-sort: ', time printString,' msecs'. - ! Item was changed: + ----- Method: HeapTest>>test1 (in category 'tests') ----- - ----- Method: HeapTest>>test1 (in category 'testing') ----- test1 | data | "The first element of each array is the sort value, and the second will be updated by the heap with the index of the element within the heap." data := (1 to: 8) collect: [:i | {i*2. 0}]. "Repeat with different data ordering." 5 timesRepeat: [ | h | h := Heap new sortBlock: [:e1 :e2 | e1 first < e2 first]. h indexUpdateBlock: [:array :index | array at: 2 put: index]. data shuffled do: [:d | h add: d]. data do: [:d | self should: (h at: d second) == d]. ]! Item was changed: + ----- Method: HeapTest>>testAdd (in category 'tests') ----- - ----- Method: HeapTest>>testAdd (in category 'basic tests') ----- testAdd "self run: #testAdd" | heap | heap := Heap new. self assert: heap size = 0. heap add: 3. self assert: heap size = 1. self assert: heap isEmpty not. self assert: heap first = 3. self assert: (heap at: 1) = 3. heap add: 2. self assert: heap size = 2. self assert: heap first = 2. self assert: (heap at: 2) = 3. ! Item was added: + ----- Method: HeapTest>>testAddAndRemoveFirst (in category 'tests') ----- + testAddAndRemoveFirst + + | random heap validateHeap | + random := Random seed: 36rSqueak. + heap := Heap sortBlock: [ :a :b | a first >= b first ]. + heap indexUpdateBlock: [ :element :newIndex | element at: 2 put: newIndex ]. + validateHeap := [ heap isValidHeap and: [ + heap do: [ :each | self assert: (heap at: each second) == each ] ] ]. + validateHeap value. + self assert: 0 equals: heap size. + self assert: heap isEmpty. + 1 to: 100 do: [ :index | + heap add: { random next. nil }. + self assert: index equals: heap size. + validateHeap value ]. + 1000 timesRepeat: [ + | first | + first := heap removeFirst. + heap do: [ :each | self assert: (heap sortBlock value: first value: each) ]. + heap add: { random next. nil }. + validateHeap value ]! Item was changed: + ----- Method: HeapTest>>testAt (in category 'tests') ----- - ----- Method: HeapTest>>testAt (in category 'basic tests') ----- testAt "self run: #testAt" | heap | heap := Heap new. heap add: 3. self assert: (heap at: 1) = 3. self should: [heap at: 2] raise: Error. heap add: 4. self assert: (heap at: 1) = 3. self assert: (heap at: 2) = 4. ! Item was added: + ----- Method: HeapTest>>testAtRaisesErrorWhenIndexIsInvalid (in category 'tests') ----- + testAtRaisesErrorWhenIndexIsInvalid + " self run: #testAtRaisesErrorWhenIndexIsInvalid " + + | heap | + heap := Heap new. + 1 to: 100 do: [ :index | + 1 to: heap size do: [ :each | + self assert: ((heap at: each) between: 1 and: heap size) ]. + self + should: [ heap at: 0 ] raise: Error; + should: [ heap at: heap size + 1 ] raise: Error. + heap add: index ].! Item was added: + ----- Method: HeapTest>>testCompact (in category 'tests') ----- + testCompact + " self run: #testCompact " + + | heap | + heap := Heap new. + 1 to: 100 do: [ :index | + | copy | + copy := heap copy. + copy compact. + self + assert: copy = heap; + assert: copy capacity <= heap capacity; + assert: copy capacity = copy size. + heap add: index ].! Item was added: + ----- Method: HeapTest>>testCopy (in category 'tests') ----- + testCopy + + | heap | + heap := Heap new. + 1 to: 100 do: [ :index | + | copy | + copy := heap copy. + self + assert: copy = heap; + assert: heap = copy; + deny: copy == heap; + assert: copy sortBlock = heap sortBlock; + deny: copy array == heap array. + heap add: index ].! Item was added: + ----- Method: HeapTest>>testCopyEmpty (in category 'tests') ----- + testCopyEmpty + + | heap | + heap := Heap new. + 1 to: 100 do: [ :index | + | copy | + copy := heap copyEmpty. + self + assert: copy isHeap; + assert: copy isEmpty; + assert: copy sortBlock = heap sortBlock. + heap add: index ].! Item was changed: + ----- Method: HeapTest>>testDo (in category 'tests') ----- - ----- Method: HeapTest>>testDo (in category 'basic tests') ----- testDo "self run: #testDo" | heap coll | heap := Heap withAll: #(1 3 5). coll := OrderedCollection new. heap do: [:each | coll add: each]. self assert: coll = #(1 3 5) asOrderedCollection. ! Item was changed: + ----- Method: HeapTest>>testExamples (in category 'tests') ----- - ----- Method: HeapTest>>testExamples (in category 'testing') ----- testExamples self heapExample. self heapSortExample.! Item was changed: + ----- Method: HeapTest>>testFirst (in category 'tests') ----- - ----- Method: HeapTest>>testFirst (in category 'basic tests') ----- testFirst "self run: #testFirst" | heap | heap := Heap new. heap add: 5. heap add: 12. heap add: 1. self assert: heap first = 1. heap removeFirst. self assert: heap first = 5.! Item was changed: + ----- Method: HeapTest>>testHeap (in category 'tests') ----- - ----- Method: HeapTest>>testHeap (in category 'basic tests') ----- testHeap "self run: #testHeap" | heap | heap := Heap new. self assert: heap isHeap. self assert: heap isEmpty. heap add: 1. self assert: heap isEmpty not ! Item was changed: + ----- Method: HeapTest>>testIfEqualIsTransitive (in category 'tests') ----- - ----- Method: HeapTest>>testIfEqualIsTransitive (in category 'testing') ----- testIfEqualIsTransitive "This is http://bugs.squeak.org/view.php?id=6943" | anArray heap1 heap2 | anArray := #(1 2 3). heap1 := Heap withAll: (1 to: 3) sortBlock: [:a :b | a < b]. heap2 := Heap withAll: (1 to: 3) sortBlock: [:a :b | b > a]. self assert: (heap1 = anArray) & (heap2 = anArray) ==> (heap1 = heap2) description: 'Heap equality should be transitive'! Item was changed: + ----- Method: HeapTest>>testRemove (in category 'tests') ----- - ----- Method: HeapTest>>testRemove (in category 'basic tests') ----- testRemove "self run: #testRemove" | heap | heap := Heap new. self should: [heap removeFirst] raise: Error. heap add: 5. + self assert: 5 equals: heap removeFirst. - heap removeFirst. self assert: heap size = 0. heap add: 5. self should: [heap removeAt: 2] raise: Error.! Item was added: + ----- Method: HeapTest>>testSort (in category 'tests') ----- + testSort + + self testSortUsing: Heap new. + { + nil. + #<=. + [ :a :b | a <= b ]. + [ :a :b | a >= b ] + } do: [ :each | self testSortUsing: (Heap sortBlock: each) ]! Item was changed: + ----- Method: HeapTest>>testSortBlock (in category 'tests') ----- - ----- Method: HeapTest>>testSortBlock (in category 'basic tests') ----- testSortBlock "self run: #testSortBlock" | heap | heap := Heap withAll: #(1 3 5). self assert: heap asArray = #(1 3 5). heap sortBlock: [ :e1 :e2 | e1 >= e2 ]. + self assert: heap isValidHeap. self assert: heap asArray = #(5 3 1) ! Item was added: + ----- Method: HeapTest>>testSortUsing: (in category 'tests') ----- + testSortUsing: aHeap + + | random | + random := Random seed: 36rSqueak. + self assert: aHeap isValidHeap. + 1000 timesRepeat: [ + aHeap add: random next. + self assert: aHeap isValidHeap ]. + self deny: (aHeap asArray isSortedBy: aHeap sortBlock). + aHeap sort. + self assert: aHeap isValidHeap. + self assert: (aHeap asArray isSortedBy: aHeap sortBlock) + ! Item was added: + ----- Method: HeapTest>>testSortWithIndexUpdateBlock (in category 'tests') ----- + testSortWithIndexUpdateBlock + + | random heap validateHeap | + random := Random seed: 36rSqueak. + heap := Heap sortBlock: [ :a :b | a first <= b first ]. + heap indexUpdateBlock: [ :element :newIndex | element at: 2 put: newIndex ]. + validateHeap := [ + heap isHeap + and: [ heap isValidHeap + and: [ heap do: [ :each | self assert: (heap at: each second) == each ] ] ] ]. + validateHeap value. + 1000 timesRepeat: [ + heap add: { random next. nil }. + validateHeap value ]. + self deny: (heap asArray isSortedBy: heap sortBlock). + heap sort. + validateHeap value. + self assert: (heap asArray isSortedBy: heap sortBlock) + !

1 0

The Trunk: Collections-ul.696.mcz
by commits＠source.squeak.org 02 Jun '16

02 Jun '16

Levente Uzonyi uploaded a new version of Collections to project The Trunk: http://source.squeak.org/trunk/Collections-ul.696.mcz ==================== Summary ==================== Name: Collections-ul.696 Author: ul Time: 2 June 2016, 5:58:47.938458 pm UUID: 0ec3a2e6-cd17-46b2-970f-2c1dc1227411 Ancestors: Collections-ul.695 - added #quickSort and #quickSort: to ArrayedCollection =============== Diff against Collections-ul.695 =============== Item was added: + ----- Method: ArrayedCollection>>quickSort (in category 'sorting') ----- + quickSort + "Sort elements of self to be nondescending according to #<= using an in-place quicksort with simple median-of-three partitioning with guaranteed O(log(n)) space usage." + + self quickSortFrom: 1 to: self size by: nil! Item was added: + ----- Method: ArrayedCollection>>quickSort: (in category 'sorting') ----- + quickSort: sortBlock + "Sort elements of self to be nondescending according to sortBlock using an in-place quicksort with simple median-of-three partitioning with guaranteed O(log(n)) space usage." + + self quickSortFrom: 1 to: self size by: sortBlock!

1 0

The Trunk: Collections-ul.695.mcz
by commits＠source.squeak.org 02 Jun '16

02 Jun '16

Levente Uzonyi uploaded a new version of Collections to project The Trunk: http://source.squeak.org/trunk/Collections-ul.695.mcz ==================== Summary ==================== Name: Collections-ul.695 Author: ul Time: 2 June 2016, 5:48:18.403513 pm UUID: be1e0401-02a2-49e4-827f-fe0fee861114 Ancestors: Collections-topa.694 Heap revamp #1: class side: - Heaps can be created on an existing array with #on: #on:size: and #on:size:sortBlock: - #withAll: and #withAll:sortBlock: avoid creating an extra copy if the argument is already an Array instance side: - imported and improved #= from Pharo - #growTo: won't raise an error when newSize is less than array size (e.g. during compaction) - #sortBlock: restores the heap invariant on its own - improved #select:, #collect, #at:, #removeAt:, #add: - added #sort and #compact; compatible with other collections - #capacity returns the real capacity - inlined #sorts:before: and #indexUpdateBlock: for performance - improved performance and legibility of the heap operations #upHeap: #downHeap: and #downHeapSingle: - added #isValidHeap - added some comments =============== Diff against Collections-topa.694 =============== Item was added: + ----- Method: Heap class>>on: (in category 'instance creation') ----- + on: anArray + "Create a new heap using anArray as the internal array" + + ^self on: anArray size: anArray size sortBlock: nil! Item was added: + ----- Method: Heap class>>on:size: (in category 'instance creation') ----- + on: anArray size: size + "Create a new heap using the first size elements of anArray as the internal array" + + ^self + on: anArray + size: size + sortBlock: nil! Item was added: + ----- Method: Heap class>>on:size:sortBlock: (in category 'instance creation') ----- + on: anArray size: size sortBlock: aBlockOrNil + "Create a new heap using the first size elements of anArray as the internal array and sorted by aBlockOrNil" + + anArray isArray ifFalse: [ self error: 'Array expected.' ]. + anArray size < size ifTrue: [ self error: 'size must not be larger than anArray size' ]. + ^super new + setCollection: anArray tally: size; + sortBlock: aBlockOrNil; + yourself! Item was changed: ----- Method: Heap class>>withAll: (in category 'instance creation') ----- withAll: aCollection "Create a new heap with all the elements from aCollection" + + ^self withAll: aCollection sortBlock: nil! - ^(self basicNew) - setCollection: aCollection asArray copy tally: aCollection size; - reSort; - yourself! Item was changed: ----- Method: Heap class>>withAll:sortBlock: (in category 'instance creation') ----- withAll: aCollection sortBlock: sortBlock + "Create a new heap with all the elements from aCollection, sorted by sortBlock" + + | array | + array := aCollection asArray. + array == aCollection ifTrue: [ array := array copy ]. + ^self on: array size: array size sortBlock: sortBlock! - "Create a new heap with all the elements from aCollection" - ^(self basicNew) - setCollection: aCollection asArray copy tally: aCollection size; - sortBlock: sortBlock; - yourself! Item was changed: ----- Method: Heap>>= (in category 'comparing') ----- = anObject + "Heap are considered to be equal when they have the same sortBlock and the same elements. This method is expensive due to the sorted copies of the arrays. Try not to use it." + self == anObject ifTrue: [ ^true ]. + anObject isHeap ifFalse: [ ^false ]. + anObject size = tally ifFalse: [ ^false ]. + anObject sortBlock = sortBlock ifFalse: [ ^false ]. + ^((array first: tally) sort: sortBlock) = ((anObject array first: tally) sort: sortBlock)! - ^ self == anObject - ifTrue: [true] - ifFalse: [anObject isHeap - ifTrue: [sortBlock = anObject sortBlock and: [super = anObject]] - ifFalse: [super = anObject]]! Item was changed: ----- Method: Heap>>add: (in category 'adding') ----- add: anObject "Include newObject as one of the receiver's elements. Answer newObject." + tally = array size ifTrue:[self grow]. array at: (tally := tally + 1) put: anObject. + indexUpdateBlock ifNotNil: [ indexUpdateBlock value: anObject value: tally ]. - self updateObjectIndex: tally. self upHeap: tally. ^anObject! Item was changed: ----- Method: Heap>>at: (in category 'accessing') ----- at: index "Return the element at the given position within the receiver" + + index > tally ifTrue: [ ^self errorSubscriptBounds: index ]. - (index < 1 or:[index > tally]) ifTrue:[^self errorSubscriptBounds: index]. ^array at: index! Item was added: + ----- Method: Heap>>capacity (in category 'accessing') ----- + capacity + "Answer the current capacity of the receiver." + + ^array size! Item was changed: ----- Method: Heap>>collect: (in category 'enumerating') ----- collect: aBlock + + ^(array first: tally) replace: aBlock! - ^self collect: aBlock as: Array! Item was added: + ----- Method: Heap>>compact (in category 'growing') ----- + compact + "Remove any empty slots in the receiver." + + self growTo: self size.! Item was changed: ----- Method: Heap>>downHeap: (in category 'private-heap') ----- downHeap: anIndex "Check the heap downwards for correctness starting at anIndex. Everything above (i.e. left of) anIndex is ok." + + | childIndex childValue index value | + index := anIndex. - | value k n j | - anIndex = 0 ifTrue:[^self]. - n := tally bitShift: -1. - k := anIndex. value := array at: anIndex. + [ (childIndex := 2 * index) >= tally or: [ + "Select the child with the larger value. We know there are two children." + childValue := array at: childIndex. + (sortBlock + ifNil: [ (array at: childIndex + 1) <= childValue ] + ifNotNil: [ sortBlock value: (array at: childIndex + 1) value: childValue ]) + ifTrue: [ + childValue := array at: (childIndex := childIndex + 1) ]. + "Check if the value at index is at the right position." + sortBlock + ifNil: [ value <= childValue ] + ifNotNil: [ sortBlock value: value value: childValue ] ] ] + whileFalse: [ + "Move value downwards the tree." + array at: index put: childValue. + indexUpdateBlock ifNotNil: [ indexUpdateBlock value: childValue value: index ]. + "Contine from childIndex" + index := childIndex ]. + childIndex = tally ifTrue: [ "Special case: there's only one child." + "Check if the value at index is at the right position." + childValue := array at: childIndex. + (sortBlock + ifNil: [ value <= childValue ] + ifNotNil: [ sortBlock value: value value: childValue ]) + ifFalse: [ + "Move value downwards the tree." + array at: index put: childValue. + indexUpdateBlock ifNotNil: [ indexUpdateBlock value: childValue value: index ]. + "Contine from childIndex" + index := childIndex ] ]. + array at: index put: value. + indexUpdateBlock ifNotNil: [ indexUpdateBlock value: value value: index ]! - [k <= n] whileTrue:[ - j := k + k. - "use max(j,j+1)" - (j < tally and:[self sorts: (array at: j+1) before: (array at: j)]) - ifTrue:[ j := j + 1]. - "check if position k is ok" - (self sorts: value before: (array at: j)) - ifTrue:[ "yes -> break loop" - n := k - 1] - ifFalse:[ "no -> make room at j by moving j-th element to k-th position" - array at: k put: (array at: j). - self updateObjectIndex: k. - "and try again with j" - k := j]]. - array at: k put: value. - self updateObjectIndex: k.! Item was changed: ----- Method: Heap>>downHeapSingle: (in category 'private-heap') ----- downHeapSingle: anIndex "This version is optimized for the case when only one element in the receiver can be at a wrong position. It avoids one comparison at each node when travelling down the heap and checks the heap upwards after the element is at a bottom position. Since the probability for being at the bottom of the heap is much larger than for being somewhere in the middle this version should be faster." + + | childIndex index value | + index := anIndex. - | value k n j | - anIndex = 0 ifTrue:[^self]. - n := tally bitShift: -1. - k := anIndex. value := array at: anIndex. + [ (childIndex := 2 * index) < tally ] whileTrue:[ + "Select the child with the larger value. We know there are two children." + (sortBlock + ifNil: [ (array at: childIndex + 1) <= (array at: childIndex) ] + ifNotNil: [ sortBlock value: (array at: childIndex + 1) value: (array at: childIndex) ]) + ifTrue: [ childIndex := childIndex + 1 ]. + array at: index put: (array at: childIndex). + indexUpdateBlock ifNotNil: [ indexUpdateBlock value: (array at: index) value: index ]. + "and repeat at the next level" + index := childIndex ]. + childIndex = tally ifTrue: [ "Child with no sibling" + array at: index put: (array at: childIndex). + indexUpdateBlock ifNotNil: [ indexUpdateBlock value: (array at: index) value: index ]. + index := childIndex ]. + array at: index put: value. + indexUpdateBlock ifNotNil: [ indexUpdateBlock value: value value: index ]. + self upHeap: index! - [k <= n] whileTrue:[ - j := k + k. - "use max(j,j+1)" - (j < tally and:[self sorts: (array at: j+1) before: (array at: j)]) - ifTrue:[ j := j + 1]. - array at: k put: (array at: j). - self updateObjectIndex: k. - "and try again with j" - k := j]. - array at: k put: value. - self updateObjectIndex: k. - self upHeap: k! Item was changed: ----- Method: Heap>>growTo: (in category 'growing') ----- growTo: newSize "Grow to the requested size." + | newArray | newArray := Array new: (newSize max: tally). + newArray replaceFrom: 1 to: tally with: array startingAt: 1. - newArray replaceFrom: 1 to: array size with: array startingAt: 1. array := newArray! Item was changed: ----- Method: Heap>>indexUpdateBlock: (in category 'accessing') ----- indexUpdateBlock: aBlockOrNil + "aBlockOrNil is either nil or a two argument block. The first argument is the object whose index has changed in the heap, the second is the new index. The block will be evaluated whenever an element is moved in the heap's internal array. If you don't plan to remove elements by index (see #removeAt:), then you should not set this block." indexUpdateBlock := aBlockOrNil. ! Item was added: + ----- Method: Heap>>isValidHeap (in category 'testing') ----- + isValidHeap + + "Check the size first." + (tally between: 0 and: array size) ifFalse: [ ^false ]. + "Check the sort order between parent and child nodes." + 1 to: (tally bitShift: -1) do: [ :index | + | childIndex | + childIndex := 2 * index. + sortBlock + ifNil: [ (array at: index) <= (array at: childIndex) ifFalse: [ ^false ] ] + ifNotNil: [ (sortBlock value: (array at: index) value: (array at: childIndex)) ifFalse: [ ^false ] ]. + childIndex < tally ifTrue: [ + childIndex := childIndex + 1. + sortBlock + ifNil: [ (array at: index) <= (array at: childIndex) ifFalse: [ ^false ] ] + ifNotNil: [ (sortBlock value: (array at: index) value: (array at: childIndex)) ifFalse: [ ^false ] ] ] ]. + "Check for elements left in array after tally." + tally + 1 to: array size do: [ :index | + (array at: index) ifNotNil: [ ^false ] ]. + ^true! Item was changed: ----- Method: Heap>>privateRemoveAt: (in category 'private') ----- privateRemoveAt: index + "Remove the element at the given index and make sure the sorting order is okay. The value of index must not be larger than tally." + - "Remove the element at the given index and make sure the sorting order is okay" | removed | removed := array at: index. + index = tally ifTrue: [ + array at: index put: nil. + tally := tally - 1. + ^removed ]. + array + at: index put: (array at: tally); + at: tally put: nil. - array at: index put: (array at: tally). - array at: tally put: nil. tally := tally - 1. + 2 * index <= tally "The node at index has at least one child." + ifTrue: [ self downHeapSingle: index ] + ifFalse: [ self upHeap: index ]. - index > tally ifFalse:[ - "Use #downHeapSingle: since only one element has been removed" - self downHeapSingle: index]. ^removed! Item was changed: ----- Method: Heap>>privateReverseSort (in category 'private') ----- privateReverseSort "Arrange to have the array sorted in reverse order. WARNING: this method breaks the heap invariants. It's up to the sender to restore them afterwards." + | oldTally | + self deprecated: 'Use #sort if you want to sort.'. oldTally := tally. [tally > 1] whileTrue: [array swap: 1 with: tally. tally := tally - 1. self downHeapSingle: 1]. tally := oldTally! Item was changed: ----- Method: Heap>>removeAt: (in category 'removing') ----- removeAt: index + "Remove the element at the given index and make sure the sorting order is okay." + + index > tally ifTrue: [ self errorSubscriptBounds: index ]. - "Remove the element at given position" - (index < 1 or:[index > tally]) ifTrue:[^self errorSubscriptBounds: index]. ^self privateRemoveAt: index! Item was changed: ----- Method: Heap>>select: (in category 'enumerating') ----- select: aBlock "Evaluate aBlock with each of my elements as the argument. Collect into a new collection like the receiver, only those elements for which aBlock evaluates to true." | newCollection | newCollection := self copyEmpty. + 1 to: tally do: [ :index | + | element | + (aBlock value: (element := array at: index)) ifTrue: [ + newCollection add: element ] ]. - self do: - [:each | - (aBlock value: each) - ifTrue: [newCollection add: each]]. ^ newCollection! Item was added: + ----- Method: Heap>>sort (in category 'sorting') ----- + sort + "Fully sort the heap. This method preserves the heap invariants and can thus be sent safely" + + | start end element originalIndexUpdateBlock | + end := tally. + "Temporarly remove indexUpdateBlock to speed up sorting." + originalIndexUpdateBlock := indexUpdateBlock. + indexUpdateBlock := nil. + [ tally > 1 ] whileTrue: [ + element := array at: tally. + array + at: tally put: (array at: 1); + at: 1 put: element. + tally := tally - 1. + self downHeapSingle: 1 ]. + tally := end. + start := 1. + originalIndexUpdateBlock ifNil: [ + "The was no indexUpdateBlock; just reverse the elements" + [ start < end ] whileTrue: [ + element := array at: start. + array + at: start put: (array at: end); + at: end put: element. + start := start + 1. + end := end - 1 ]. + ^self ]. + "Restore indexUpdateBlock, reverse the elements and update the indices." + indexUpdateBlock := originalIndexUpdateBlock. + start := 1. + [ start < end ] whileTrue: [ + | endValue | + element := array at: start. + endValue := array at: end. + array + at: start put: endValue; + at: end put: element. + indexUpdateBlock + value: endValue value: start; + value: element value: end. + start := start + 1. + end := end - 1 ]. + start = end ifTrue: [ indexUpdateBlock value: (array at: start) value: start ]! Item was changed: ----- Method: Heap>>sortBlock: (in category 'accessing') ----- sortBlock: aBlock + + | oldIndexUpdateBlock | sortBlock := aBlock. + "Restore the heap invariant." + tally <= 1 ifTrue: [ ^self ]. + oldIndexUpdateBlock := indexUpdateBlock. + indexUpdateBlock := nil. + (tally bitShift: -1) to: 1 by: -1 do: [ :index | self downHeap: index ]. + indexUpdateBlock := oldIndexUpdateBlock ifNil: [ ^self ]. + 1 to: tally do: [ :index | + indexUpdateBlock value: (array at: index) value: index ] + + ! - self reSort.! Item was changed: ----- Method: Heap>>upHeap: (in category 'private-heap') ----- upHeap: anIndex "Check the heap upwards for correctness starting at anIndex. Everything below anIndex is ok." + + | index parentValue parentIndex value | + anIndex = 1 ifTrue: [ ^self ]. + value := array at: (index := anIndex). + [ index > 1 and: [ + parentValue := array at: (parentIndex := index bitShift: -1). + sortBlock + ifNil: [ value <= parentValue ] + ifNotNil: [ sortBlock value: value value: parentValue ] ] ] + whileTrue: [ + array at: index put: parentValue. + indexUpdateBlock ifNotNil: [ indexUpdateBlock value: parentValue value: index ]. + index := parentIndex ]. + array at: index put: value. + indexUpdateBlock ifNotNil: [ indexUpdateBlock value: value value: index ]! - | value k kDiv2 tmp | - anIndex = 0 ifTrue:[^self]. - k := anIndex. - value := array at: anIndex. - [ (k > 1) and:[self sorts: value before: (tmp := array at: (kDiv2 := k bitShift: -1))] ] - whileTrue:[ - array at: k put: tmp. - self updateObjectIndex: k. - k := kDiv2]. - array at: k put: value. - self updateObjectIndex: k.!

1 0

Re: [squeak-dev] The Inbox: Compiler-cmm.323.mcz
by Levente Uzonyi 02 Jun '16

02 Jun '16

If you have a look at the diff here, you'll see why using the pretty printer is such a bad idea: > Item was changed: > ----- Method: BraceNode>>printOn:indent: (in category 'printing') ----- > + printOn: aStream indent: level > - printOn: aStream indent: level > - > aStream nextPut: ${. > + 1 > + to: elements size > + do: > + [ : i | > + (elements at: i) > + printOn: aStream > + indent: level. > + i < elements size ifTrue: > + [ aStream > + nextPutAll: '. ' ; > + crtab: level ] ]. > - 1 to: elements size do: > - [:i | (elements at: i) printOn: aStream indent: level. > - i < elements size ifTrue: [aStream nextPutAll: '. ']]. > aStream nextPut: $}! Levente

1 0

The Inbox: Compiler-cmm.323.mcz
by commits＠source.squeak.org 02 Jun '16

02 Jun '16

A new version of Compiler was added to project The Inbox: http://source.squeak.org/inbox/Compiler-cmm.323.mcz ==================== Summary ==================== Name: Compiler-cmm.323 Author: cmm Time: 1 June 2016, 8:27:43.294651 pm UUID: 4dce5d55-dae2-416b-bbbc-41b4520dd577 Ancestors: Compiler-eem.322 Kent Beckian style "Rectangular Block" pretty printing. =============== Diff against Compiler-eem.322 =============== Item was added: + ----- Method: AssignmentNode>>isComplex (in category 'testing') ----- + isComplex + ^ value isComplex! Item was changed: ----- Method: AssignmentNode>>printOn:indent: (in category 'printing') ----- printOn: aStream indent: level variable printOn: aStream indent: level. aStream nextPutAll: ' := '. + value printOn: aStream indent: level! - value printOn: aStream indent: level + 2! Item was changed: ----- Method: BlockNode>>isComplex (in category 'testing') ----- isComplex + ^ statements size > 1 or: + [ (statements size = 1 and: [ statements first isComplex ]) or: + [ arguments size > 0 or: [ temporaries size > 0 ] ] ]! - - ^statements size > 1 or: [statements size = 1 and: [statements first isComplex]]! Item was changed: ----- Method: BlockNode>>printArgumentsOn:indent: (in category 'printing') ----- + printArgumentsOn: aStream indent: level - printArgumentsOn: aStream indent: level arguments size = 0 ifTrue: [^ self]. + arguments do: + [ : arg | + aStream nextPut: $: ; + " space;" + nextPutAll: arg key"; + space" ]. + aStream + space ; + nextPut: $|; + space! - arguments do: - [:arg | aStream nextPut: $:; nextPutAll: arg key; space]. - aStream nextPut: $|; space. - "If >0 args and >1 statement, put all statements on separate lines" - statements size > 1 ifTrue: - [aStream crtab: level]! Item was changed: ----- Method: BlockNode>>printOn:indent: (in category 'printing') ----- + printOn: aStream indent: level + aStream + nextPut: $[ "; + space". + self + printArgumentsOn: aStream + indent: level. + (self + printTemporaries: temporaries + on: aStream + doPrior: [ ] ) ifTrue: + [ "If >0 temps and >1 statement, put all statements on separate lines" + statements size > 1 + ifTrue: [ aStream crtab: level ] + ifFalse: [ aStream space] ] . + self + printStatementsOn: aStream + indent: level. + aStream + " space ;" + nextPut: $]! - printOn: aStream indent: level - - "statements size <= 1 ifFalse: [aStream crtab: level]." - aStream nextPut: $[. - self printArgumentsOn: aStream indent: level. - (self printTemporaries: temporaries on: aStream doPrior: []) ifTrue: - ["If >0 temps and >1 statement, put all statements on separate lines" - statements size > 1 - ifTrue: [aStream crtab: level] - ifFalse: [aStream space]]. - self printStatementsOn: aStream indent: level. - aStream nextPut: $]! Item was changed: ----- Method: BlockNode>>printWithClosureAnalysisArgumentsOn:indent: (in category 'printing') ----- printWithClosureAnalysisArgumentsOn: aStream indent: level arguments size = 0 ifTrue: [^self]. arguments do: [:tempNode | + aStream "space;" nextPut: $:. - aStream space; nextPut: $:. tempNode printDefinitionForClosureAnalysisOn: aStream]. + aStream nextPut: $|"; space". - aStream nextPut: $|; space. "If >0 args and >1 statement, put all statements on separate lines" statements size > 1 ifTrue: [aStream crtab: level]! Item was changed: ----- Method: BlockNode>>printWithClosureAnalysisOn:indent: (in category 'printing') ----- printWithClosureAnalysisOn: aStream indent: level + aStream nextPut: $["; space". - aStream nextPut: $[. blockExtent ifNotNil: [aStream print: blockExtent]. self printWithClosureAnalysisArgumentsOn: aStream indent: level. self printWithClosureAnalysisTemporariesOn: aStream indent: level. self printWithClosureAnalysisStatementsOn: aStream indent: level. + aStream "space;" nextPut: $]! - aStream nextPut: $]! Item was changed: ----- Method: BlockNode>>printWithClosureAnalysisTemporariesOn:indent: (in category 'printing') ----- + printWithClosureAnalysisTemporariesOn: aStream indent: level - printWithClosureAnalysisTemporariesOn: aStream indent: level - (temporaries == nil or: [temporaries size = 0]) ifFalse: [aStream nextPut: $|. + temporaries + do: + [: tempNode | tempNode printDefinitionForClosureAnalysisOn: aStream] + separatedBy: [aStream space]. + aStream nextPutAll: '|'. - temporaries do: - [:tempNode | - aStream space. - tempNode printDefinitionForClosureAnalysisOn: aStream]. - aStream nextPutAll: ' | '. "If >0 args and >1 statement, put all statements on separate lines" statements size > 1 ifTrue: [aStream crtab: level]]! Item was changed: ----- Method: BraceNode>>printOn:indent: (in category 'printing') ----- + printOn: aStream indent: level - printOn: aStream indent: level - aStream nextPut: ${. + 1 + to: elements size + do: + [ : i | + (elements at: i) + printOn: aStream + indent: level. + i < elements size ifTrue: + [ aStream + nextPutAll: '. ' ; + crtab: level ] ]. - 1 to: elements size do: - [:i | (elements at: i) printOn: aStream indent: level. - i < elements size ifTrue: [aStream nextPutAll: '. ']]. aStream nextPut: $}! Item was added: + ----- Method: CascadeNode>>isComplex (in category 'testing') ----- + isComplex + ^ true! Item was changed: ----- Method: CascadeNode>>printOn:indent:precedence: (in category 'printing') ----- printOn: aStream indent: level precedence: p + p > 0 ifTrue: [ aStream nextPut: $( ]. + messages first + printReceiver: receiver + on: aStream + indent: level. + 1 + to: messages size + do: + [ : i | + aStream crtab: level + 1. + (messages at: i) + printOn: aStream + indent: level. + i < messages size ifTrue: [ aStream nextPutAll: ' ;' ] ]. + p > 0 ifTrue: [ aStream nextPut: $) ]! - - p > 0 ifTrue: [aStream nextPut: $(]. - messages first printReceiver: receiver on: aStream indent: level. - 1 to: messages size do: - [:i | (messages at: i) printOn: aStream indent: level. - i < messages size ifTrue: - [aStream nextPut: $;. - messages first precedence >= 2 ifTrue: [aStream crtab: level + 1]]]. - p > 0 ifTrue: [aStream nextPut: $)]! Item was changed: ----- Method: MessageNode>>isComplex (in category 'testing') ----- isComplex + ^ (special + between: 1 + and: 10) + or: + [ arguments size > 1 + or: + [ receiver isComplex or: [ arguments anySatisfy: [ : each | each isComplex ] ] ] ]! - - ^(special between: 1 and: 10) or: [arguments size > 2 or: [receiver isComplex]]! Item was changed: ----- Method: MessageNode>>printIfOn:indent: (in category 'printing') ----- + printIfOn: aStream indent: level + receiver ifNotNil: + [ receiver + printOn: aStream + indent: level + precedence: precedence ]. + (arguments last isJust: NodeNil) ifTrue: [ ^ self + printKeywords: #ifTrue: + arguments: (Array with: arguments first) + on: aStream + indent: level ]. + (arguments last isJust: NodeFalse) ifTrue: [ ^ self + printKeywords: #and: + arguments: (Array with: arguments first) + on: aStream + indent: level ]. + (arguments first isJust: NodeNil) ifTrue: [ ^ self + printKeywords: #ifFalse: + arguments: (Array with: arguments last) + on: aStream + indent: level ]. + (arguments first isJust: NodeTrue) ifTrue: [ ^ self + printKeywords: #or: + arguments: (Array with: arguments last) + on: aStream + indent: level ]. + self + printKeywords: #ifTrue:ifFalse: + arguments: arguments + on: aStream + indent: level! - printIfOn: aStream indent: level - - receiver ifNotNil: - [receiver printOn: aStream indent: level + 1 precedence: precedence]. - (arguments last isJust: NodeNil) ifTrue: - [^self printKeywords: #ifTrue: arguments: (Array with: arguments first) - on: aStream indent: level]. - (arguments last isJust: NodeFalse) ifTrue: - [^self printKeywords: #and: arguments: (Array with: arguments first) - on: aStream indent: level]. - (arguments first isJust: NodeNil) ifTrue: - [^self printKeywords: #ifFalse: arguments: (Array with: arguments last) - on: aStream indent: level]. - (arguments first isJust: NodeTrue) ifTrue: - [^self printKeywords: #or: arguments: (Array with: arguments last) - on: aStream indent: level]. - self printKeywords: #ifTrue:ifFalse: arguments: arguments - on: aStream indent: level! Item was changed: ----- Method: MessageNode>>printKeywords:arguments:on:indent: (in category 'printing') ----- + printKeywords: key arguments: args on: aStream indent: level - printKeywords: key arguments: args on: aStream indent: level | keywords indent arg kwd doCrTab | args size = 0 ifTrue: + [ aStream + space ; + nextPutAll: key. + ^ self ]. - [aStream space; nextPutAll: key. - ^self]. keywords := key keywords. + doCrTab := args size > 1. + 1 + to: (args size min: keywords size) + do: + [ : i | arg := args at: i. + kwd := keywords at: i. + doCrTab + ifTrue: + [ aStream crtab: level + 1. + indent := 1 + "newline after big args" ] + ifFalse: + [ aStream space. + indent := 0 ]. + aStream nextPutAll: kwd. + arg isComplex + ifTrue: [ aStream crtab: level + indent + 1 ] + ifFalse: [ aStream space ]. + arg + printOn: aStream + indent: level + 1 + indent + precedence: + (precedence = 2 + ifTrue: [ 1 ] + ifFalse: [ precedence ]) ]! - doCrTab := args size > 2 - or: [{receiver} , args anySatisfy: - [:thisArg | - thisArg notNil - and: [thisArg isBlockNode - or: [thisArg isMessageNode and: [thisArg precedence >= 3]]]]]. - 1 to: (args size min: keywords size) do: - [:i | - arg := args at: i. - kwd := keywords at: i. - doCrTab - ifTrue: [aStream crtab: level+1. indent := 1] "newline after big args" - ifFalse: [aStream space. indent := 0]. - aStream nextPutAll: kwd; space. - arg printOn: aStream - indent: level + 1 + indent - precedence: (precedence = 2 ifTrue: [1] ifFalse: [precedence])]! Item was changed: ----- Method: ParseNode>>printSingleComment:on:indent: (in category 'private') ----- printSingleComment: aString on: aStream indent: indent + "Print the comment string, assuming it has been indented indent tabs. Break the string at word breaks, given the widths in the default font, at 450 points." + aStream nextPutAll: aString! - "Print the comment string, assuming it has been indented indent tabs. - Break the string at word breaks, given the widths in the default - font, at 450 points." - - | readStream word position lineBreak font wordWidth tabWidth spaceWidth lastChar | - readStream := ReadStream on: aString. - font := TextStyle default defaultFont. - tabWidth := TextConstants at: #DefaultTab. - spaceWidth := font widthOf: Character space. - position := indent * tabWidth. - lineBreak := 450. - [readStream atEnd] - whileFalse: - [word := self nextWordFrom: readStream setCharacter: [:lc | lastChar := lc]. - wordWidth := word inject: 0 into: [:width :char | width + (font widthOf: char)]. - position := position + wordWidth. - position > lineBreak - ifTrue: - [aStream skip: -1; crtab: indent. - position := indent * tabWidth + wordWidth + spaceWidth. - lastChar = Character cr - ifTrue: [[readStream peekFor: Character tab] whileTrue]. - word isEmpty ifFalse: [aStream nextPutAll: word; space]] - ifFalse: - [aStream nextPutAll: word. - readStream atEnd - ifFalse: - [position := position + spaceWidth. - aStream space]. - lastChar = Character cr - ifTrue: - [aStream skip: -1; crtab: indent. - position := indent * tabWidth. - [readStream peekFor: Character tab] whileTrue]]]!

1 0

Daily Commit Log
by commits＠source.squeak.org 01 Jun '16

01 Jun '16

Changes to Trunk (http://source.squeak.org/trunk.html) in the last 24 hours: http://lists.squeakfoundation.org/pipermail/packages/2016-June/068159.html Name: Collections-topa.694 Ancestors: Collections-mt.693 provide some sample text in Text ============================================= http://lists.squeakfoundation.org/pipermail/packages/2016-June/068160.html Name: Graphics-topa.340 Ancestors: Graphics-bf.339 All fonts should know whether they have a glyph. Also, provide a sample text styled with a font. ============================================= http://lists.squeakfoundation.org/pipermail/packages/2016-June/068161.html Name: Morphic-topa.1155 Ancestors: Morphic-mt.1154 Let the fonts provide their sample ============================================= http://lists.squeakfoundation.org/pipermail/packages/2016-June/068162.html Name: Multilingual-topa.213 Ancestors: Multilingual-pre.212 All fonts should know whether they have a glyph. ============================================= http://lists.squeakfoundation.org/pipermail/packages/2016-June/068163.html Name: TrueType-topa.42 Ancestors: TrueType-topa.41 All fonts should know whether they have a glyph. For the way TT fonts currently work, this information is tricky to get, tho. ============================================= http://lists.squeakfoundation.org/pipermail/packages/2016-June/068164.html Name: Morphic-mt.1156 Ancestors: Morphic-topa.1155 If #mouseOverForKeyboardFocus is disabled, do not highlight (a.k.a. "look focused") background windows on mouse-enter, even if they are active due to the preference "Windows' Contents Are Always Active". Note that there is still a bug, which I intend to fix if the event filters make it into the trunk. Namely, if you "debug it" and expression via the context menu, the appearing debugger will not be the top window. An additional click is required. Sorry for this inconvenience. ============================================= http://lists.squeakfoundation.org/pipermail/packages/2016-June/068165.html Name: ToolBuilder-Morphic-mt.165 Ancestors: ToolBuilder-Morphic-cmm.164 Our list choosers use system windows. Request input for specific data. Use that to update the current keyboard focus. See #update:with: in pluggable list and text morphs. ============================================= http://lists.squeakfoundation.org/pipermail/packages/2016-June/068166.html Name: Morphic-mt.1157 Ancestors: Morphic-mt.1156 Grab the keyboard focus if models request that. Models have to use the respective selectors (get or set) so that the correct widget will grab the keyboard focus. ============================================= http://lists.squeakfoundation.org/pipermail/packages/2016-June/068167.html Name: Graphics-topa.341 Ancestors: Graphics-topa.340 Let text styels present themselves =============================================

1 0

The Trunk: Graphics-topa.341.mcz
by commits＠source.squeak.org 01 Jun '16

01 Jun '16

Tobias Pape uploaded a new version of Graphics to project The Trunk: http://source.squeak.org/trunk/Graphics-topa.341.mcz ==================== Summary ==================== Name: Graphics-topa.341 Author: topa Time: 1 June 2016, 11:41:14.5378 pm UUID: 6b532963-62f7-4713-8668-99d5d3c7fc5f Ancestors: Graphics-topa.340 Let text styels present themselves =============== Diff against Graphics-topa.340 =============== Item was added: + ----- Method: TextStyle>>asStringOrText (in category 'accessing') ----- + asStringOrText + "be fancy" + ^ self defaultFont familyName asText + addAttribute: (TextFontReference toFont: self defaultFont); + yourself!

1 0

Re: The Inbox: Compiler-cmm.179.mcz
by marcel.taeumel 01 Jun '16

01 Jun '16

Hi Chris, I would call this rather "different" than "improved". I think that we would benefit from a configurable pretty printer. There are a bunch of acceptable Smalltalk code styles out there. There is no such thing as the one best formatting. For example, I do prefer this style somePredicate ifTrue: [ something. something] ifFalse: [ something. something]. ... over this style: somePredicate ifTrue: [ something. something ] ifFalse: [ something. something ]. Or something like that. Too much spaces. Complicated position of parentheses. I can come up a number of reasons. Hence, I think that there are many Smalltalkers out there, that also have their own style. Sometimes this seems even more readable: somePredicate ifTrue: [something. something] ifFalse: [something. something]. Sure, we have some official books that suggest some code formatting. Personally, I would prefer a configure system where I can read and write the code in the way I feel most productive. :-) Just my two cents. Best, Marcel -- View this message in context: http://forum.world.st/The-Inbox-Compiler-cmm-179-mcz-tp4898674p4898688.html Sent from the Squeak - Dev mailing list archive at Nabble.com.

2 1

Jump to page: