Squeak-dev November 2020

squeak-dev@lists.squeakfoundation.org

31 participants
223 discussions

The Inbox: System-ct.1149.mcz
by commits＠source.squeak.org 14 Apr '21

14 Apr '21

Christoph Thiede uploaded a new version of System to project The Inbox: http://source.squeak.org/inbox/System-ct.1149.mcz ==================== Summary ==================== Name: System-ct.1149 Author: ct Time: 29 March 2020, 1:35:58.40756 pm UUID: 1bf6e87f-fc73-7747-af4d-df3e339a0627 Ancestors: System-ul.1148 Proposal: Add some convenience methods for debugging blocks. See examples in #debugFromContextThat:title:. While I know that we already talked about the sense of convenience methods that are not actually used in the base system, I think that these ones actually add value and should be used in the base system. We are experiencing an ascending number of methods that implement "debugging of a specific action", such as "debug action" and "debug get-list invocation" in Morphic, or "debug test" in SUnit (see SUnit-ct.125). As they have little duplication at the moment, it is also hard to make them more convenient: For example, if you try to debug a test case that overrides #performTest in a way that it does not actually invoke the test selector; or for another example, if you try to debug the action of a morphic button that we do not support properly at the moment (e. g. the buttons in a UserDialogBox), the current approach opens a debugger on a terminated process on #newProcess. If we follow this suggestion to refactor that behavior into one place, this will allow us to be a bit smarter and mo re convenient, as you can see in the edge case in #debugFromContextThat:title:. My follow-up proposal would thus be to call this convenience methods from all implementors of #debugAction & Co. This commit also tries to solve the issue mentioned in [1]. However, I'm not sure whether BlockClosure is the optimal place for this. I am open for your suggestions to move this somewhere else, for example into Debugger, Process or ToolSet. [1] http://forum.world.st/The-Inbox-Morphic-ct-1590-mcz-tp5106996p5107059.html =============== Diff against System-ul.1148 =============== Item was added: + ----- Method: BlockClosure>>debug (in category '*System-debugging') ----- + debug + + ^ self debugWithTitle: nil! Item was added: + ----- Method: BlockClosure>>debugFromContextThat: (in category '*System-debugging') ----- + debugFromContextThat: contextBlock + + ^ self debugFromContextThat: contextBlock title: nil! Item was added: + ----- Method: BlockClosure>>debugFromContextThat:title: (in category '*System-debugging') ----- + debugFromContextThat: contextBlock title: title + "Evaluate the receiver on a new process (synchronously). Once the contextBlock criterium is satisfied, open a debugger on that process. If the criterium is never satisfied until the process terminates, offer the user to debug the receiver again without waiting for contextBlock again. + + [self halt] debug. + [15 factorial] debugWithTitle: 'Fun with Math!!'. + [self inform: #foo] debugFromContextThat: [:ctxt | ctxt receiver isMorph] title: 'Debug dialog invocation'. + [15 factorial] debugFromContextThat: [:ctxt | ctxt selector = #+]." + + | process | + process := self newProcess. + process runUntil: contextBlock. + process isTerminated ifTrue: [ + ^ (self confirm: 'Did not reach the desired piece of code.\Would you like to debug the whole process again?' withCRs translated) + ifTrue: [self debugWithTitle: title] + ifFalse: [self]]. + ^ process debugWithTitle: title! Item was added: + ----- Method: BlockClosure>>debugWithTitle: (in category '*System-debugging') ----- + debugWithTitle: title + + ^ self + debugFromContextThat: [:ctx | ctx closure == self] + title: title!

2 1

Problems with #caseError
by Thiede, Christoph 28 Mar '21

28 Mar '21

Hi all, there are two problems with #caseError. First one: Given the following example, you will receive a confusing error message: #foo caseOf: {[#bar] -> [2]. [#baz] -> [3]} "--> Error: Case not found (nil), and no otherwise clause" Either #caseError should be called on #foo, then this would be compiler bug. Otherwise, I don't see any reason to print out the receiver. We could also name it #caseError: anObject and print out this object, but the current message is not helpful IMO ... Second one: I'm not sure whether it is expected behavior how #allLiterals works on the following example: method := Compiler new compiledMethodFor: '#bar caseOf: {[#bar] -> [2]}' in: nil to: nil notifying: nil ifFail: nil. method allLiterals. "--> #(#caseError #bar #caseOf:)"

4 9

The Inbox: Tools-ct.1015.mcz
by commits＠source.squeak.org 11 Mar '21

11 Mar '21

Christoph Thiede uploaded a new version of Tools to project The Inbox: http://source.squeak.org/inbox/Tools-ct.1015.mcz ==================== Summary ==================== Name: Tools-ct.1015 Author: ct Time: 1 November 2020, 3:58:41.62325 pm UUID: 0f1723d1-90c5-ca4e-88ad-56f6800b2b17 Ancestors: Tools-tpr.1014 Beautify CodeHolder >> #annotationForSelector:ofClass: implementation and output. Remove dangling separator character and add multilingual support. Example - before: mt 2/13/2020 13:49 · running · 2 implementors · in change sets: Morphic-pre.1466 Morphic-mt.1507 Morphic-mt.1607 Morphic-cmm.1617 Morphic-mt.1622 · Example - after: mt 2/13/2020 13:49 · running · 2 implementors · in change sets: Morphic-pre.1466, Morphic-mt.1507, Morphic-mt.1607, Morphic-cmm.1617 and Morphic-mt.1622 =============== Diff against Tools-tpr.1014 =============== Item was changed: ----- Method: CodeHolder>>annotationForSelector:ofClass: (in category 'annotation') ----- annotationForSelector: aSelector ofClass: aClass "Provide a line of content for an annotation pane, representing information about the given selector and class" | separator aStream requestList | aSelector == #Comment ifTrue: [^ self annotationForClassCommentFor: aClass]. aSelector == #Definition ifTrue: [^ self annotationForClassDefinitionFor: aClass]. aSelector == #Hierarchy ifTrue: [^ self annotationForHierarchyFor: aClass]. aStream := (String new: 512) writeStream. requestList := self annotationRequests. + separator := self annotationSeparator. - separator := requestList size > 1 - ifTrue: [self annotationSeparator] - ifFalse: ['']. requestList do: [:aRequest | | aString sendersCount aComment aCategory implementorsCount aList stamp authorInitials | aRequest == #firstComment ifTrue: [aComment := aClass firstCommentAt: aSelector. aComment isEmptyOrNil + ifFalse: [aStream nextPutAll: aComment]]. - ifFalse: [aStream nextPutAll: aComment , separator]]. aRequest == #masterComment ifTrue: [aComment := aClass supermostPrecodeCommentFor: aSelector. aComment isEmptyOrNil + ifFalse: [aStream nextPutAll: aComment]]. - ifFalse: [aStream nextPutAll: aComment , separator]]. aRequest == #documentation ifTrue: [aComment := aClass precodeCommentOrInheritedCommentFor: aSelector. aComment isEmptyOrNil + ifFalse: [aStream nextPutAll: aComment]]. - ifFalse: [aStream nextPutAll: aComment , separator]]. aRequest == #timeStamp ifTrue: [stamp := self timeStamp. aStream + nextPutAll: (stamp ifEmpty: ['no timeStamp' translated])]. - nextPutAll: (stamp size > 0 - ifTrue: [stamp , separator] - ifFalse: ['no timeStamp' , separator])]. aRequest == #author ifTrue: [authorInitials := self timeStamp findTokens ifEmpty: [''] ifNotEmpty: [:tokens | tokens first]. aStream nextPutAll: (SystemNavigation authorsInverted at: authorInitials ifPresent: [:fullNames | fullNames anyOne] ifAbsent: ['unknown author']), separator]. aRequest == #messageCategory ifTrue: [aCategory := aClass organization categoryOfElement: aSelector. aCategory ifNotNil: ["woud be nil for a method no longer present, e.g. in a recent-submissions browser" + aStream nextPutAll: aCategory]]. - aStream nextPutAll: aCategory , separator]]. aRequest == #sendersCount ifTrue: [sendersCount := (self systemNavigation allCallsOn: aSelector) size. sendersCount := sendersCount = 1 + ifTrue: ['1 sender' translated] + ifFalse: ['{1} senders' translated format: {sendersCount}]. + aStream nextPutAll: sendersCount]. - ifTrue: ['1 sender'] - ifFalse: [sendersCount printString , ' senders']. - aStream nextPutAll: sendersCount , separator]. aRequest == #implementorsCount ifTrue: [implementorsCount := self systemNavigation numberOfImplementorsOf: aSelector. implementorsCount := implementorsCount = 1 + ifTrue: ['1 implementor' translated] + ifFalse: ['{1} implementors' translated format: {implementorsCount}]. + aStream nextPutAll: implementorsCount]. - ifTrue: ['1 implementor'] - ifFalse: [implementorsCount printString , ' implementors']. - aStream nextPutAll: implementorsCount , separator]. aRequest == #priorVersionsCount ifTrue: [self addPriorVersionsCountForSelector: aSelector ofClass: aClass to: aStream]. aRequest == #priorTimeStamp ifTrue: [stamp := VersionsBrowser timeStampFor: aSelector class: aClass reverseOrdinal: 2. stamp + ifNotNil: [aStream nextPutAll: 'prior time stamp: ' translated , stamp]]. - ifNotNil: [aStream nextPutAll: 'prior time stamp: ' , stamp , separator]]. aRequest == #recentChangeSet ifTrue: [aString := ChangesOrganizer mostRecentChangeSetWithChangeForClass: aClass selector: aSelector. + aStream nextPutAll: aString]. - aString size > 0 - ifTrue: [aStream nextPutAll: aString , separator]]. aRequest == #allChangeSets ifTrue: [aList := ChangesOrganizer allChangeSetsWithClass: aClass selector: aSelector. + aList + ifNotEmpty: [aList size = 1 + ifTrue: [aStream nextPutAll: 'only in change set ' translated] + ifFalse: [aStream nextPutAll: 'in change sets: ' translated]. + aStream nextPutAll: (aList collect: + [:changeSet | changeSet name]) asCommaStringAnd] + ifEmpty: [aStream nextPutAll: 'in no change set' translated]]] + separatedBy: [ + aStream nextPutAll: separator]. - aList size > 0 - ifTrue: [aList size = 1 - ifTrue: [aStream nextPutAll: 'only in change set '] - ifFalse: [aStream nextPutAll: 'in change sets: ']. - aList - do: [:aChangeSet | aStream nextPutAll: aChangeSet name , ' ']] - ifFalse: [aStream nextPutAll: 'in no change set']. - aStream nextPutAll: separator]]. ^ aStream contents!

3 2

Proposal: Geometry Classes
by patrick.rein＠hpi.uni-potsdam.de 11 Mar '21

11 Mar '21

Hi everyone, during some recent clean-up an issue with geometry objects came up. As a result the following idea came up which I thereby would like to put out for an initial discussion. In case we find that this might be useful, I would continue by implementing a first prototype of the package as a foundation of a more in-depth discussion later on. Bests Patrick # Squeak Change Proposal - Geometry Package ## Why? Squeak implements basic geometry logic in too many different places. For example intersection of different kinds of geometric objects is implemented all over Morphic, ST80, Balloon, Graphics, and Etoys. Such extensive scattering across packages and classes impedes modularity, that is, readability and extensibility. An example for this recently came up when we discovered an issue with testing for graphical intersections between PolygonMorph and RectangleMorph. It was not possible to compute that overlapping area because the class Rectangle omits to provide an important method. A quick fix would entail unnecessary dependencies (here: Morphic -> Balloon) or duplicated code (see also http://bugs.squeak.org/view.php?id=7872). Consequently, we might want to modularize the geometry objects and operations. As a side effect, dependent packages such as Morphic can be simplified a little bit (more). ## Scope The proposed package should cover basic 2D geometric objects and their operations represented by the following classes: - Point - Line - LineSegment - Polygon - Rectangle (as an optimization as it could be represented as a special Polygon already) Most classes could simply be moved from their previous packages. Afterwards the interfaces would need to be made consistent with each other to allow interoperability of all geometry classes within the new package. ### Affected classes: - All classes in ST80-Paths - LineSegement, Bezier2Segment, Bezier3Segment (Balloon-Geometry) - Rectangle, Quadrangle, Point (Graphics-Primitives) - LineIntersections, LineIntersectionSegment, LineIntersectionEvent (Etoys-Squeakland-Graphics-Tools-Intersection) ## Open questions - Should this become a single new package or a subcategory in the Graphics package? - Should the package contain an Ellipses class? - Should we model curved line segments as BezierLineSegments, CurvedLineSegment, or Arc? ## Risks - This would potentially deprecate the existing ST80 geometry classes (ST80-Paths) - Some of the new classes will cause name clashes with existing classes. For example Line is currently in ST-80 and represents a line segment, and the class LineSegment is a line segment but not in the geometric sense as it also incorporates arcs. Both names might then be used by new classes with different meanings. This might be mitigated by introducing a pre-/postfix for the names of the new classes.

6 16

find original change set
by Javier Orsaria 09 Mar '21

09 Mar '21

Hi, I was trying to use, in VersionsBrowser, the feature "find original change set" for a method. In old versions (3.8 and earlier) this work fine. But in 3.10 and 3.9 don´t. I followed the sequence and detect the problem at MethodChangeRecord-noteNewMethod: noteNewMethod: newMethod "NEVER do this. It is evil." currentMethod _ nil. should be: noteNewMethod: newMethod "NEVER do this. It is evil." currentMethod _ newMethod. This way work as I expect. But with that comment I understand was intentioned. What is the problem with this? I can´t see it... I'm the devil? Thanks, Javier

3 2

[Test][Squeak5.2rc1][SqueakMap] FFI entry in SqueakMap catalog for 5.2?
by H. Hirzel 12 Jan '21

12 Jan '21

Hello All tests Loading FFI into Sque The load script for FFI is 'community supported' in SqueakMap. The relevant FFI entry has as load script is just Installer new merge: #ffiTests This still applies for 5.2. However the last time FFI shows up in the SqueakMap client list for a particular release is version 4.5. Not in 4.6, 5.0 and 5.1 What do I need to do to make it appear in the list for 5.2. Creating a release for 5.2 would be an option but that seems unnecessary as it had not been done for 4.5 either. Suggestions how to proceed? Regards Hannes

7 23

The Trunk: Files-eem.184.mcz
by commits＠source.squeak.org 08 Jan '21

08 Jan '21

Eliot Miranda uploaded a new version of Files to project The Trunk: http://source.squeak.org/trunk/Files-eem.184.mcz ==================== Summary ==================== Name: Files-eem.184 Author: eem Time: 29 November 2020, 10:24:50.876717 am UUID: 453a229c-9b4d-4acb-b8ba-c0688fc17020 Ancestors: Files-pre.183 Add a guard to FileDirectory class>>requestDropDirectory:. Every time I connect my headphone buds I get an MNU because primDropRequestFileName: answers nil. This squashes the MNU. =============== Diff against Files-pre.183 =============== Item was changed: ----- Method: FileDirectory class>>requestDropDirectory: (in category 'dnd requests') ----- requestDropDirectory: dropIndex + ^(FileStream primDropRequestFileName: dropIndex) ifNotNil: + [:dropFileDirdectoryName| | potentialDirectory | + potentialDirectory := self on: dropFileDirdectoryName. + potentialDirectory exists ifTrue: [potentialDirectory]]! - | potentialDirectory | - potentialDirectory := self on: (FileStream primDropRequestFileName: dropIndex). - ^ potentialDirectory exists ifTrue: [potentialDirectory] - !

3 2

The Inbox: System-mt.1175.mcz
by commits＠source.squeak.org 17 Dec '20

17 Dec '20

A new version of System was added to project The Inbox: http://source.squeak.org/inbox/System-mt.1175.mcz ==================== Summary ==================== Name: System-mt.1175 Author: mt Time: 29 September 2020, 1:16:45.233157 pm UUID: f0acc060-a48b-2c4f-8b56-aaf2f55601b4 Ancestors: System-topa.1174 Adds a way to compute a space tally for objects up to a certain depth. Questions: - Is the interface (i.e. "depth" and "seen") OK? - Is the use of IdentitySet OK? - Can we speed this up somehow? - Do we need depth-messages for the "class analysis" protocol, too? =============== Diff against System-topa.1174 =============== Item was added: + ----- Method: SpaceTally>>spaceForInstance:depth: (in category 'instance size') ----- + spaceForInstance: anObject depth: anInteger + + ^ self spaceForInstance: anObject depth: anInteger seen: IdentitySet new! Item was added: + ----- Method: SpaceTally>>spaceForInstance:depth:seen: (in category 'instance size') ----- + spaceForInstance: anObject depth: anInteger seen: someObjects + + | class depth total | + (someObjects includes: anObject) ifTrue: [^ 0]. + someObjects add: anObject. + class := anObject class. + depth := anInteger - 1. + total := class isVariable + ifTrue: [class byteSizeOfInstanceOfSize: anObject basicSize] + ifFalse: [class isImmediateClass ifTrue: [0] ifFalse: [class byteSizeOfInstance]]. + depth >= 0 ifTrue: [ + anObject isCompiledCode + ifTrue: [ + anObject literalsDo: [:literal | + total := total + (self spaceForInstance: literal depth: depth seen: someObjects)]] + ifFalse: [ + 1 to: anObject basicSize do: [:index | + total := total + (self spaceForInstance: (anObject basicAt: index) depth: depth seen: someObjects)]. + 1 to: class instSize do: [:index | + total := total + (self spaceForInstance: (anObject instVarAt: index) depth: depth seen: someObjects)]]]. + ^ total! Item was added: + ----- Method: SpaceTally>>spaceForInstancesOf:depth: (in category 'instance size') ----- + spaceForInstancesOf: aClass depth: aNumber + "Answer a pair of the number of bytes consumed by all instances of the given class, including their object headers, and the number of instances. Follow each instance's fields up to the given depth. Beware of cycles to shared objects, which will tamper the resulting numbers. + + SpaceTally new spaceForInstancesOf: Form depth: 0. --- Same as #spaceForInstanecsOf: + SpaceTally new spaceForInstancesOf: Form depth: 1. --- Includes memory footprint for bits etc. + SpaceTally new spaceForInstancesOf: Form depth: 2. --- Also includes LargePositiveIntegers in bitmaps ;-) + " + + | instances total sub depth | + instances := aClass allInstances. + instances isEmpty ifTrue: [^#(0 0)]. + total := 0. + instances do: [:each | total := total + (self spaceForInstance: each depth: aNumber)]. + ^{ total. instances size }!

5 4

The Inbox: Collections-nice.869.mcz
by commits＠source.squeak.org 17 Dec '20

17 Dec '20

Nicolas Cellier uploaded a new version of Collections to project The Inbox: http://source.squeak.org/inbox/Collections-nice.869.mcz ==================== Summary ==================== Name: Collections-nice.869 Author: nice Time: 31 December 2019, 11:14:43.388306 pm UUID: e5a9bef5-16d3-4d8a-bf08-040d30e4e907 Ancestors: Collections-nice.868 Remaster Collections-nice.464: opimize RunArray This should not be noticeable for Text, but as a general library, it's important for any other potential use. Among those optimizations, notice one important change: some of the enumerating methods like #collect: won't iterate on each element, but only once per run. Be aware that providing blocks with side effects like (i := i + 1) might lead to different behavior than ordinary ArrayedCollection. Move RunArray off ArrayedCollection which serves nothing to such subclass. Add the ability to remove: since it already has the hability to addFirst: and addLast: Fix a few missing lastIndex cache flush, and advertise about the necessity to do it in class comment. Deprecate mapValues: to the profit of replace:. =============== Diff against Collections-nice.868 =============== Item was changed: + SequenceableCollection subclass: #RunArray - ArrayedCollection subclass: #RunArray instanceVariableNames: 'runs values lastIndex lastRun lastOffset' classVariableNames: '' poolDictionaries: '' category: 'Collections-Arrayed'! + !RunArray commentStamp: 'nice 12/30/2019 00:57' prior: 0! - !RunArray commentStamp: '<historical>' prior: 0! My instances provide space-efficient storage of data which tends to be constant over long runs of the possible indices. Essentially repeated values are stored singly and then associated with a "run" length that denotes the number of consecutive occurrences of the value. My two important variables are runs An array of how many elements are in each run values An array of what the value is over those elements The variables lastIndex, lastRun and lastOffset cache the last access so that streaming through RunArrays is not an N-squared process. + Beware: methods modifying the RunArray contents should reset the lastIndex cache to nil. Many complexities of access can be bypassed by using the method RunArray withStartStopAndValueDo:! Item was changed: ----- Method: RunArray class>>newFrom: (in category 'instance creation') ----- newFrom: aCollection "Answer an instance of me containing the same elements as aCollection." | newCollection | newCollection := self new. + newCollection fillFrom: aCollection with: [:each | each]. - aCollection do: [:x | newCollection addLast: x]. ^newCollection " RunArray newFrom: {1. 2. 2. 3} {1. $a. $a. 3} as: RunArray ({1. $a. $a. 3} as: RunArray) values "! Item was added: + ----- Method: RunArray>>allSatisfy: (in category 'enumerating') ----- + allSatisfy: aBlock + "Only evaluate once per run" + + ^values allSatisfy: aBlock! Item was added: + ----- Method: RunArray>>anySatisfy: (in category 'enumerating') ----- + anySatisfy: aBlock + "Only evaluate once per run" + + ^values anySatisfy: aBlock! Item was added: + ----- Method: RunArray>>asBag (in category 'converting') ----- + asBag + | aBag | + aBag := Bag new: values size. + self runsAndValuesDo: [:run :value | + aBag add: value withOccurrences: run]. + ^aBag! Item was added: + ----- Method: RunArray>>asSet (in category 'converting') ----- + asSet + ^values asSet! Item was changed: + ----- Method: RunArray>>coalesce (in category 'private') ----- - ----- Method: RunArray>>coalesce (in category 'adding') ----- coalesce + "Coalesce theRuns and theValues if ever the values have adjacent equal objects" + + | lastLength lastValue mustCoalesce coalescedRuns coalescedValued runIndex | + mustCoalesce := false. + runIndex := 0. + lastLength := 0. + lastValue := Object new. + runs with: values do: [:run :value | + (lastValue = value or: [run = 0]) + ifTrue: + [mustCoalesce + ifFalse: + [coalescedRuns := (Array new: runs size) writeStream. + coalescedValued := (Array new: values size) writeStream. + coalescedRuns next: runIndex putAll: runs startingAt: 1. + coalescedValued next: runIndex putAll: values startingAt: 1. + mustCoalesce := true]. + lastLength := lastLength + run] + ifFalse: + [lastLength > 0 + ifTrue: + [mustCoalesce + ifTrue: + [coalescedRuns nextPut: lastLength. + coalescedValued nextPut: lastValue]. + runIndex := runIndex + 1]. + lastLength := run. + lastValue := value]]. + mustCoalesce + ifTrue: + [lastLength > 0 + ifTrue: + [coalescedRuns nextPut: lastLength. + coalescedValued nextPut: lastValue]. + self setRuns: coalescedRuns contents setValues: coalescedValued contents]! - "Try to combine adjacent runs" - | ind | - ind := 2. - [ind > values size] whileFalse: [ - (values at: ind-1) = (values at: ind) - ifFalse: [ind := ind + 1] - ifTrue: ["two are the same, combine them" - values := values copyReplaceFrom: ind to: ind with: #(). - runs at: ind-1 put: (runs at: ind-1) + (runs at: ind). - runs := runs copyReplaceFrom: ind to: ind with: #(). - "self error: 'needed to combine runs' "]]. - ! Item was added: + ----- Method: RunArray>>collect: (in category 'enumerating') ----- + collect: aBlock + "Beware, the block will be evaluated only once per group of values." + ^(self class runs: runs copy values: (values collect: aBlock)) coalesce! Item was added: + ----- Method: RunArray>>copyUpThrough: (in category 'copying') ----- + copyUpThrough: value + "Optimized" + + | newSize newValues newRuns | + newSize := values indexOf: value startingAt: 1. + newSize = 0 ifTrue: [^self copy]. + newRuns := runs copyFrom: 1 to: newSize. + newRuns at: newSize put: 1. + newValues := values copyFrom: 1 to: newSize. + ^ self class + runs: newRuns + values: newValues! Item was added: + ----- Method: RunArray>>copyUpTo: (in category 'copying') ----- + copyUpTo: anElement + "Optimized" + + | newValues | + newValues := values copyUpTo: anElement. + ^ self class + runs: (runs copyFrom: 1 to: newValues size) + values: newValues! Item was added: + ----- Method: RunArray>>copyUpToLast: (in category 'copying') ----- + copyUpToLast: value + "Optimized" + + | newSize run newRuns newValues | + newSize := values lastIndexOf: value startingAt: values size. + newSize = 0 ifTrue: [^self copy]. + run := runs at: newSize. + run > 1 + ifTrue: + [newRuns := runs copyFrom: 1 to: newSize. + newRuns at: newSize put: run - 1] + ifFalse: + [newSize := newSize - 1. + newRuns := runs copyFrom: 1 to: newSize]. + newValues := values copyFrom: 1 to: newSize. + ^ self class + runs: newRuns + values: newValues! Item was added: + ----- Method: RunArray>>count: (in category 'enumerating') ----- + count: aBlock + "Beware, the block will be evaluated only once per group of values." + | count | + count := 0. + self runsAndValuesDo: [:run :value | + (aBlock value: value) + ifTrue: + [count := count + run]]. + ^count! Item was added: + ----- Method: RunArray>>detect:ifNone: (in category 'enumerating') ----- + detect: aBlock ifNone: exceptionBlock + "Only evaluate once per run" + + ^values detect: aBlock ifNone: exceptionBlock ! Item was added: + ----- Method: RunArray>>detectMax: (in category 'enumerating') ----- + detectMax: aBlock + "Only evaluate once per run" + + ^values detectMax: aBlock! Item was added: + ----- Method: RunArray>>detectMin: (in category 'enumerating') ----- + detectMin: aBlock + "Only evaluate once per run" + + ^values detectMin: aBlock! Item was added: + ----- Method: RunArray>>detectSum: (in category 'enumerating') ----- + detectSum: aBlock + "Only loop on runs" + | sum | + sum := 0. + self runsAndValuesDo: [:run :value | + sum := (aBlock value: value) * run + sum]. + ^ sum! Item was added: + ----- Method: RunArray>>do: (in category 'enumerating') ----- + do: aBlock + "This is refined for speed" + + 1 to: runs size do: [:i | + | r v | + v := values at: i. + r := runs at: i. + [( r := r - 1) >= 0] + whileTrue: [aBlock value: v]].! Item was added: + ----- Method: RunArray>>fillFrom:with: (in category 'private') ----- + fillFrom: aCollection with: aBlock + "Evaluate aBlock with each of aCollections's elements as the argument. + Collect the resulting values into self. Answer self." + + | newRuns newValues lastLength lastValue | + newRuns := (Array new: aCollection size) writeStream. + newValues := (Array new: aCollection size) writeStream. + lastLength := 0. + lastValue := Object new. + lastIndex := nil. "flush access cache" + aCollection do: [:each | + | value | + value := aBlock value: each. + lastValue = value + ifTrue: [lastLength := lastLength + 1] + ifFalse: + [lastLength > 0 + ifTrue: + [newRuns nextPut: lastLength. + newValues nextPut: lastValue]. + lastLength := 1. + lastValue := value]]. + lastLength > 0 + ifTrue: + [newRuns nextPut: lastLength. + newValues nextPut: lastValue]. + self setRuns: newRuns contents setValues: newValues contents! Item was added: + ----- Method: RunArray>>findFirst: (in category 'enumerating') ----- + findFirst: aBlock + | index | + index := 1. + self runsAndValuesDo: [ :run :value | + (aBlock value: value) ifTrue: [^index]. + index := index + run]. + ^0! Item was added: + ----- Method: RunArray>>findLast: (in category 'enumerating') ----- + findLast: aBlock + | index | + index := values size + 1. + [(index := index - 1) >= 1] whileTrue: + [(aBlock value: (values at: index)) ifTrue: [^(1 to: index) detectSum: [:i | runs at: i]]]. + ^0! Item was added: + ----- Method: RunArray>>includes: (in category 'testing') ----- + includes: anObject + "Answer whether anObject is one of the receiver's elements." + + ^values includes: anObject! Item was added: + ----- Method: RunArray>>indexOf:startingAt: (in category 'accessing') ----- + indexOf: anElement startingAt: start + "Answer the index of the first occurence of anElement after start + within the receiver. If the receiver does not contain anElement, + answer 0." + + | index | + index := 1. + self runsAndValuesDo: [ :run :value | + (index >= start and: [value = anElement]) ifTrue: [^index]. + index := index + run]. + ^0! Item was added: + ----- Method: RunArray>>indexOfAnyOf:startingAt: (in category 'accessing') ----- + indexOfAnyOf: aCollection startingAt: start + "Answer the index of the first occurence of any element included in aCollection after start within the receiver. + If the receiver does not contain anElement, answer zero, which is an invalid index." + + | index | + index := 1. + self runsAndValuesDo: [ :run :value | + (index >= start and: [aCollection includes: value]) ifTrue: [^index]. + index := index + run]. + ^0! Item was added: + ----- Method: RunArray>>isSorted (in category 'testing') ----- + isSorted + ^values isSorted! Item was added: + ----- Method: RunArray>>isSortedBy: (in category 'testing') ----- + isSortedBy: aBlock + ^values isSortedBy: aBlock! Item was added: + ----- Method: RunArray>>lastIndexOf:startingAt: (in category 'accessing') ----- + lastIndexOf: anElement startingAt: lastIndex + "Answer the index of the last occurence of anElement within the + receiver. If the receiver does not contain anElement, answer 0." + + | lastValueIndex | + lastValueIndex := values lastIndexOf: anElement startingAt: values size. + [lastValueIndex > 0] whileTrue: + [| i index | + i := index := 0. + [index <= lastIndex and: [(i := i + 1) <= lastValueIndex]] + whileTrue: [index := index + (runs at: i)]. + index <= lastIndex ifTrue: [^index]. + index - (runs at: lastValueIndex) < lastIndex ifTrue: [^lastIndex]. + lastValueIndex := values lastIndexOf: anElement startingAt: lastValueIndex - 1]. + ^0! Item was added: + ----- Method: RunArray>>lastIndexOfAnyOf:startingAt: (in category 'accessing') ----- + lastIndexOfAnyOf: aCollection startingAt: lastIndex + "Answer the index of the last occurence of any element of aCollection + within the receiver. If the receiver does not contain any of those + elements, answer 0" + + | lastValueIndex | + lastValueIndex := values lastIndexOfAnyOf: aCollection startingAt: values size. + [lastValueIndex > 0] whileTrue: + [| i index | + i := index := 0. + [index <= lastIndex and: [(i := i + 1) <= lastValueIndex]] + whileTrue: [index := index + (runs at: i)]. + index <= lastIndex ifTrue: [^index]. + index - (runs at: lastValueIndex) < lastIndex ifTrue: [^lastIndex]. + lastValueIndex := values lastIndexOfAnyOf: aCollection startingAt: lastValueIndex - 1]. + ^0! Item was removed: - ----- Method: RunArray>>mapValues: (in category 'private') ----- - mapValues: mapBlock - "NOTE: only meaningful to an entire set of runs" - - values := values collect: mapBlock! Item was added: + ----- Method: RunArray>>noneSatisfy: (in category 'enumerating') ----- + noneSatisfy: aBlock + "Only evaluate once per run" + + ^values noneSatisfy: aBlock! Item was changed: + ----- Method: RunArray>>rangeOf:startingAt: (in category 'accessing') ----- - ----- Method: RunArray>>rangeOf:startingAt: (in category 'adding') ----- rangeOf: attr startingAt: startPos "Answer an interval that gives the range of attr at index position startPos. An empty interval with start value startPos is returned when the attribute attr is not present at position startPos. self size > 0 is assumed, it is the responsibility of the caller to test for emptiness of self. Note that an attribute may span several adjancent runs. " self at: startPos setRunOffsetAndValue: [:run :offset :value | ^(value includes: attr) ifFalse: [startPos to: startPos - 1] ifTrue: [ | firstRelevantPosition lastRelevantPosition idxOfCandidateRun | lastRelevantPosition := startPos - offset + (runs at: run) - 1. firstRelevantPosition := startPos - offset. idxOfCandidateRun := run + 1. [idxOfCandidateRun <= runs size and: [(values at: idxOfCandidateRun) includes: attr]] whileTrue: [lastRelevantPosition := lastRelevantPosition + (runs at: idxOfCandidateRun). idxOfCandidateRun := idxOfCandidateRun + 1]. idxOfCandidateRun := run - 1. [idxOfCandidateRun >= 1 and: [(values at: idxOfCandidateRun) includes: attr]] whileTrue: [firstRelevantPosition := firstRelevantPosition - (runs at: idxOfCandidateRun). idxOfCandidateRun := idxOfCandidateRun - 1]. firstRelevantPosition to: lastRelevantPosition] ]! Item was added: + ----- Method: RunArray>>remove:ifAbsent: (in category 'removing') ----- + remove: anObject ifAbsent: exceptionBlock + | index mustCoalesce run | + lastIndex := nil. "flush access cache" + index := values indexOf: anObject ifAbsent: [^exceptionBlock value]. + (run := runs at: index) > 1 + ifTrue: [runs at: index put: run - 1] + ifFalse: + [mustCoalesce := index > 1 and: [index < values size and: [(values at: index - 1) = (values at: index + 1)]]. + runs := runs copyWithoutIndex: index. + values := values copyWithoutIndex: index. + mustCoalesce + ifTrue: + [runs at: index - 1 put: (runs at: index - 1) + (runs at: index). + runs := runs copyWithoutIndex: index. + values := values copyWithoutIndex: index]]. + ^anObject! Item was added: + ----- Method: RunArray>>removeAll (in category 'removing') ----- + removeAll + lastIndex := nil. "flush access cache" + runs := Array new. + values := Array new! Item was added: + ----- Method: RunArray>>replace: (in category 'enumerating') ----- + replace: aBlock + "destructively replace the values in this RunArray with the ones transformed by aBlock." + lastIndex := nil. "flush access cache" + values := values replace: aBlock. + self coalesce! Item was added: + ----- Method: RunArray>>reverseDo: (in category 'enumerating') ----- + reverseDo: aBlock + "This is refined for speed" + + | i | + i := runs size. + [i > 0] + whileTrue: + [ | r v | + v := values at: i. + r := runs at: i. + i := i - 1. + [( r := r - 1) >= 0] + whileTrue: [aBlock value: v]].! Item was added: + ----- Method: RunArray>>select: (in category 'enumerating') ----- + select: aBlock + "Beware, the block will be evaluated only once per group of values." + | newRuns newValues | + newRuns := (Array new: runs size) writeStream. + newValues := (Array new: values size) writeStream. + self runsAndValuesDo: [:run :value | + (aBlock value: value) + ifTrue: + [newRuns nextPut: run. + newValues nextPut: value]]. + ^(self class runs: newRuns contents values: newValues contents) coalesce! Item was changed: ----- Method: SequenceableCollection>>lastIndexOf:startingAt: (in category 'accessing') ----- lastIndexOf: anElement startingAt: lastIndex "Answer the index of the last occurence of anElement within the + receiver. If the receiver does not contain anElement, answer 0." - receiver. If the receiver does not contain anElement, answer the - result of evaluating the argument, exceptionBlock." lastIndex to: 1 by: -1 do: [ :index | (self at: index) = anElement ifTrue: [ ^index ] ]. ^0! Item was changed: ----- Method: Text>>addAttribute:from:to: (in category 'emphasis') ----- addAttribute: att from: start to: stop "Set the attribute for characters in the interval start to stop." runs := runs copyReplaceFrom: start to: stop with: ((runs copyFrom: start to: stop) + replace: - mapValues: [:attributes | Text addAttribute: att toArray: attributes]) ! Item was changed: ----- Method: Text>>removeAttribute:from:to: (in category 'emphasis') ----- removeAttribute: att from: start to: stop "Remove the attribute over the interval start to stop." runs := runs copyReplaceFrom: start to: stop with: ((runs copyFrom: start to: stop) + replace: - mapValues: [:attributes | attributes copyWithout: att]) !

6 14

[ANN] DoItFirst command line goodie on SqueakSource
by David T. Lewis 12 Dec '20

12 Dec '20

A few cups of coffee this morning led to some enhancements to my DoItFirst utility, so I decided to put in on SqueakSource. http://www.squeaksource.com/DoItFirst It works more or less like this: $ squeak squeak.image -- -help DoItFirst image arguments: -doit argumentlist "evaluate each argument as a doIt expression" -evaluate arg "evaluate arg, print result then exit" -filein filelist "file in each file named in fileList" -cwd path "set FileDirectory defaultDirectory to path prior to evaluating other options" -help "print this message" Dave

4 14

← Newer
1
...
4
5
6
7
8
9
10
...
23
Older →

Jump to page: