[squeak-dev] The Trunk: Collections.V3-dtl.1026.mczcommits at source.squeak.org commits at source.squeak.orgMon Jan 16 14:37:02 UTC 2023
David T. Lewis uploaded a new version of Collections to project The Trunk: http://source.squeak.org/trunk/Collections.V3-dtl.1026.mcz ==================== Summary ==================== Name: Collections.V3-dtl.1026 Author: dtl Time: 16 January 2023, 9:36:52.641721 am UUID: fa3ecbe3-a4e9-4518-8248-9d0bad07c2b6 Ancestors: Collections.V3-dtl.1025 Name: Collections-ct.1026 Author: ct Time: 28 December 2022, 12:44:05.815118 am UUID: 4f0b7759-244d-0442-a70e-fc296638966c Ancestors: Collections-eem.1025, Collections-ct.1022 Merges Collections-ct.1022 (PositionableStream>>#peek:). =============== Diff against Collections-topa.638 =============== Item was added: + (PackageInfo named: 'Collections') preamble: '"FloatArray is going to become the abstract class above Float32Array and Float64Array. + In order to avoid spurious instance migration or recompilation errors, this preamble is required." + + FloatArray rename: #Float32Array.'! 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 removed: - ----- Method: Array class>>braceWith: (in category 'brace support') ----- - braceWith: a - "This method is used in compilation of brace constructs. - It MUST NOT be deleted or altered." - - | array | - array := self new: 1. - array at: 1 put: a. - ^ array! Item was removed: - ----- Method: Array class>>braceWith:with: (in category 'brace support') ----- - braceWith: a with: b - "This method is used in compilation of brace constructs. - It MUST NOT be deleted or altered." - - | array | - array := self new: 2. - array at: 1 put: a. - array at: 2 put: b. - ^ array! Item was removed: - ----- Method: Array class>>braceWith:with:with: (in category 'brace support') ----- - braceWith: a with: b with: c - "This method is used in compilation of brace constructs. - It MUST NOT be deleted or altered." - - | array | - array := self new: 3. - array at: 1 put: a. - array at: 2 put: b. - array at: 3 put: c. - ^ array! Item was removed: - ----- Method: Array class>>braceWith:with:with:with: (in category 'brace support') ----- - braceWith: a with: b with: c with: d - "This method is used in compilation of brace constructs. - It MUST NOT be deleted or altered." - - | array | - array := self new: 4. - array at: 1 put: a. - array at: 2 put: b. - array at: 3 put: c. - array at: 4 put: d. - ^ array! Item was removed: - ----- Method: Array class>>braceWithNone (in category 'brace support') ----- - braceWithNone - "This method is used in compilation of brace constructs. - It MUST NOT be deleted or altered." - - ^ self new: 0! Item was added: + ----- Method: Array>>allLiteralsDo: (in category 'literals') ----- + allLiteralsDo: aBlock + + "I am a literal." + aBlock value: self. + + "All my elements are literals." + self do: [:each | each allLiteralsDo: aBlock].! Item was changed: ----- Method: Array>>elementsExchangeIdentityWith: (in category 'converting') ----- elementsExchangeIdentityWith: otherArray + "This primitive performs a bulk mutation, causing all pointers to the elements of the + receiver to be replaced by pointers to the corresponding elements of otherArray. + At the same time, all pointers to the elements of otherArray are replaced by + pointers to the corresponding elements of this array. The identityHashes remain + with the pointers rather than with the objects so that objects in hashed structures + should still be properly indexed after the mutation." - "This primitive performs a bulk mutation, causing all pointers to the elements of this array to be replaced by pointers to the corresponding elements of otherArray. At the same time, all pointers to the elements of otherArray are replaced by pointers to the corresponding elements of this array. The identityHashes remain with the pointers rather than with the objects so that objects in hashed structures should still be properly indexed after the mutation." + <primitive: 128 error: ec> + ec == #'no modification' ifTrue: + [^self modificationForbiddenFor: otherArray becomeSelector: #elementsExchangeIdentityWith:]. + ec == #'bad receiver' ifTrue: + [^self error: 'receiver must be of class Array']. + ec == #'bad argument' ifTrue: + [^self error: (otherArray class == Array + ifFalse: ['arg must be of class Array'] + ifTrue: ['receiver and argument must have the same size'])]. + ec == #'inappropriate operation' ifTrue: + [^self error: 'can''t become immediates such as SmallIntegers or Characters']. + ec == #'object is pinned' ifTrue: + [^self error: 'can''t become pinned objects']. + ec == #'insufficient object memory' ifTrue: + [| maxRequired | + "In Spur, two-way become may involve making each pair of objects into a forwarder into a copy of the other. + So if become fails with #'insufficient object memory', garbage collect, and if necessary, grow memory." + maxRequired := (self detectSum: [:obj | obj class byteSizeOfInstanceOfSize: obj basicSize]) + + (otherArray detectSum: [:obj | obj class byteSizeOfInstanceOfSize: obj basicSize]). + (Smalltalk garbageCollectMost < maxRequired + and: [Smalltalk garbageCollect < maxRequired]) ifTrue: + [Smalltalk growMemoryByAtLeast: maxRequired]. + ^self elementsExchangeIdentityWith: otherArray]. + self primitiveFailed! - <primitive: 128> - otherArray class == Array ifFalse: [^ self error: 'arg must be array']. - self size = otherArray size ifFalse: [^ self error: 'arrays must be same size']. - (self anySatisfy: [:obj | obj class == SmallInteger]) ifTrue: [^ self error: 'can''t become SmallIntegers']. - (otherArray anySatisfy: [:obj | obj class == SmallInteger]) ifTrue: [^ self error: 'can''t become SmallIntegers']. - self with: otherArray do:[:a :b| a == b ifTrue:[^self error:'can''t become yourself']]. - - "Must have failed because not enough space in forwarding table (see ObjectMemory-prepareForwardingTableForBecoming:with:twoWay:). Do GC and try again only once" - (Smalltalk bytesLeft: true) = Smalltalk primitiveGarbageCollect - ifTrue: [^ self primitiveFailed]. - ^ self elementsExchangeIdentityWith: otherArray! Item was added: + ----- Method: Array>>elementsForwardIdentityAndHashTo: (in category 'converting') ----- + elementsForwardIdentityAndHashTo: otherArray + "This primitive performs a bulk mutation, causing all pointers to the elements of the receiver to be replaced by pointers to the corresponding elements of otherArray. + NOTE THAT the #identityHash of the objects in otherArray are changed, so that hashed structures that contain such objects MUST BE rehashed while structures that contain objects from the receiver are still properly indexed. See implementors of #rehash." + <primitive: 72 error: ec> + ec == #'no modification' ifTrue: + [^self modificationForbiddenFor: otherArray becomeSelector: #elementsForwardIdentityAndHashTo:]. + ec == #'bad receiver' ifTrue: + [^self error: 'receiver must be of class Array']. + ec == #'bad argument' ifTrue: + [^self error: (otherArray class == Array + ifFalse: ['arg must be of class Array'] + ifTrue: ['receiver and argument must have the same size'])]. + ec == #'inappropriate operation' ifTrue: + [^self error: 'can''t become immediates such as SmallIntegers or Characters']. + ec == #'object is pinned' ifTrue: + [^self error: 'can''t become pinned objects']. + ec == #'insufficient object memory' ifTrue: + [self error: 'The virtual machine is out-of-date. Please upgrade.']. + self primitiveFailed! Item was changed: ----- Method: Array>>elementsForwardIdentityTo: (in category 'converting') ----- elementsForwardIdentityTo: otherArray + "This primitive performs a bulk mutation, causing all pointers to the elements of the + receiver to be replaced by pointers to the corresponding elements of otherArray. + NOTE THAT the #identityHash of the objects in the receiver are changed, so that hashed structures that contain such objects MUST BE rehashed while structures that contain objects from otherArray are still properly indexed. See implementors of #rehash." + <primitive: 248 error: ec> + ec == #'no modification' ifTrue: + [^self modificationForbiddenFor: otherArray becomeSelector: #elementsForwardIdentityTo:]. + ec == #'bad receiver' ifTrue: + [^self error: 'receiver must be of class Array']. + ec == #'bad argument' ifTrue: + [^self error: (otherArray class == Array + ifFalse: ['arg must be of class Array'] + ifTrue: ['receiver and argument must have the same size'])]. + ec == #'inappropriate operation' ifTrue: + [^self error: 'can''t become immediates such as SmallIntegers or Characters']. + ec == #'object is pinned' ifTrue: + [^self error: 'can''t become pinned objects']. + ec == #'insufficient object memory' ifTrue: + [self error: 'The virtual machine is out-of-date. Please upgrade.']. - "This primitive performs a bulk mutation, causing all pointers to the elements of this array to be replaced by pointers to the corresponding elements of otherArray. The identityHashes remain with the pointers rather than with the objects so that the objects in this array should still be properly indexed in any existing hashed structures after the mutation." - <primitive: 72> self primitiveFailed! Item was changed: ----- Method: Array>>elementsForwardIdentityTo:copyHash: (in category 'converting') ----- elementsForwardIdentityTo: otherArray copyHash: copyHash + "This primitive performs a bulk mutation, causing all pointers to the elements of the + receiver to be replaced by pointers to the corresponding elements of otherArray. + If copyHash is true, the identityHashes remain with the pointers rather than with the + objects so that the objects in the receiver should still be properly indexed in any + existing hashed structures after the mutation. If copyHash is false, then the hashes + of the objects in otherArray remain unchanged. If you know what you're doing this + may indeed be what you want." + <primitive: 249 error: ec> + ec == #'no modification' ifTrue: + [^self modificationForbiddenFor: otherArray argument: copyHash becomeSelector: #elementsForwardIdentityTo:copyHash:]. + ec == #'bad receiver' ifTrue: + [^self error: 'receiver must be of class Array']. + ec == #'bad argument' ifTrue: + [^self error: (otherArray class == Array + ifFalse: ['arg must be of class Array'] + ifTrue: ['receiver and argument must have the same size'])]. + ec == #'inappropriate operation' ifTrue: + [^self error: 'can''t become immediates such as SmallIntegers or Characters']. + ec == #'object is pinned' ifTrue: + [^self error: 'can''t become pinned objects']. - "This primitive performs a bulk mutation, causing all pointers to the elements of this array to be replaced by pointers to the corresponding elements of otherArray. The identityHashes remain with the pointers rather than with the objects so that the objects in this array should still be properly indexed in any existing hashed structures after the mutation." - <primitive: 249> self primitiveFailed! Item was removed: - ----- Method: Array>>hasLiteral: (in category 'private') ----- - hasLiteral: literal - "Answer true if literal is identical to any literal in this array, even - if imbedded in further array structure. This method is only intended - for private use by CompiledMethod hasLiteralSymbol:" - - | lit | - 1 to: self size do: - [:index | - ((lit := self at: index) literalEqual: literal) ifTrue: [^true]. - (Array == lit class and: [lit hasLiteral: literal]) ifTrue: [^true]]. - ^false! Item was removed: - ----- Method: Array>>hasLiteralSuchThat: (in category 'private') ----- - hasLiteralSuchThat: testBlock - "Answer true if testBlock returns true for any literal in this array, even if imbedded in further Arrays or CompiledMethods. This method is only intended for private use by CompiledMethod hasLiteralSuchThat:" - | lit | - 1 to: self size do: [:index | - (testBlock value: (lit := self at: index)) ifTrue: [^ true]. - (lit hasLiteralSuchThat: testBlock) ifTrue: [^ true]]. - ^ false! Item was changed: + ----- Method: Array>>literalEqual: (in category 'literals') ----- - ----- Method: Array>>literalEqual: (in category 'comparing') ----- literalEqual: other self class == other class ifFalse: [^ false]. self size = other size ifFalse: [^ false]. self with: other do: [:e1 :e2 | (e1 literalEqual: e2) ifFalse: [^ false]]. ^ true! Item was added: + ----- Method: Array>>modificationForbiddenFor:argument:becomeSelector: (in category 'read-only objects') ----- + modificationForbiddenFor: otherArray argument: argument becomeSelector: retrySelector + "Raise a ModificationForbidden error for an attempt to modify a read-only object through a become operation." + ^(ModificationForbidden new + mirror: self + object: otherArray + index: nil + newValue: argument + resumptionValue: self + retrySelector: retrySelector) signal! Item was added: + ----- Method: Array>>modificationForbiddenFor:becomeSelector: (in category 'read-only objects') ----- + modificationForbiddenFor: otherArray becomeSelector: retrySelector + "Raise a ModificationForbidden error for an attempt to modify a read-only object through a become operation." + ^(BinaryModificationForbidden new + mirror: self + object: otherArray + index: nil + newValue: nil + resumptionValue: self + retrySelector: retrySelector) signal! Item was changed: + ----- Method: Array>>printAsBraceFormOn: (in category 'printing') ----- - ----- Method: Array>>printAsBraceFormOn: (in category 'self evaluating') ----- printAsBraceFormOn: aStream - aStream nextPut: ${. + self do: [:el | el printOn: aStream] separatedBy: [ aStream nextPutAll: ' . ']. - self do: [:el | aStream print: el] separatedBy: [ aStream nextPutAll: ' . ']. aStream nextPut: $}! Item was removed: - ----- Method: Array>>printAsLiteralFormOn: (in category 'self evaluating') ----- - printAsLiteralFormOn: aStream - aStream nextPut: $#. - self printElementsOn: aStream - ! Item was added: + ----- Method: Array>>printAsLiteralOn: (in category 'printing') ----- + printAsLiteralOn: aStream + aStream nextPut: $#; nextPut: $(. + self do: [:each| each printAsLiteralOn: aStream] separatedBy: [aStream space]. + aStream nextPut: $) + ! Item was changed: ----- Method: Array>>printOn: (in category 'printing') ----- printOn: aStream + self class == Array ifFalse: + [^super printOn: aStream]. + self shouldBePrintedAsLiteral + ifTrue: [self printAsLiteralOn: aStream] + ifFalse: [self printAsBraceFormOn: aStream]! - self shouldBePrintedAsLiteral ifTrue: [^self printAsLiteralFormOn: aStream]. - self class = Array ifTrue: [^self printAsBraceFormOn: aStream]. - ^super printOn: aStream! Item was changed: ----- Method: Array>>storeOn: (in category 'printing') ----- + storeOn: aStream - storeOn: aStream "Use the literal form if possible." - self shouldBePrintedAsLiteral + ifTrue: [self printAsLiteralOn: aStream] - ifTrue: - [aStream nextPut: $#; nextPut: $(. - self do: - [:element | - element storeOn: aStream. - aStream space]. - aStream nextPut: $)] ifFalse: [super storeOn: aStream]! Item was added: + ----- Method: ArrayedCollection class>>isAbstract (in category 'testing') ----- + isAbstract + ^self = ArrayedCollection! Item was changed: ----- Method: ArrayedCollection class>>with:with:with:with: (in category 'instance creation') ----- with: firstObject with: secondObject with: thirdObject with: fourthObject + "Answer a new instance of me, containing only the four arguments as - "Answer a new instance of me, containing only the three arguments as elements." | newCollection | newCollection := self new: 4. newCollection at: 1 put: firstObject. newCollection at: 2 put: secondObject. newCollection at: 3 put: thirdObject. newCollection at: 4 put: fourthObject. ^newCollection! Item was added: + ----- Method: ArrayedCollection>>isEmpty (in category 'testing') ----- + isEmpty + ^self size = 0! Item was changed: ----- Method: ArrayedCollection>>mergeFirst:middle:last:into:by: (in category 'sorting') ----- mergeFirst: first middle: middle last: last into: dst by: aBlock "Private. Merge the sorted ranges [first..middle] and [middle+1..last] of the receiver into the range [first..last] of dst." | i1 i2 val1 val2 out | i1 := first. i2 := middle + 1. val1 := self at: i1. val2 := self at: i2. out := first - 1. "will be pre-incremented" "select 'lower' half of the elements based on comparator" + [ (i1 <= middle) and: [ i2 <= last ] ] whileTrue: [ - [ (i1 <= middle) and: [ i2 <= last ] ] whileTrue: [ (aBlock ifNil: [ val1 <= val2 ] ifNotNil: [ aBlock value: val1 value: val2 ]) ifTrue: [ dst at: (out := out + 1) put: val1. val1 := self at: (i1 := i1 + 1)] ifFalse: [ dst at: (out := out + 1) put: val2. + val2 := self atWrap: (i2 := i2 + 1) ] ]. - (i2 := i2 + 1) <= last ifTrue: [ - val2 := self at: i2 ] ] ]. "copy the remaining elements" i1 <= middle ifTrue: [dst replaceFrom: out + 1 to: last with: self startingAt: i1] ifFalse: [dst replaceFrom: out + 1 to: last with: self startingAt: i2]! Item was changed: ----- Method: ArrayedCollection>>mergeSortFrom:to:by: (in category 'sorting') ----- mergeSortFrom: startIndex to: stopIndex by: aBlock "Sort the given range of indices using the mergesort algorithm. Mergesort is a worst-case O(N log N) sorting algorithm that usually does only half as many comparisons as heapsort or quicksort." "Details: recursively split the range to be sorted into two halves, mergesort each half, then merge the two halves together. An extra copy of the data is used as temporary storage and successive merge phases copy data back and forth between the receiver and this copy. The recursion is set up so that the final merge is performed into the receiver, resulting in the receiver being completely sorted." + | size | + (size := self size) <= 1 ifTrue: [^ self]. "nothing to do" - self size <= 1 ifTrue: [^ self]. "nothing to do" startIndex = stopIndex ifTrue: [^ self]. + 1 <= startIndex ifFalse: [ self errorSubscriptBounds: startIndex ]. + stopIndex <= size ifFalse: [ self errorSubscriptBounds: stopIndex ]. + startIndex < stopIndex ifFalse: [ self errorSubscriptBounds: startIndex ]. + self shallowCopy - self assert: [startIndex >= 1 and: [startIndex < stopIndex]]. "bad start index" - self assert: [stopIndex <= self size]. "bad stop index" - self mergeSortFrom: startIndex to: stopIndex + into: self - src: self clone - dst: self by: aBlock! Item was added: + ----- Method: ArrayedCollection>>mergeSortFrom:to:into:by: (in category 'sorting') ----- + mergeSortFrom: firstIndex to: lastIndex into: destination by: aBlock + "Private. Split the range to be sorted in half, sort each half, and + merge the two half-ranges into destination." + + | n firstObject lastObject | + "Precondition: firstIndex <= lastIndex, self and destination contain the same elements between firstIndex and lastIndex inclusively but not necessarily in the same order" + (n := lastIndex - firstIndex) <= 1 ifTrue: [ "Handle 1 and 2 sized ranges directly." + n = 0 ifTrue: [ ^self ]. + firstObject := self at: firstIndex. + lastObject := self at: lastIndex. + (aBlock + ifNil: [ firstObject <= lastObject ] + ifNotNil: [ aBlock value: firstObject value: lastObject ]) + ifFalse: [ + destination + at: lastIndex put: firstObject; + at: firstIndex put: lastObject ] + ifTrue: [ + destination + at: lastIndex put: lastObject; + at: firstIndex put: firstObject ]. + ^self ]. + n := firstIndex + lastIndex // 2. + destination mergeSortFrom: firstIndex to: n into: self by: aBlock. + destination mergeSortFrom: n + 1 to: lastIndex into: self by: aBlock. + self mergeFirst: firstIndex middle: n last: lastIndex into: destination by: aBlock! Item was removed: - ----- Method: ArrayedCollection>>mergeSortFrom:to:src:dst:by: (in category 'sorting') ----- - mergeSortFrom: first to: last src: src dst: dst by: aBlock - "Private. Split the range to be sorted in half, sort each half, and - merge the two half-ranges into dst." - - | middle | - first = last ifTrue: [^ self]. - middle := (first + last) // 2. - self mergeSortFrom: first to: middle src: dst dst: src by: aBlock. - self mergeSortFrom: middle + 1 to: last src: dst dst: src by: aBlock. - src mergeFirst: first middle: middle last: last into: dst by: aBlock! Item was added: + ----- Method: ArrayedCollection>>occurrencesOf: (in category 'enumerating') ----- + occurrencesOf: anObject + "Answer how many of the receiver's elements are equal to anObject. Optimized version." + + | tally | + tally := 0. + 1 to: self size do: [ :index | + (self at: index) = anObject ifTrue: [ tally := tally + 1 ] ]. + ^tally! 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! Item was added: + Object subclass: #Ascii85Converter + instanceVariableNames: 'dataStream stringStream number85 tupleSize binary' + classVariableNames: '' + poolDictionaries: '' + category: 'Collections-Streams'! + + !Ascii85Converter commentStamp: 'topa 7/10/2016 20:57' prior: 0! + I convert between binary data and an Ascii85 text representation of PostScript and PDF fame. + I am a little bit more efficient (~25% overhead) than Base64 (~30% overhead). + + Instance Variables + binary: <Boolean> - Tells whether to decode to binary data or characters + dataStream: <PositionableStream> - The data stream to decode to or encode from (Typically does not contain Ascii85) + stringStream: <PositionableStream> - The text stream to decode from or encode to (Always contains Ascii85) + number85: <Integer> - Decoder state, accumulated read number in base85 + tupleSize: <SmallInteger> - Number of bytes read into number85 already + + 'Hello, World' ascii85Encoded. + + '<~87cURD]htuF_+us~>' ascii85Decoded. + ! Item was added: + ----- Method: Ascii85Converter class>>decode:as: (in category 'convenience') ----- + decode: aStringOrStream as: contentsClass + + ^ contentsClass streamContents: + [:out | self decode: aStringOrStream to: out]! Item was added: + ----- Method: Ascii85Converter class>>decode:to: (in category 'convenience') ----- + decode: aStringOrStream to: outStream + + ^ (self stringStream: aStringOrStream readStream dataStream: outStream) + decode! Item was added: + ----- Method: Ascii85Converter class>>decodeToBytes: (in category 'convenience') ----- + decodeToBytes: aStringOrStream + " Analogous to Base64MimeConverter>>#mimeDecodeToBytes:" + | expectedSize | + expectedSize := aStringOrStream size * 4 // 5. + ^ (ByteArray new: expectedSize streamContents: + [:stream | + (self stringStream: aStringOrStream readStream dataStream: stream) + decodeToByteArray]) readStream! Item was added: + ----- Method: Ascii85Converter class>>decodeToChars: (in category 'convenience') ----- + decodeToChars: aStringOrStream + " Analogous to Base64MimeConverter>>#mimeDecodeToChars:" + | expectedSize | + expectedSize := aStringOrStream size * 4 // 5. + ^ (String new: expectedSize streamContents: + [:stream | self decode: aStringOrStream to: stream]) readStream! Item was added: + ----- Method: Ascii85Converter class>>encode: (in category 'convenience') ----- + encode: aCollectionOrStream + + ^ String streamContents: + [:out | self encode: aCollectionOrStream to: out]! Item was added: + ----- Method: Ascii85Converter class>>encode:to: (in category 'convenience') ----- + encode: aCollectionOrStream to: outStream + + ^ (self stringStream: outStream dataStream: aCollectionOrStream readStream) + encode! Item was added: + ----- Method: Ascii85Converter class>>stringStream:dataStream: (in category 'instance creation') ----- + stringStream: aStream dataStream: anotherStream + + ^ self new + stringStream: aStream; + dataStream: anotherStream; + yourself! Item was added: + ----- Method: Ascii85Converter>>ascii (in category 'accessing') ----- + ascii + + binary := false.! Item was added: + ----- Method: Ascii85Converter>>binary (in category 'accessing') ----- + binary + + binary := true.! Item was added: + ----- Method: Ascii85Converter>>dataStream (in category 'accessing') ----- + dataStream + + ^dataStream! Item was added: + ----- Method: Ascii85Converter>>dataStream: (in category 'accessing') ----- + dataStream: anObject + + dataStream := anObject.! Item was added: + ----- Method: Ascii85Converter>>decode (in category 'conversion') ----- + decode + + self readBOD ifFalse: [^ self dataStream]. + + [self stringStream atEnd] whileFalse: [ + self stringStream skipSeparators. + self readEOD ifTrue: [^ self endDecode]. "<--- End of data" + + self decodeChar: self stringStream next ifFail: [^ self dataStream]]. + "actually, should not reach, but our failure condition is returning the stream, anyway" + ^ self dataStream! Item was added: + ----- Method: Ascii85Converter>>decodeChar:ifFail: (in category 'conversion') ----- + decodeChar: char ifFail: failBlock + + char = $z ifTrue: [^ self decodeZIfFail: failBlock]. + + (char between: $!! and: $u) ifFalse: [^ failBlock value]. + + self incrementTupleSize. + self incrementNumber85: char asInteger - 33 * (self pow85 at: self tupleSize). + self tupleSize = 5 ifTrue: + [self isBinary + ifTrue: [self writeBytes255: self number85 atMax: 4] + ifFalse: [self writeChars255: self number85 atMax: 4]. + self resetDecoderState]! Item was added: + ----- Method: Ascii85Converter>>decodeToByteArray (in category 'conversion') ----- + decodeToByteArray + + self binary. + ^ self decode! Item was added: + ----- Method: Ascii85Converter>>decodeZIfFail: (in category 'conversion') ----- + decodeZIfFail: failBlock + + self tupleSize ~= 0 ifTrue: [^ failBlock value]. + self dataStream next: 4 put: (self isBinary ifTrue: [0] ifFalse: [Character null]). + ! Item was added: + ----- Method: Ascii85Converter>>encode (in category 'conversion') ----- + encode + + | lineLength | + + lineLength := 0. + self stringStream nextPutAll: '<~'. + [self dataStream atEnd] whileFalse: [ + | raw data out | + lineLength >= 74 ifTrue: [self stringStream cr. lineLength := 0]. + out := 5. + raw := (self dataStream next: 4) asByteArray. + raw size < 4 ifTrue: + [out := raw size + 1. + raw := raw, (self padOfSize: 4 - raw size)]. + data := raw unsignedLongAt: 1 bigEndian: true. + data = 0 + ifTrue: [self stringStream nextPut: $z. lineLength := lineLength + 1] + ifFalse: [self write85: data atMax: out. lineLength := lineLength + out]]. + self stringStream nextPutAll: '~>'. + ^ self stringStream + ! Item was added: + ----- Method: Ascii85Converter>>endDecode (in category 'private') ----- + endDecode + + self tupleSize > 0 ifTrue: + [self incrementNumber85: (self pow85 at: self tupleSize). + self isBinary + ifTrue: [self writeBytes255: self number85 atMax: self tupleSize - 1] + ifFalse: [self writeChars255: self number85 atMax: self tupleSize - 1]]. + ^ self dataStream! Item was added: + ----- Method: Ascii85Converter>>incrementNumber85: (in category 'private') ----- + incrementNumber85: aNumber + + number85 := number85 + aNumber. + + ! Item was added: + ----- Method: Ascii85Converter>>incrementTupleSize (in category 'private') ----- + incrementTupleSize + + tupleSize := tupleSize + 1. + ! Item was added: + ----- Method: Ascii85Converter>>initialize (in category 'initialize-release') ----- + initialize + + super initialize. + self ascii. + self resetDecoderState.! Item was added: + ----- Method: Ascii85Converter>>isBinary (in category 'testing') ----- + isBinary + + ^ binary! Item was added: + ----- Method: Ascii85Converter>>number85 (in category 'accessing') ----- + number85 + + ^ number85! Item was added: + ----- Method: Ascii85Converter>>padOfSize: (in category 'private') ----- + padOfSize: anInteger + + anInteger = 1 ifTrue: [ ^#[0] ]. + anInteger = 2 ifTrue: [ ^#[0 0] ]. + anInteger = 3 ifTrue: [ ^#[0 0 0] ]. + self error: 'Should not reach'! Item was added: + ----- Method: Ascii85Converter>>pow85 (in category 'private') ----- + pow85 + + ^ #(52200625 614125 7225 85 1) "{85*85*85*85 . 85*85*85 . 85*85 . 85. 1}"! Item was added: + ----- Method: Ascii85Converter>>readBOD (in category 'private') ----- + readBOD + + self stringStream skipSeparators. + self stringStream peek = $< ifFalse: [^ false] ifTrue: + [self stringStream next. "ignore" + self stringStream peek = $~ ifFalse: [^ false] ifTrue: + [self stringStream next "ignore"]]. + ^ true! Item was added: + ----- Method: Ascii85Converter>>readEOD (in category 'private') ----- + readEOD + + self stringStream skipSeparators. + self stringStream peek = $~ ifFalse: [^ false] ifTrue: + [self stringStream next. "ignore" + self stringStream peek = $> ifFalse: [^ false] ifTrue: + [self stringStream next "ignore"]]. + ^ true! Item was added: + ----- Method: Ascii85Converter>>resetDecoderState (in category 'private') ----- + resetDecoderState + + number85 := 0. + tupleSize := 0. + ! Item was added: + ----- Method: Ascii85Converter>>stringStream (in category 'accessing') ----- + stringStream + + ^ stringStream! Item was added: + ----- Method: Ascii85Converter>>stringStream: (in category 'accessing') ----- + stringStream: anObject + + stringStream := anObject.! Item was added: + ----- Method: Ascii85Converter>>tupleSize (in category 'accessing') ----- + tupleSize + + ^ tupleSize! Item was added: + ----- Method: Ascii85Converter>>write85:atMax: (in category 'writing') ----- + write85: anInteger atMax: aNumber + + | c1 c2 c3 c4 c5 remain | + remain := anInteger. + c5 := (remain \\ 85 + 33) asCharacter. remain := remain // 85. + c4 := (remain \\ 85 + 33) asCharacter. remain := remain // 85. + c3 := (remain \\ 85 + 33) asCharacter. remain := remain // 85. + c2 := (remain \\ 85 + 33) asCharacter. remain := remain // 85. + c1 := (remain \\ 85 + 33) asCharacter. remain := remain // 85. + aNumber > 0 ifTrue: [self stringStream nextPut: c1. + aNumber > 1 ifTrue: [self stringStream nextPut: c2. + aNumber > 2 ifTrue: [self stringStream nextPut: c3. + aNumber > 3 ifTrue: [self stringStream nextPut: c4. + aNumber > 4 ifTrue: [self stringStream nextPut: c5]]]]]. + ! Item was added: + ----- Method: Ascii85Converter>>writeBytes255:atMax: (in category 'writing') ----- + writeBytes255: anInteger atMax: aNumber + + (aNumber between: 1 and: 4) ifFalse: [^ self error: 'Unexpected byte count']. + 4 to: (5 - aNumber) by: -1 do: + [:index | self dataStream nextPut: (anInteger digitAt: index)]. + ! Item was added: + ----- Method: Ascii85Converter>>writeChars255:atMax: (in category 'writing') ----- + writeChars255: anInteger atMax: aNumber + + (aNumber between: 1 and: 4) ifFalse: [^ self error: 'Unexpected byte count']. + 4 to: (5 - aNumber) by: -1 do: + [:index | self dataStream nextPut: (anInteger digitAt: index) asCharacter]. + ! Item was removed: - ----- Method: Association>>literalEqual: (in category 'testing') ----- - literalEqual: otherLiteral - "Answer true if the receiver and otherLiteral represent the same literal. - Variable bindings are literally equals only if identical. - This is how variable sharing works, by preserving identity and changing only the value." - ^self == otherLiteral! Item was changed: ----- Method: AttributedTextStream class>>new (in category 'instance creation') ----- new "For this class we override Stream class>>new since this class actually is created using #new, even though it is a Stream." + ^self new: 10! - ^self basicNew initialize! Item was added: + ----- Method: AttributedTextStream class>>new: (in category 'instance creation') ----- + new: n + + ^self basicNew + initialize: n; + yourself! Item was removed: - ----- Method: AttributedTextStream>>initialize (in category 'initialize-release') ----- - initialize - - characters := String new writeStream. - currentAttributes := #(). - currentRun := 0. - attributeValues := (Array new: 50) writeStream. - attributeRuns := (Array new: 50) writeStream! Item was added: + ----- Method: AttributedTextStream>>initialize: (in category 'initialize-release') ----- + initialize: n + + super initialize. + characters := (String new: n) writeStream. + currentAttributes := #(). + currentRun := 0. + attributeValues := (Array new: (n min: 10)) writeStream. + attributeRuns := (Array new: (n min: 10)) writeStream! Item was added: + ----- Method: AttributedTextStream>>next:putAll:startingAt: (in category 'accessing') ----- + next: anInteger putAll: aString startingAt: startIndex + + "add an entire string with the same attributes" + anInteger > 0 ifFalse: [ ^aString ]. + currentRun := currentRun + anInteger. + ^characters + next: anInteger + putAll: aString + startingAt: startIndex! Item was changed: + ----- Method: Bag>>occurrencesOf: (in category 'enumerating') ----- + occurrencesOf: anObject + "Answer how many of the receiver's elements are equal to anObject. Optimized version." - ----- Method: Bag>>occurrencesOf: (in category 'testing') ----- - occurrencesOf: anObject - "Refer to the comment in Collection|occurrencesOf:." + ^contents at: anObject ifAbsent: 0! - (self includes: anObject) - ifTrue: [^contents at: anObject] - ifFalse: [^0]! Item was changed: + ----- Method: Base64MimeConverter class>>decodeInteger: (in category 'convenience') ----- - ----- Method: Base64MimeConverter class>>decodeInteger: (in category 'as yet unclassified') ----- decodeInteger: mimeString | bytes sum | "Decode the MIME string into an integer of any length" bytes := (Base64MimeConverter mimeDecodeToBytes: (ReadStream on: mimeString)) contents. sum := 0. bytes reverseDo: [:by | sum := sum * 256 + by]. ^ sum! Item was changed: + ----- Method: Base64MimeConverter class>>encodeInteger: (in category 'convenience') ----- - ----- Method: Base64MimeConverter class>>encodeInteger: (in category 'as yet unclassified') ----- encodeInteger: int | strm | "Encode an integer of any length and return the MIME string" strm := WriteStream on: (ByteArray new: int digitLength). 1 to: int digitLength do: [:ii | strm nextPut: (int digitAt: ii)]. ^ ((self mimeEncode: strm readStream) contents) copyUpTo: $= "remove padding"! Item was changed: + ----- Method: Base64MimeConverter class>>initialize (in category 'class initialization') ----- - ----- Method: Base64MimeConverter class>>initialize (in category 'as yet unclassified') ----- initialize FromCharTable := Array new: 256. "nils" ToCharTable := ($A to: $Z) , ($a to: $z) , ($0 to: $9) , '+/'. ToCharTable keysAndValuesDo: [:ind :char | FromCharTable at: char asciiValue + 1 put: ind - 1].! Item was changed: + ----- Method: Base64MimeConverter class>>mimeDecodeToBytes: (in category 'convenience') ----- - ----- Method: Base64MimeConverter class>>mimeDecodeToBytes: (in category 'as yet unclassified') ----- mimeDecodeToBytes: aStream "Return a ReadStream of the original ByteArray. aStream has only 65 innocuous character values. aStream is not binary. (See class comment). 4 bytes in aStream goes to 3 bytes in output." | me | aStream position: 0. me := self new mimeStream: aStream. me dataStream: (WriteStream on: (ByteArray new: aStream size * 3 // 4)). me mimeDecodeToByteArray. ^ me dataStream readStream! Item was changed: + ----- Method: Base64MimeConverter class>>mimeDecodeToChars: (in category 'convenience') ----- - ----- Method: Base64MimeConverter class>>mimeDecodeToChars: (in category 'as yet unclassified') ----- mimeDecodeToChars: aStream "Return a ReadWriteStream of the original String. aStream has only 65 innocuous character values. It is not binary. (See class comment). 4 bytes in aStream goes to 3 bytes in output." | me | aStream position: 0. me := self new mimeStream: aStream. me dataStream: (WriteStream on: (String new: aStream size * 3 // 4)). me mimeDecode. ^ me dataStream readStream! Item was changed: + ----- Method: Base64MimeConverter class>>mimeEncode: (in category 'convenience') ----- - ----- Method: Base64MimeConverter class>>mimeEncode: (in category 'as yet unclassified') ----- mimeEncode: aStream "Return a ReadWriteStream of characters. The data of aStream is encoded as 65 innocuous characters. (See class comment). 3 bytes in aStream goes to 4 bytes in output." ^self mimeEncode: aStream multiLine: true atStart: true! Item was changed: + ----- Method: Base64MimeConverter class>>mimeEncode:multiLine: (in category 'convenience') ----- - ----- Method: Base64MimeConverter class>>mimeEncode:multiLine: (in category 'as yet unclassified') ----- mimeEncode: aStream multiLine: aBool "Return a ReadWriteStream of characters. The data of aStream is encoded as 65 innocuous characters. (See class comment). 3 bytes in aStream goes to 4 bytes in output." ^self mimeEncode: aStream multiLine: aBool atStart: true! Item was changed: + ----- Method: Base64MimeConverter class>>mimeEncode:multiLine:atStart: (in category 'private - convenience') ----- - ----- Method: Base64MimeConverter class>>mimeEncode:multiLine:atStart: (in category 'as yet unclassified') ----- mimeEncode: aStream multiLine: aBool atStart: resetInput "Return a ReadStream of characters. The data of aStream is encoded as 65 innocuous characters. (See class comment). 3 bytes in aStream goes to 4 bytes in output." | me | resetInput ifTrue:[aStream position: 0]. me := self new dataStream: aStream. me multiLine: aBool. me mimeStream: (WriteStream on: (String new: aStream size + 20 * 4 // 3)). me mimeEncode. ^ me mimeStream readStream! Item was changed: + ----- Method: Base64MimeConverter class>>mimeEncodeContinue: (in category 'private - convenience') ----- - ----- Method: Base64MimeConverter class>>mimeEncodeContinue: (in category 'as yet unclassified') ----- mimeEncodeContinue: aStream "Return a ReadWriteStream of characters. The data of aStream is encoded as 65 innocuous characters. (See class comment). 3 bytes in aStream goes to 4 bytes in output." ^self mimeEncode: aStream multiLine: true atStart: false! Item was changed: ----- Method: Base64MimeConverter>>mimeDecode (in category 'conversion') ----- mimeDecode + "Convert a stream in base 64 with only a-z,A-Z,0-9,+,/ to a full byte stream of characters. Return a whole stream for the user to read." - "Convert a stream in base 64 with only a-z,A-Z,0-9,+,/ to a full byte stream of characters. Reutrn a whole stream for the user to read." | nibA nibB nibC nibD | [mimeStream atEnd] whileFalse: [ (nibA := self nextValue) ifNil: [^ dataStream]. (nibB := self nextValue) ifNil: [^ dataStream]. dataStream nextPut: ((nibA bitShift: 2) + (nibB bitShift: -4)) asCharacter. nibB := nibB bitAnd: 16rF. (nibC := self nextValue) ifNil: [^ dataStream]. dataStream nextPut: ((nibB bitShift: 4) + (nibC bitShift: -2)) asCharacter. nibC := nibC bitAnd: 16r3. (nibD := self nextValue) ifNil: [^ dataStream]. dataStream nextPut: ((nibC bitShift: 6) + nibD) asCharacter. ]. ^ dataStream! Item was changed: ----- Method: Base64MimeConverter>>mimeDecodeToByteArray (in category 'conversion') ----- mimeDecodeToByteArray + "Convert a stream in base 64 with only a-z,A-Z,0-9,+,/ to a full ByteArray of 0-255 values. Return a whole stream for the user to read." - "Convert a stream in base 64 with only a-z,A-Z,0-9,+,/ to a full ByteArray of 0-255 values. Reutrn a whole stream for the user to read." | nibA nibB nibC nibD | [mimeStream atEnd] whileFalse: [ (nibA := self nextValue) ifNil: [^ dataStream]. (nibB := self nextValue) ifNil: [^ dataStream]. dataStream nextPut: ((nibA bitShift: 2) + (nibB bitShift: -4)). nibB := nibB bitAnd: 16rF. (nibC := self nextValue) ifNil: [^ dataStream]. dataStream nextPut: ((nibB bitShift: 4) + (nibC bitShift: -2)). nibC := nibC bitAnd: 16r3. (nibD := self nextValue) ifNil: [^ dataStream]. dataStream nextPut: ((nibC bitShift: 6) + nibD). ]. ^ dataStream! Item was added: + MimeConverter subclass: #Bit7MimeConverter + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Collections-Streams'! Item was added: + ----- Method: Bit7MimeConverter>>mimeDecode (in category 'conversion') ----- + mimeDecode + + dataStream nextPutAll: mimeStream upToEnd. + ^ dataStream! Item was added: + ----- Method: Bit7MimeConverter>>mimeEncode (in category 'conversion') ----- + mimeEncode + + | character | + [dataStream atEnd] whileFalse: [ + character := dataStream next. + self assert: character asciiValue < 128. + mimeStream nextPut: character]. + + ^ mimeStream! Item was added: + Collection subclass: #Bitset + instanceVariableNames: 'bytes tally' + classVariableNames: '' + poolDictionaries: '' + category: 'Collections-Support'! + + !Bitset commentStamp: 'ul 8/22/2015 00:52' prior: 0! + I implement Bitsets, which are dictionary-like data structures mapping 0-1 values to integers between 0 and capacity-1, or in another way they are set-like data structures which can include values between 0 and capacity-1. + I implement three different kind of APIs, each corresponding to a way of thinking about this data structure: + - A Set-like API with #add:, #remove: and #includes: + - A Dictionary-like API with #at:, #at:put: + - And a bit-manipulation API with #bitAt:, #clearBitAt: and #setBitAt:. + + Instance Variables + bytes: <ByteArray> + tally: <Integer> + + bytes + - a ByteArray which holds the values for each integer key. Each byte holds 8 values. + + tally + - the number of objects in this set, or the number or 1 values in this dictionary. + ! Item was added: + ----- Method: Bitset class>>initializedInstance (in category 'instance creation') ----- + initializedInstance + + ^ self new: 0! Item was added: + ----- Method: Bitset class>>new (in category 'instance creation') ----- + new + + self error: 'Use #new: instead.'! Item was added: + ----- Method: Bitset class>>new: (in category 'instance creation') ----- + new: capacity + + ^self basicNew initialize: capacity! Item was added: + ----- Method: Bitset>>= (in category 'comparing') ----- + = anObject + + self species == anObject species ifFalse: [ ^false ]. + anObject size = tally ifFalse: [ ^false ]. + ^anObject bytes = bytes! Item was added: + ----- Method: Bitset>>add: (in category 'adding') ----- + add: anInteger + "Add anInteger to this set. Return anInteger." + + self setBitAt: anInteger. + ^anInteger! Item was added: + ----- Method: Bitset>>at: (in category 'accessing') ----- + at: anInteger + + ^self bitAt: anInteger + ! Item was added: + ----- Method: Bitset>>at:put: (in category 'accessing') ----- + at: anInteger put: aBit + + ^self bitAt: anInteger put: aBit + ! Item was added: + ----- Method: Bitset>>bitAt: (in category 'bit manipulation') ----- + bitAt: anInteger + "Return the bit corresponding to anInteger." + + ^((bytes at: (anInteger bitShift: -3) + 1) bitShift: 0 - (anInteger bitAnd: 7)) bitAnd: 1 + ! Item was added: + ----- Method: Bitset>>bitAt:put: (in category 'bit manipulation') ----- + bitAt: anInteger put: aBit + "Set the value corresponding to anInteger to aBit. Return the new value." + + aBit caseOf: { + [ 0 ] -> [ self clearBitAt: anInteger ]. + [ 1 ] -> [ self setBitAt: anInteger ] }. + ^aBit + + ! Item was added: + ----- Method: Bitset>>bytes (in category 'private') ----- + bytes + + ^bytes! Item was added: + ----- Method: Bitset>>capacity (in category 'accessing') ----- + capacity + "Return the highest integer this collection can store plus one." + + ^bytes size * 8! Item was added: + ----- Method: Bitset>>clearBitAt: (in category 'bit manipulation') ----- + clearBitAt: anInteger + "Set the value corresponding to anInteger to 0. Return true if the value wasn't 0." + + | index value mask newValue | + index := (anInteger bitShift: -3) + 1. + value := bytes at: index. + mask := 1 bitShift: (anInteger bitAnd: 7). + (newValue := (value bitOr: mask) - mask) = value ifTrue: [ ^false ]. + bytes at: index put: newValue. + tally := tally - 1. + ^true + ! Item was added: + ----- Method: Bitset>>do: (in category 'enumerating') ----- + do: aBlock + "Evaluate aBlock with each integer which has its bit set to 1." + + | byte byteOffset lowBits remainingBits | + remainingBits := tally. + lowBits := Integer lowBitPerByteTable. + 1 to: bytes size do: [ :index | + 1 <= remainingBits ifFalse: [ ^self ]. + (byte := bytes at: index) = 0 ifFalse: [ + byteOffset := (index bitShift: 3) - 9. "- 8 - 1 to make it -1 based." + [ + aBlock value: (lowBits at: byte) + byteOffset. "byteOffset is -1 based, lowBits is 1-based." + remainingBits := remainingBits - 1. + "Eliminate the low bit and loop if there're any remaning bits set." + (byte := byte bitAnd: byte - 1) = 0 ] whileFalse ] ]! Item was added: + ----- Method: Bitset>>hash (in category 'comparing') ----- + hash + "#hash is implemented, because #= is implemented." + + ^(self species hash bitXor: tally hashMultiply) bitXor: bytes hash! Item was added: + ----- Method: Bitset>>includes: (in category 'testing') ----- + includes: anInteger + + anInteger isInteger ifFalse: [ ^false ]. + -1 < anInteger ifFalse: [ ^false ]. + anInteger < self capacity ifFalse: [ ^false ]. + ^(self bitAt: anInteger) = 1! Item was added: + ----- Method: Bitset>>initialize: (in category 'private') ----- + initialize: capacity + "Capacity is expected to be a non-negative, multiple-of-eight integer." + + bytes := ByteArray new: capacity // 8. + tally := 0! Item was added: + ----- Method: Bitset>>isEmpty (in category 'testing') ----- + isEmpty + ^tally = 0! Item was added: + ----- Method: Bitset>>occurrencesOf: (in category 'enumerating') ----- + occurrencesOf: anObject + "Answer how many of the receiver's elements are equal to anObject. Optimized version." + + (self includes: anObject) ifTrue: [ ^1 ]. + ^0! Item was added: + ----- Method: Bitset>>postCopy (in category 'copying') ----- + postCopy + "Copy bytes as well." + + bytes := bytes copy! Item was added: + ----- Method: Bitset>>printElementsOn:separatedBy: (in category 'printing') ----- + printElementsOn: aStream separatedBy: delimiter + "Overridden to always inform about the entire set of bits." + + (0 to: self capacity-1) + do: [:index | aStream print: (self bitAt: index)] + separatedBy: [aStream nextPutAll: delimiter asString].! Item was added: + ----- Method: Bitset>>remove:ifAbsent: (in category 'removing') ----- + remove: anInteger ifAbsent: absentBlock + + (self clearBitAt: anInteger) ifTrue: [ ^anInteger ]. + ^absentBlock value! Item was added: + ----- Method: Bitset>>removeAll (in category 'removing') ----- + removeAll + + tally = 0 ifTrue: [ ^self ]. + bytes atAllPut: 0. "Unlike most #removeAll implementations, we don't allocate a new ByteArray here, because this is a bit more efficient. The VM would have to fill the new array with zeroes anyway." + tally := 0! Item was added: + ----- Method: Bitset>>setBitAt: (in category 'bit manipulation') ----- + setBitAt: anInteger + "Set the value corresponding to anInteger to 1. Return true if the value wasn't 1." + + | index value newValue | + index := (anInteger bitShift: -3) + 1. + value := bytes at: index. + (newValue := (1 bitShift: (anInteger bitAnd: 7)) bitOr: value) = value ifTrue: [ ^false ]. + bytes at: index put: newValue. + tally := tally + 1. + ^true! Item was added: + ----- Method: Bitset>>size (in category 'accessing') ----- + size + "Return the number of 1 values in this collection." + + ^tally! 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: + UnsignedIntegerArray variableByteSubclass: #ByteArray - ArrayedCollection variableByteSubclass: #ByteArray instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Collections-Arrayed'! !ByteArray commentStamp: '<historical>' prior: 0! I represent an ArrayedCollection whose elements are integers between 0 and 255. ! Item was added: + ----- Method: ByteArray class>>empty (in category 'instance creation') ----- + empty + "A canonicalized empty ByteArray instance." + ^ #[]! Item was changed: ----- Method: ByteArray class>>hashBytes:startingWith: (in category 'byte based hash') ----- hashBytes: aByteArray startingWith: speciesHash + "Answer the hash of a byte-indexed collection, using speciesHash as the initial value. + See SmallInteger>>hashMultiply. - "Answer the hash of a byte-indexed collection, - using speciesHash as the initial value. - See SmallInteger>>hashMultiply. + The primitive should be renamed at a suitable point in the future" - The primitive should be renamed at a - suitable point in the future" - - | byteArraySize hash low | <primitive: 'primitiveStringHash' module: 'MiscPrimitivePlugin'> + + ^String stringHash: aByteArray initialHash: speciesHash! - <var: #aHash declareC: 'int speciesHash'> - <var: #aByteArray declareC: 'unsigned char *aByteArray'> - - byteArraySize := aByteArray size. - hash := speciesHash bitAnd: 16rFFFFFFF. - 1 to: byteArraySize do: [:pos | - hash := hash + (aByteArray basicAt: pos). - "Begin hashMultiply" - low := hash bitAnd: 16383. - hash := (16r260D * low + ((16r260D * (hash bitShift: -14) + (16r0065 * low) bitAnd: 16383) * 16384)) bitAnd: 16r0FFFFFFF. - ]. - ^ hash! Item was removed: - ----- Method: ByteArray>>asByteArrayPointer (in category 'private') ----- - asByteArrayPointer - "Return a ByteArray describing a pointer to the contents of the receiver." - ^self shouldNotImplement! Item was added: + ----- Method: ByteArray>>ascii85Encoded (in category 'converting') ----- + ascii85Encoded + "Encode the receiver as Ascii85" + "'Hello World' asByteArray ascii85Encoded" + + ^ (Ascii85Converter encode: self readStream) contents! Item was removed: - ----- Method: ByteArray>>at:put: (in category 'accessing') ----- - at: index put: value - <primitive: 61> "try primitiveAtPut, convert value to integer if that fails and try again" - ^ self byteAt: index put: value asInteger - ! Item was removed: - ----- Method: ByteArray>>atAllPut: (in category 'accessing') ----- - atAllPut: value - "Fill the receiver with the given value" - - <primitive: 145> - super atAllPut: value! Item was removed: - ----- Method: ByteArray>>byteSize (in category 'accessing') ----- - byteSize - ^self size! Item was changed: ----- Method: ByteArray>>hash (in category 'comparing') ----- hash "#hash is implemented, because #= is implemented" + ^self hashWithInitialHash: self species hash! - ^self class - hashBytes: self - startingWith: self species hash! Item was added: + ----- Method: ByteArray>>hashWithInitialHash: (in category 'private') ----- + hashWithInitialHash: speciesHash + "Answer the hash of a byte-indexed array, using speciesHash as the initial value. + See SmallInteger>>hashMultiply." + <primitive: 'primitiveStringHash' module: 'MiscPrimitivePlugin'> + + ^String stringHash: self initialHash: speciesHash! Item was changed: ----- Method: ByteArray>>indexOf:startingAt: (in category 'accessing') ----- indexOf: anInteger startingAt: start + anInteger isInteger ifFalse: [ ^0 ]. + 0 <= anInteger ifFalse: [ ^0 ]. + anInteger <= 255 ifFalse: [ ^0 ]. - (anInteger isInteger and: [ - anInteger >= 0 and: [ - anInteger <= 255 ] ]) ifFalse: [ ^0 ]. ^ByteString indexOfAscii: anInteger inString: self startingAt: start! Item was added: + ----- Method: ByteArray>>long64At:bigEndian: (in category 'platform independent access') ----- + long64At: index bigEndian: bigEndian + "Return a 64-bit signed integer quantity starting from the given byte index." + + | value | + value := self unsignedLong64At: index bigEndian: bigEndian. + value digitLength < 8 ifTrue: [ ^value ]. + (value digitAt: 8) < 16r80 ifTrue: [ ^value ]. + ^value - 16r10000000000000000! Item was added: + ----- Method: ByteArray>>long64At:put:bigEndian: (in category 'platform independent access') ----- + long64At: index put: value bigEndian: bigEndian + "Store a 64-bit signed integer quantity starting from the given byte index." + + ^self + unsignedLong64At: index + put: (value negative + ifFalse: [ value ] + ifTrue: [ value + 16r10000000000000000 ]) + bigEndian: bigEndian! Item was changed: ----- Method: ByteArray>>longAt:bigEndian: (in category 'platform independent access') ----- + longAt: index bigEndian: bigEndian + "Return a 32-bit integer quantity starting from the given byte index. Use #normalize where necessary to ensure compatibility with non-30-bit SmallIntegers." + + | byte result | + bigEndian ifFalse: [ + (byte := self at: index + 3) <= 16r7F ifTrue: [ "Is the result non-negative?" + byte <= 16r3F ifTrue: [ + ^(((byte bitShift: 8) + (self at: index + 2) bitShift: 8) + (self at: index + 1) bitShift: 8) + (self at: index) ]. + ^(LargePositiveInteger new: 4) + replaceFrom: 1 + to: 4 + with: self + startingAt: index; + normalize ]. + "Negative" + byte >= 16rC0 ifTrue: [ + ^-1 - (((((byte bitShift: 8) + (self at: index + 2) bitShift: 8) + (self at: index + 1) bitXor: 16rFFFFFF) bitShift: 8) + ((self at: index) bitXor: 16rFF)) ]. + (result := LargeNegativeInteger new: 4) + digitAt: 4 put: ((self at: index + 3) bitXor: 16rFF); + digitAt: 3 put: ((self at: index + 2) bitXor: 16rFF); + digitAt: 2 put: ((self at: index + 1) bitXor: 16rFF). + (byte := ((self at: index) bitXor: 16rFF) + 1) <= 16rFF ifTrue: [ + ^result + digitAt: 1 put: byte; + normalize ]. + ^result + digitAt: 1 put: 16rFF; + - 1 "It's tempting to do the subtraction in a loop to avoid the LargeInteger creation, but it's actually slower than this." ]. + (byte := self at: index) <= 16r7F ifTrue: [ "Is the result non-negative?" + byte <= 16r3F ifTrue: [ + ^(((byte bitShift: 8) + (self at: index + 1) bitShift: 8) + (self at: index + 2) bitShift: 8) + (self at: index + 3) ]. + ^(LargePositiveInteger new: 4) + digitAt: 1 put: (self at: index + 3); + digitAt: 2 put: (self at: index + 2); + digitAt: 3 put: (self at: index + 1); + digitAt: 4 put: byte; + normalize ]. + "Negative" + 16rC0 <= byte ifTrue: [ + ^-1 - (((((byte bitShift: 8) + (self at: index + 1) bitShift: 8) + (self at: index + 2) bitXor: 16rFFFFFF) bitShift: 8) + ((self at: index + 3) bitXor: 16rFF)) ]. + (result := LargeNegativeInteger new: 4) + digitAt: 4 put: (byte bitXor: 16rFF); + digitAt: 3 put: ((self at: index + 1) bitXor: 16rFF); + digitAt: 2 put: ((self at: index + 2) bitXor: 16rFF). + (byte := ((self at: index + 3) bitXor: 16rFF) + 1) <= 16rFF ifTrue: [ + ^result + digitAt: 1 put: byte; + normalize ]. + ^result + digitAt: 1 put: 16rFF; + - 1 "It's tempting to do the subtraction in a loop to avoid the LargeInteger creation, but it's actually slower than this."! - longAt: index bigEndian: aBool - "Return a 32bit integer quantity starting from the given byte index" - | b0 b1 b2 w h | - aBool ifTrue:[ - b0 := self at: index. - b1 := self at: index+1. - b2 := self at: index+2. - w := self at: index+3. - ] ifFalse:[ - w := self at: index. - b2 := self at: index+1. - b1 := self at: index+2. - b0 := self at: index+3. - ]. - "Minimize LargeInteger arithmetic" - h := ((b0 bitAnd: 16r7F) - (b0 bitAnd: 16r80) bitShift: 8) + b1. - b2 = 0 ifFalse:[w := (b2 bitShift: 8) + w]. - h = 0 ifFalse:[w := (h bitShift: 16) + w]. - ^w! Item was changed: ----- Method: ByteArray>>longAt:put:bigEndian: (in category 'platform independent access') ----- + longAt: index put: value bigEndian: bigEndian + "Store a 32-bit signed integer quantity starting from the given byte index" + + | v v2 | + value isLarge ifTrue: [ + bigEndian ifFalse: [ + value positive ifTrue: [ + self + replaceFrom: index + to: index + 3 + with: value + startingAt: 1. + ^value ]. + v := 0. + [ v <= 3 and: [ (v2 := ((value digitAt: v + 1) bitXor: 16rFF) + 1) = 16r100 ] ] whileTrue: [ + self at: index + v put: 0. + v := v + 1 ]. + self at: index + v put: v2. + v := v + 1. + [ v <= 3 ] whileTrue: [ + self at: index + v put: ((value digitAt: (v := v + 1)) bitXor: 16rFF) ]. + ^value ]. + value positive ifTrue: [ + self + at: index put: (value digitAt: 4); + at: index + 1 put: (value digitAt: 3); + at: index + 2 put: (value digitAt: 2); + at: index + 3 put: (value digitAt: 1). + ^value ]. + v := 3. + [ 0 <= v and: [ (v2 := ((value digitAt: 4 - v) bitXor: 16rFF) + 1) = 16r100 ] ] whileTrue: [ + self at: index + v put: 0. + v := v - 1 ]. + self at: index + v put: v2. + [ 0 <= (v := v - 1) ] whileTrue: [ + self at: index + v put: ((value digitAt: 4 - v) bitXor: 16rFF) ]. + ^value ]. + v := value bitShift: -24. + 0 <= (v := (v bitAnd: 16r7F) - (v bitAnd: 16r80)) ifFalse: [ + v := v + 16r100 ]. + bigEndian ifFalse: [ + self + at: index put: (value bitAnd: 16rFF); + at: index + 1 put: ((value bitShift: -8) bitAnd: 16rFF); + at: index + 2 put: ((value bitShift: -16) bitAnd: 16rFF); + at: index + 3 put: v. + ^value ]. + self + at: index put: v; + at: index + 1 put: ((value bitShift: -16) bitAnd: 16rFF); + at: index + 2 put: ((value bitShift: -8) bitAnd: 16rFF); + at: index + 3 put: (value bitAnd: 16rFF). - longAt: index put: value bigEndian: aBool - "Return a 32bit integer quantity starting from the given byte index" - | b0 b1 b2 b3 | - b0 := value bitShift: -24. - b0 := (b0 bitAnd: 16r7F) - (b0 bitAnd: 16r80). - b0 < 0 ifTrue:[b0 := 256 + b0]. - b1 := (value bitShift: -16) bitAnd: 255. - b2 := (value bitShift: -8) bitAnd: 255. - b3 := value bitAnd: 255. - aBool ifTrue:[ - self at: index put: b0. - self at: index+1 put: b1. - self at: index+2 put: b2. - self at: index+3 put: b3. - ] ifFalse:[ - self at: index put: b3. - self at: index+1 put: b2. - self at: index+2 put: b1. - self at: index+3 put: b0. - ]. ^value! Item was added: + ----- Method: ByteArray>>occurrencesOf: (in category 'enumerating') ----- + occurrencesOf: anObject + "Answer how many of the receiver's elements are equal to anObject. Optimized version." + + | tally | + anObject isInteger ifFalse: [ ^0 ]. + anObject negative ifTrue: [ ^0 ]. + anObject > 255 ifTrue: [ ^0 ]. + tally := 0. + 1 to: self size do: [ :index | + (self at: index) = anObject ifTrue: [ tally := tally + 1 ] ]. + ^tally! Item was added: + ----- Method: ByteArray>>printAsLiteralOn: (in category 'printing') ----- + printAsLiteralOn: aStream + aStream nextPut: $#; nextPut: $[. + self do: [:each| each storeOn: aStream] + separatedBy: [aStream nextPut: $ ]. + aStream nextPut: $]! Item was changed: ----- Method: ByteArray>>printOn: (in category 'printing') ----- printOn: aStream + self shouldBePrintedAsLiteral ifFalse: + [super printOn: aStream. + aStream space]. + self printAsLiteralOn: aStream! - - aStream nextPutAll: '#['. - self - do: [ :each | each printOn: aStream ] - separatedBy: [ aStream nextPut: $ ]. - aStream nextPut: $]! Item was changed: ----- Method: ByteArray>>readHexFrom: (in category 'initialize') ----- readHexFrom: aStream "Initialize the receiver from a hexadecimal string representation" + + 1 to: self size do: + [:i| | n v1 v2 | + n := aStream next asInteger. + v1 := n > 57 "$9 asInteger = 57" + ifTrue: + [n > 96 "$a asInteger 97" + ifTrue: [n - 87] + ifFalse: [n > 64 "$A asInteger = 65" + ifTrue: [n - 55] + ifFalse: [-1]]] + ifFalse: [n - 48]. "$0 asInteger = 48" + (v1 between: 0 and: 15) ifFalse: [^self error: 'Hex digit expected']. + n := aStream next asInteger. + v2 := n > 57 "$9 asInteger = 57" + ifTrue: + [n > 96 "$a asInteger 97" + ifTrue: [n - 87] + ifFalse: [n > 64 "$A asInteger = 65" + ifTrue: [n - 55] + ifFalse: [-1]]] + ifFalse: [n - 48]. "$0 asInteger = 48" + (v2 between: 0 and: 15) ifFalse: [^self error: 'Hex digit expected']. + self at: i put: (v1 bitShift: 4) + v2] + + "Proof that our filter selects only hexadecimal characters: + (0 to: 255) + select: + [:n| + (n > 57 + ifTrue: + [n > 96 + ifTrue: [n - 87] + ifFalse: [n > 64 + ifTrue: [n - 55] + ifFalse: [-1]]] + ifFalse: [n - 48]) between: 0 and: 15] + thenCollect: + [:n| Character value: n]"! - | map v ch value | - map := '0123456789abcdefABCDEF'. - 1 to: self size do:[:i| - ch := aStream next. - v := (map indexOf: ch) - 1. - ((v between: 0 and: 15) or: [((v:= v - 6) between: 0 and: 15)]) ifFalse:[^self error: 'Hex digit expected']. - value := v bitShift: 4. - ch := aStream next. - v := (map indexOf: ch) - 1. - ((v between: 0 and: 15) or: [((v:= v - 6) between: 0 and: 15)]) ifFalse:[^self error: 'Hex digit expected']. - value := value + v. - self at: i put: value. - ]. - ! Item was changed: ----- Method: ByteArray>>replaceFrom:to:with:startingAt: (in category 'private') ----- replaceFrom: start to: stop with: replacement startingAt: repStart "Primitive. This destructively replaces elements from start to stop in the receiver starting at index, repStart, in the collection, replacement. Answer the receiver. Range checks are performed in the primitive only. Optional. See Object documentation whatIsAPrimitive." <primitive: 105> + replacement isString + ifFalse: + [super replaceFrom: start to: stop with: replacement startingAt: repStart] + ifTrue: + [ "use String>>byteAt: to mimic prim 105" + | index repOff | + repOff := repStart - start. + index := start - 1. + [(index := index + 1) <= stop] + whileTrue: [self at: index put: (replacement byteAt: repOff + index)]] + ! - super replaceFrom: start to: stop with: replacement startingAt: repStart! Item was changed: ----- Method: ByteArray>>shortAt:bigEndian: (in category 'platform independent access') ----- + shortAt: index bigEndian: bigEndian + "Return a 16-bit signed integer quantity starting from the given byte index" + + | result | + result := bigEndian + ifFalse: [ ((self at: index + 1) bitShift: 8) + (self at: index) ] + ifTrue: [ ((self at: index) bitShift: 8) + (self at: index + 1) ]. + result < 16r8000 ifTrue: [ ^result ]. + ^result - 16r10000! - shortAt: index bigEndian: aBool - "Return a 16 bit integer quantity starting from the given byte index" - | uShort | - uShort := self unsignedShortAt: index bigEndian: aBool. - ^(uShort bitAnd: 16r7FFF) - (uShort bitAnd: 16r8000)! Item was changed: ----- Method: ByteArray>>shortAt:put:bigEndian: (in category 'platform independent access') ----- + shortAt: index put: value bigEndian: bigEndian + "Store a 16-bit signed integer quantity starting from the given byte index" + + | unsignedValue | + (unsignedValue := value) < 0 ifTrue: [ + unsignedValue := unsignedValue + 16r10000 ]. + bigEndian ifFalse: [ + self + at: index + 1 put: (unsignedValue bitShift: -8); + at: index put: (unsignedValue bitAnd: 16rFF). + ^value ]. + self + at: index put: (unsignedValue bitShift: -8); + at: index + 1 put: (unsignedValue bitAnd: 16rFF). - shortAt: index put: value bigEndian: aBool - "Store a 16 bit integer quantity starting from the given byte index" - self unsignedShortAt: index put: (value bitAnd: 16r7FFF) - (value bitAnd: -16r8000) bigEndian: aBool. ^value! Item was added: + ----- Method: ByteArray>>signedByteAt: (in category 'platform independent access') ----- + signedByteAt: index + "Answer an 8-bit signed integer quantity from the given byte index." + <primitive: 165> + | byte | + (byte := self at: index) <= 16r7F ifTrue: [ ^byte ]. + ^byte - 16r100! Item was added: + ----- Method: ByteArray>>signedByteAt:put: (in category 'platform independent access') ----- + signedByteAt: index put: anInteger + "Store an 8-bit signed integer quantity at the given byte index." + <primitive: 166> + anInteger >= 0 ifTrue: [ ^self at: index put: anInteger ]. + self at: index put: anInteger + 16r100. + ^anInteger! Item was changed: ----- Method: ByteArray>>storeOn: (in category 'printing') ----- storeOn: aStream + self shouldBePrintedAsLiteral + ifTrue: [self printAsLiteralOn: aStream] + ifFalse: [super storeOn: aStream]! - aStream nextPutAll: '#['. - self - do: [ :each | each storeOn: aStream ] - separatedBy: [ aStream nextPut: $ ]. - aStream nextPut: $]! Item was added: + ----- Method: ByteArray>>unsignedLong64At:bigEndian: (in category 'platform independent access') ----- + unsignedLong64At: index bigEndian: bigEndian + "Return a 64-bit unsigned integer quantity starting from the given byte index. Use #normalize where necessary to ensure compatibility with non-30-bit SmallIntegers." + + | byte | + SmallInteger maxVal > 1073741823 ifTrue: + [bigEndian + ifTrue: "64-bit SmallIntegers have a 3 bit tag and a sign bit, so the most positive value has 16rF as its top byte." + [(byte := self at: index) <= 16rF ifTrue: + [^((((((((byte bitShift: 8) + (self at: index + 1) bitShift: 8) + (self at: index + 2) bitShift: 8) + (self at: index + 3)) bitShift: 8) + + (self at: index + 4) bitShift: 8) + (self at: index + 5) bitShift: 8) + (self at: index + 6) bitShift: 8) + (self at: index + 7)]] + ifFalse: + [(byte := self at: index + 7) <= 16rF ifTrue: + [^((((((((byte bitShift: 8) + (self at: index + 6) bitShift: 8) + (self at: index + 5) bitShift: 8) + (self at: index + 4)) bitShift: 8) + + (self at: index + 3) bitShift: 8) + (self at: index + 2) bitShift: 8) + (self at: index + 1) bitShift: 8) + (self at: index)]]]. + bigEndian ifFalse: [ + (byte := self at: index + 7) = 0 ifFalse: [ + ^(LargePositiveInteger new: 8) + replaceFrom: 1 to: 8 with: self startingAt: index; + normalize ]. + (byte := self at: index + 6) = 0 ifFalse: [ + ^(LargePositiveInteger new: 7) + replaceFrom: 1 to: 7 with: self startingAt: index; + normalize ]. + (byte := self at: index + 5) = 0 ifFalse: [ + ^(LargePositiveInteger new: 6) + replaceFrom: 1 to: 6 with: self startingAt: index; + normalize ]. + (byte := self at: index + 4) = 0 ifFalse: [ + ^(LargePositiveInteger new: 5) + replaceFrom: 1 to: 5 with: self startingAt: index; + normalize ]. + (byte := self at: index + 3) <= 16r3F ifFalse: [ + ^(LargePositiveInteger new: 4) + replaceFrom: 1 to: 4 with: self startingAt: index; + normalize ]. + ^(((byte bitShift: 8) + (self at: index + 2) bitShift: 8) + (self at: index + 1) bitShift: 8) + (self at: index) ]. + (byte := self at: index) = 0 ifFalse: [ + ^(LargePositiveInteger new: 8) + digitAt: 1 put: (self at: index + 7); + digitAt: 2 put: (self at: index + 6); + digitAt: 3 put: (self at: index + 5); + digitAt: 4 put: (self at: index + 4); + digitAt: 5 put: (self at: index + 3); + digitAt: 6 put: (self at: index + 2); + digitAt: 7 put: (self at: index + 1); + digitAt: 8 put: byte; + normalize ]. + (byte := self at: index + 1) = 0 ifFalse: [ + ^(LargePositiveInteger new: 7) + digitAt: 1 put: (self at: index + 7); + digitAt: 2 put: (self at: index + 6); + digitAt: 3 put: (self at: index + 5); + digitAt: 4 put: (self at: index + 4); + digitAt: 5 put: (self at: index + 3); + digitAt: 6 put: (self at: index + 2); + digitAt: 7 put: byte; + normalize ]. + (byte := self at: index + 2) = 0 ifFalse: [ + ^(LargePositiveInteger new: 6) + digitAt: 1 put: (self at: index + 7); + digitAt: 2 put: (self at: index + 6); + digitAt: 3 put: (self at: index + 5); + digitAt: 4 put: (self at: index + 4); + digitAt: 5 put: (self at: index + 3); + digitAt: 6 put: byte; + normalize ]. + (byte := self at: index + 3) = 0 ifFalse: [ + ^(LargePositiveInteger new: 5) + digitAt: 1 put: (self at: index + 7); + digitAt: 2 put: (self at: index + 6); + digitAt: 3 put: (self at: index + 5); + digitAt: 4 put: (self at: index + 4); + digitAt: 5 put: byte; + normalize ]. + (byte := self at: index + 4) <= 16r3F ifFalse: [ + ^(LargePositiveInteger new: 4) + digitAt: 1 put: (self at: index + 7); + digitAt: 2 put: (self at: index + 6); + digitAt: 3 put: (self at: index + 5); + digitAt: 4 put: byte; + normalize ]. + ^(((byte bitShift: 8) + (self at: index + 5) bitShift: 8) + (self at: index + 6) bitShift: 8) + (self at: index + 7)! Item was added: + ----- Method: ByteArray>>unsignedLong64At:put:bigEndian: (in category 'platform independent access') ----- + unsignedLong64At: index put: value bigEndian: bigEndian + "Store a 64-bit unsigned integer quantity starting from the given byte index" + + | i j | + value isLarge ifTrue: [ + i := value digitLength. + bigEndian ifFalse: [ + self + replaceFrom: index + to: index + i - 1 + with: value + startingAt: 1; + replaceFrom: index + i + to: index + 7 + with: #[0 0 0 0 0 0 0 0] + startingAt: 1. + ^value ]. + j := index + 8. + i <= 7 ifTrue: [ + self + replaceFrom: index + to: j - i - 1 + with: #[0 0 0 0 0 0 0 0] + startingAt: 1 ]. + [ 1 <= i ] whileTrue: [ + self at: j - i put: (value digitAt: i). + i := i - 1 ]. + ^value ]. + bigEndian ifFalse: [ + j := index - 1. + i := value. + [ 1 <= i ] whileTrue: [ + self at: (j := j + 1) put: (i bitAnd: 16rFF). + i := i bitShift: -8 ]. + self replaceFrom: j + 1 + to: index + 7 + with: #[0 0 0 0 0 0 0 0] + startingAt: 1. + ^value ]. + j := index + 8. + i := value. + [ 1 <= i ] whileTrue: [ + self at: (j := j - 1) put: (i bitAnd: 16rFF). + i := i bitShift: -8 ]. + self replaceFrom: index + to: j - 1 + with: #[0 0 0 0 0 0 0 0] + startingAt: 1. + ^value! Item was changed: ----- Method: ByteArray>>unsignedLongAt:bigEndian: (in category 'platform independent access') ----- + unsignedLongAt: index bigEndian: bigEndian + "Return a 32-bit unsigned integer quantity starting from the given byte index. Use #normalize where necessary to ensure compatibility with non-30-bit SmallIntegers." + | byte | + bigEndian ifTrue: + [((byte := self at: index) <= 16r3F + or: [SmallInteger maxVal > 1073741823]) ifTrue: + [^(((byte bitShift: 8) + (self at: index + 1) bitShift: 8) + (self at: index + 2) bitShift: 8) + (self at: index + 3)]. + ^(LargePositiveInteger new: 4) + digitAt: 1 put: (self at: index + 3); + digitAt: 2 put: (self at: index + 2); + digitAt: 3 put: (self at: index + 1); + digitAt: 4 put: byte; + normalize]. + ((byte := self at: index + 3) <= 16r3F + or: [SmallInteger maxVal > 1073741823]) ifTrue: + [^(((byte bitShift: 8) + (self at: index + 2) bitShift: 8) + (self at: index + 1) bitShift: 8) + (self at: index)]. + ^(LargePositiveInteger new: 4) + replaceFrom: 1 to: 4 with: self startingAt: index; + normalize! - unsignedLongAt: index bigEndian: aBool - "Return a 32bit unsigned integer quantity starting from the given byte index" - | b0 b1 b2 w | - aBool ifTrue:[ - b0 := self at: index. - b1 := self at: index+1. - b2 := self at: index+2. - w := self at: index+3. - ] ifFalse:[ - w := self at: index. - b2 := self at: index+1. - b1 := self at: index+2. - b0 := self at: index+3. - ]. - "Minimize LargeInteger arithmetic" - b2 = 0 ifFalse:[w := (b2 bitShift: 8) + w]. - b1 = 0 ifFalse:[w := (b1 bitShift: 16) + w]. - b0 = 0 ifFalse:[w := (b0 bitShift: 24) + w]. - ^w! Item was changed: ----- Method: ByteArray>>unsignedLongAt:put:bigEndian: (in category 'platform independent access') ----- + unsignedLongAt: index put: value bigEndian: bigEndian + "Store a 32-bit unsigned integer quantity starting from the given byte index" + + value isLarge + ifTrue: [ + bigEndian ifFalse: [ + self + replaceFrom: index + to: index + 3 + with: value + startingAt: 1. + ^value ]. + self + at: index put: (value digitAt: 4); + at: index + 1 put: (value digitAt: 3); + at: index + 2 put: (value digitAt: 2); + at: index +3 put: (value digitAt: 1) ] + ifFalse: [ + bigEndian ifFalse: [ + self + at: index put: (value bitAnd: 16rFF); + at: index + 1 put: ((value bitShift: -8) bitAnd: 16rFF); + at: index + 2 put: ((value bitShift: -16) bitAnd: 16rFF); + at: index + 3 put: (value bitShift: -24). + ^value ]. + self + at: index put: (value bitShift: -24); + at: index + 1 put: ((value bitShift: -16) bitAnd: 16rFF); + at: index + 2 put: ((value bitShift: -8) bitAnd: 16rFF); + at: index + 3 put: (value bitAnd: 16rFF) ]. - unsignedLongAt: index put: value bigEndian: aBool - "Store a 32bit unsigned integer quantity starting from the given byte index" - | b0 b1 b2 b3 | - b0 := value bitShift: -24. - b1 := (value bitShift: -16) bitAnd: 255. - b2 := (value bitShift: -8) bitAnd: 255. - b3 := value bitAnd: 255. - aBool ifTrue:[ - self at: index put: b0. - self at: index+1 put: b1. - self at: index+2 put: b2. - self at: index+3 put: b3. - ] ifFalse:[ - self at: index put: b3. - self at: index+1 put: b2. - self at: index+2 put: b1. - self at: index+3 put: b0. - ]. ^value! Item was changed: ----- Method: ByteArray>>unsignedShortAt:bigEndian: (in category 'platform independent access') ----- + unsignedShortAt: index bigEndian: bigEndian + "Return a 16-bit unsigned integer quantity starting from the given byte index" + + bigEndian ifFalse: [ ^((self at: index + 1) bitShift: 8) + (self at: index) ]. + ^((self at: index) bitShift: 8) + (self at: index + 1) + ! - unsignedShortAt: index bigEndian: aBool - "Return a 16 bit unsigned integer quantity starting from the given byte index" - ^aBool - ifTrue:[((self at: index) bitShift: 8) + (self at: index+1)] - ifFalse:[((self at: index+1) bitShift: 8) + (self at: index)].! Item was changed: ----- Method: ByteArray>>unsignedShortAt:put:bigEndian: (in category 'platform independent access') ----- + unsignedShortAt: index put: value bigEndian: bigEndian + "Store a 16-bit unsigned integer quantity starting from the given byte index" + + bigEndian ifFalse: [ + self + at: index + 1 put: (value bitShift: -8); + at: index put: (value bitAnd: 16rFF). + ^value ]. + self + at: index put: (value bitShift: -8); + at: index+1 put: (value bitAnd: 16rFF). - unsignedShortAt: index put: value bigEndian: aBool - "Store a 16 bit unsigned integer quantity starting from the given byte index" - aBool ifTrue:[ - self at: index put: (value bitShift: -8). - self at: index+1 put: (value bitAnd: 255). - ] ifFalse:[ - self at: index+1 put: (value bitShift: -8). - self at: index put: (value bitAnd: 255). - ]. ^value! Item was added: + CharacterSet subclass: #ByteCharacterSet + instanceVariableNames: 'tally' + classVariableNames: '' + poolDictionaries: '' + category: 'Collections-Support'! + + !ByteCharacterSet commentStamp: '<historical>' prior: 0! + A set of characters. Lookups for inclusion are very fast.! Item was added: + ----- Method: ByteCharacterSet class>>allCharacters (in category 'instance creation') ----- + allCharacters + "return a set containing all byte characters" + + ^ self fromMap: (ByteArray new: 256 withAll: 1)! Item was added: + ----- Method: ByteCharacterSet class>>fromMap: (in category 'instance creation') ----- + fromMap: aByteArray + + ^self basicNew fromMap: aByteArray! Item was added: + ----- Method: ByteCharacterSet>>= (in category 'comparing') ----- + = anObject + + self species == anObject species ifFalse: [ ^false ]. + anObject size = tally ifFalse: [ ^false ]. + ^self byteArrayMap = anObject byteArrayMap! Item was added: + ----- Method: ByteCharacterSet>>add: (in category 'adding') ----- + add: aCharacter + "I automatically become a WideByteCharacterSet if you add a wide character to myself" + + | index | + (index := aCharacter asInteger + 1) <= 256 ifFalse: [ + | wide | + wide := WideCharacterSet new. + wide addAll: self. + wide add: aCharacter. + self becomeForward: wide. + ^aCharacter ]. + (byteArrayMap at: index) = 1 ifFalse: [ + byteArrayMap at: index put: 1. + tally := tally + 1 ]. + ^aCharacter! Item was added: + ----- Method: ByteCharacterSet>>asString (in category 'conversion') ----- + asString + "Convert the receiver into a String" + + ^String new: self size streamContents:[:s| + self do:[:ch| s nextPut: ch]. + ].! Item was added: + ----- Method: ByteCharacterSet>>byteArrayMap (in category 'private') ----- + byteArrayMap + "return a ByteArray mapping each ascii value to a 1 if that ascii value is in the set, and a 0 if it isn't. Intended for use by primitives only" + ^byteArrayMap! Item was added: + ----- Method: ByteCharacterSet>>do: (in category 'enumerating') ----- + do: aBlock + "evaluate aBlock with each character in the set" + + | index | + tally >= 128 ifTrue: [ "dense" + index := 0. + [ (index := index + 1) <= 256 ] whileTrue: [ + (byteArrayMap at: index) = 1 ifTrue: [ + aBlock value: (Character value: index - 1) ] ]. + ^self ]. + "sparse" + index := 0. + [ (index := byteArrayMap indexOf: 1 startingAt: index + 1) = 0 ] whileFalse: [ + aBlock value: (Character value: index - 1) ]. + ! Item was added: + ----- Method: ByteCharacterSet>>enumerationCost (in category 'private') ----- + enumerationCost + "Low cost. I do not hold more than 256 characters." + + ^10! Item was added: + ----- Method: ByteCharacterSet>>fromMap: (in category 'initialize-release') ----- + fromMap: aByteArray + byteArrayMap := aByteArray. + tally := aByteArray count: [:e | e = 1]! Item was added: + ----- Method: ByteCharacterSet>>hasWideCharacters (in category 'testing') ----- + hasWideCharacters + ^false! Item was added: + ----- Method: ByteCharacterSet>>hash (in category 'comparing') ----- + hash + ^self byteArrayMap hash! Item was added: + ----- Method: ByteCharacterSet>>includesCode: (in category 'testing') ----- + includesCode: anInteger + anInteger > 255 ifTrue: [ ^false ]. + ^(byteArrayMap at: anInteger + 1) > 0! Item was added: + ----- Method: ByteCharacterSet>>initialize (in category 'initialize-release') ----- + initialize + byteArrayMap := ByteArray new: 256. + tally := 0! Item was added: + ----- Method: ByteCharacterSet>>isEmpty (in category 'testing') ----- + isEmpty + ^tally = 0! Item was added: + ----- Method: ByteCharacterSet>>postCopy (in category 'copying') ----- + postCopy + super postCopy. + byteArrayMap := byteArrayMap copy! Item was added: + ----- Method: ByteCharacterSet>>remove: (in category 'removing') ----- + remove: aCharacter + + ^self remove: aCharacter ifAbsent: aCharacter! Item was added: + ----- Method: ByteCharacterSet>>remove:ifAbsent: (in category 'removing') ----- + remove: aCharacter ifAbsent: aBlock + + | index | + (index := aCharacter asciiValue + 1) <= 256 ifFalse: [ ^aBlock value ]. + (byteArrayMap at: index) = 0 ifTrue: [ ^aBlock value ]. + byteArrayMap at: index put: 0. + tally := tally - 1. + ^aCharacter! Item was added: + ----- Method: ByteCharacterSet>>removeAll (in category 'removing') ----- + removeAll + + byteArrayMap atAllPut: 0. + tally := 0! Item was added: + ----- Method: ByteCharacterSet>>size (in category 'accessing') ----- + size + + ^tally! Item was added: + ----- Method: ByteCharacterSet>>wideCharacterMap (in category 'private') ----- + wideCharacterMap + "used for comparing with WideByteCharacterSet" + + | wide | + wide := WideCharacterSet new. + wide addAll: self. + ^wide wideCharacterMap! Item was changed: ----- Method: ByteString class>>findFirstInString:inSet:startingAt: (in category 'primitives') ----- findFirstInString: aString inSet: inclusionMap startingAt: start | i stringSize | <primitive: 'primitiveFindFirstInString' module: 'MiscPrimitivePlugin'> <var: #aString declareC: 'unsigned char *aString'> <var: #inclusionMap declareC: 'char *inclusionMap'> inclusionMap size ~= 256 ifTrue: [ ^0 ]. i := start. stringSize := aString size. + [ i <= stringSize and: [ (inclusionMap at: (aString basicAt: i) + 1) = 0 ] ] whileTrue: [ - [ i <= stringSize and: [ (inclusionMap at: (aString at: i) asciiValue+1) = 0 ] ] whileTrue: [ i := i + 1 ]. i > stringSize ifTrue: [ ^0 ]. ^i! Item was changed: ----- Method: ByteString class>>indexOfAscii:inString:startingAt: (in category 'primitives') ----- indexOfAscii: anInteger inString: aString startingAt: start | stringSize | <primitive: 'primitiveIndexOfAsciiInString' module: 'MiscPrimitivePlugin'> + <var: #aString type: #'unsigned char *'> - <var: #aCharacter declareC: 'int anInteger'> - <var: #aString declareC: 'unsigned char *aString'> stringSize := aString size. start to: stringSize do: [:pos | + (aString basicAt: pos) = anInteger ifTrue: [^ pos]]. - (aString at: pos) asciiValue = anInteger ifTrue: [^ pos]]. + ^ 0! - ^ 0 - ! Item was changed: ----- Method: ByteString class>>stringHash:initialHash: (in category 'primitives') ----- stringHash: aString initialHash: speciesHash + "Answer the hash of a byte-indexed string, using speciesHash as the initial value. + See SmallInteger>>hashMultiply." - - | stringSize hash low | <primitive: 'primitiveStringHash' module: 'MiscPrimitivePlugin'> + + ^super stringHash: aString initialHash: speciesHash! - - <var: #aHash declareC: 'int speciesHash'> - <var: #aString declareC: 'unsigned char *aString'> - - stringSize := aString size. - hash := speciesHash bitAnd: 16rFFFFFFF. - 1 to: stringSize do: [:pos | - hash := hash + (aString at: pos) asciiValue. - "Begin hashMultiply" - low := hash bitAnd: 16383. - hash := (16r260D * low + ((16r260D * (hash bitShift: -14) + (16r0065 * low) bitAnd: 16383) * 16384)) bitAnd: 16r0FFFFFFF. - ]. - ^ hash! Item was changed: ----- Method: ByteString class>>translate:from:to:table: (in category 'primitives') ----- translate: aString from: start to: stop table: table "translate the characters in the string by the given table, in place" <primitive: 'primitiveTranslateStringWithTable' module: 'MiscPrimitivePlugin'> <var: #table declareC: 'unsigned char *table'> <var: #aString declareC: 'unsigned char *aString'> start to: stop do: [ :i | + aString at: i put: (table at: (aString basicAt: i) + 1) ]! - aString at: i put: (table at: (aString at: i) asciiValue+1) ]! Item was added: + ----- Method: ByteString>>applyLanguageInformation: (in category 'accessing') ----- + applyLanguageInformation: aLanguage + "Overwritten because the receiver has latin-1 encoding and thus needs no extra language information applied." + ! Item was added: + ----- Method: ByteString>>asIntegerSigned: (in category 'converting') ----- + asIntegerSigned: signed + "Return the first decimal integer I can find or nil." + + | index integerValue result size negative | + (size := self size) <= 16 ifFalse: [ ^super asIntegerSigned: signed ]. + "Find the first character between $0 and $9." + index := 0. + [ + (index := index + 1) <= size ifFalse: [ ^nil "There are no digits in this string." ]. + (integerValue := self basicAt: index) <= 47 "$0 asInteger - 1" + or: [ 58 "$9 asInteger + 1" <= integerValue ] ] whileTrue. + "Check the sign." + negative := signed and: [ 2 <= index and: [ (self at: index - 1) == $- ] ]. + "Parse the number." + result := integerValue - 48 "$0 asInteger". + [ (index := index + 1) <= size + and: [ (integerValue := self basicAt: index) <= 57 "$9 asInteger" + and: [ 48 "$0 asInteger" <= integerValue ] ] ] whileTrue: [ + result := result * 10 + integerValue - 48 ]. + negative ifTrue: [ ^result negated ]. + ^result! Item was changed: ----- Method: ByteString>>at:put: (in category 'accessing') ----- at: index put: aCharacter + "Primitive. Store the Character in the field of the receiver indicated by the index. + Fail if the index is not an Integer or is out of bounds, or if the argument is not a + Character, or the Character's code is outside the 0-255 range, or if the receiver + is read-only. Essential. See Object documentation whatIsAPrimitive." - "Primitive. Store the Character in the field of the receiver indicated by - the index. Fail if the index is not an Integer or is out of bounds, or if - the argument is not a Character. Essential. See Object documentation - whatIsAPrimitive." + <primitive: 64 error: ec> + aCharacter isCharacter ifFalse: + [^self errorImproperStore]. - <primitive: 64> - aCharacter isCharacter - ifFalse:[^self errorImproperStore]. - aCharacter isOctetCharacter ifFalse:[ - "Convert to WideString" - self becomeForward: (WideString from: self). - ^self at: index put: aCharacter. - ]. index isInteger + ifTrue: + [ec == #'no modification' ifTrue: + [^thisContext modificationForbiddenFor: self at: index putCharacter: aCharacter]. + aCharacter isOctetCharacter ifFalse: "Convert to WideString" + [self becomeForward: (WideString from: self). + ^self at: index put: aCharacter]. + self errorSubscriptBounds: index] - ifTrue: [self errorSubscriptBounds: index] ifFalse: [self errorNonIntegerIndex]! Item was changed: ----- Method: ByteString>>convertFromSystemString (in category 'converting') ----- convertFromSystemString | readStream writeStream converter | readStream := self readStream. writeStream := String new writeStream. + converter := Locale currentPlatform systemConverter. - converter := LanguageEnvironment defaultSystemConverter. converter ifNil: [^ self]. [readStream atEnd] whileFalse: [ writeStream nextPut: (converter nextFromStream: readStream)]. ^ writeStream contents ! Item was changed: ----- Method: ByteString>>findSubstring:in:startingAt:matchTable: (in category 'comparing') ----- findSubstring: key in: body startingAt: start matchTable: matchTable "Answer the index in the string body at which the substring key first occurs, at or beyond start. The match is determined using matchTable, which can be used to effect, eg, case-insensitive matches. If no match is found, zero will be returned. The algorithm below is not optimum -- it is intended to be translated to C which will go so fast that it wont matter." | index | <primitive: 'primitiveFindSubstring' module: 'MiscPrimitivePlugin'> + <var: #key type: #'unsigned char *'> + <var: #body type: #'unsigned char *'> + <var: #matchTable type: #'unsigned char *'> - <var: #key declareC: 'unsigned char *key'> - <var: #body declareC: 'unsigned char *body'> - <var: #matchTable declareC: 'unsigned char *matchTable'> key size = 0 ifTrue: [^ 0]. (start max: 1) to: body size - key size + 1 do: [:startIndex | index := 1. + [(matchTable at: (body basicAt: startIndex+index-1) + 1) + = (matchTable at: (key basicAt: index) + 1)] + whileTrue: - [(matchTable at: (body at: startIndex+index-1) asciiValue + 1) - = (matchTable at: (key at: index) asciiValue + 1)] - whileTrue: [index = key size ifTrue: [^ startIndex]. index := index+1]]. ^ 0 " ' ' findSubstring: 'abc' in: 'abcdefabcd' startingAt: 1 matchTable: CaseSensitiveOrder 1 ' ' findSubstring: 'abc' in: 'abcdefabcd' startingAt: 2 matchTable: CaseSensitiveOrder 7 ' ' findSubstring: 'abc' in: 'abcdefabcd' startingAt: 8 matchTable: CaseSensitiveOrder 0 ' ' findSubstring: 'abc' in: 'abcdefABcd' startingAt: 2 matchTable: CaseSensitiveOrder 0 ' ' findSubstring: 'abc' in: 'abcdefABcd' startingAt: 2 matchTable: CaseInsensitiveOrder 7 "! Item was removed: - ----- Method: ByteString>>indexOfAnyOf:startingAt:ifAbsent: (in category 'accessing') ----- - indexOfAnyOf: aCollection startingAt: start ifAbsent: aBlock - "Use double dispatching for speed" - | index | - ^(index := aCollection findFirstInByteString: self startingAt: start) = 0 - ifTrue: [aBlock value] - ifFalse: [index]! Item was added: + ----- Method: ByteString>>occurrencesOf: (in category 'enumerating') ----- + occurrencesOf: anObject + "Answer how many of the receiver's elements are equal to anObject. Optimized version." + + | tally | + anObject isCharacter ifFalse: [ ^0 ]. + anObject asInteger > 255 ifTrue: [ ^0 ]. + tally := 0. + 1 to: self size do: [ :index | + (self at: index) == anObject ifTrue: [ tally := tally + 1 ] ]. + ^tally! Item was removed: - ----- Method: ByteString>>substrings (in category 'converting') ----- - substrings - "Answer an array of the substrings that compose the receiver." - | result end beginning | - result := WriteStream on: (Array new: 10). - end := 0. - "find one substring each time through this loop" - [ "find the beginning of the next substring" - beginning := self indexOfAnyOf: CharacterSet nonSeparators - startingAt: end+1 ifAbsent: [ nil ]. - beginning ~~ nil ] whileTrue: [ - "find the end" - end := self indexOfAnyOf: CharacterSet separators - startingAt: beginning ifAbsent: [ self size + 1 ]. - end := end - 1. - result nextPut: (self copyFrom: beginning to: end). - ]. - ^result contents! Item was changed: ----- Method: ByteSymbol class>>stringHash:initialHash: (in category 'primitives') ----- stringHash: aString initialHash: speciesHash + "Answer the hash of a byte-indexed string, using speciesHash as the initial value. + See SmallInteger>>hashMultiply." + <primitive: 'primitiveStringHash' module: 'MiscPrimitivePlugin'> + + ^super stringHash: aString initialHash: speciesHash! - ^ByteString stringHash: aString initialHash: speciesHash! Item was removed: - ----- Method: ByteSymbol>>indexOfAnyOf:startingAt:ifAbsent: (in category 'accessing') ----- - indexOfAnyOf: aCollection startingAt: start ifAbsent: aBlock - "Use double dispatching for speed" - | index | - ^(index := aCollection findFirstInByteString: self startingAt: start) = 0 - ifTrue: [aBlock value] - ifFalse: [index]! Item was added: + ----- Method: ByteSymbol>>occurrencesOf: (in category 'enumerating') ----- + occurrencesOf: anObject + "Answer how many of the receiver's elements are equal to anObject. Optimized version." + + | tally | + anObject isCharacter ifFalse: [ ^0 ]. + anObject asInteger > 255 ifTrue: [ ^0 ]. + tally := 0. + 1 to: self size do: [ :index | + (self at: index) == anObject ifTrue: [ tally := tally + 1 ] ]. + ^tally! Item was removed: - ----- Method: ByteSymbol>>pvtAt:put: (in category 'private') ----- - pvtAt: index put: aCharacter - "Primitive. Store the Character in the field of the receiver indicated by - the index. Fail if the index is not an Integer or is out of bounds, or if - the argument is not a Character. Essential. See Object documentation - whatIsAPrimitive." - - <primitive: 64> - aCharacter isCharacter - ifFalse:[^self errorImproperStore]. - index isInteger - ifTrue: [self errorSubscriptBounds: index] - ifFalse: [self errorNonIntegerIndex]! Item was removed: - ----- Method: ByteSymbol>>string: (in category 'private') ----- - string: aString - 1 to: aString size do: [:j | self pvtAt: j put: (aString at: j)]. - ^self! 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 changed: Magnitude subclass: #Character instanceVariableNames: 'value' classVariableNames: 'AlphaNumericMask CharacterTable ClassificationTable DigitBit DigitValues LetterMask LowercaseBit UppercaseBit' poolDictionaries: '' category: 'Collections-Strings'! + !Character commentStamp: 'dtl 3/12/2022 13:57' prior: 0! + I represent a character by storing its associated Unicode code point as an unsigned 30-bit value. Characters are created uniquely, so that all instances of a particular Unicode are identical. My instances are encoded in tagged pointers in the VM, so called immediates, and therefore are pure immutable values. - !Character commentStamp: 'ar 4/9/2005 22:35' prior: 0! - I represent a character by storing its associated Unicode. The first 256 characters are created uniquely, so that all instances of latin1 characters ($R, for example) are identical. + (Bit encoding described below is for Spur image format, not V3 -dtl March 2022) + Here is my bit layout (1-based, check via #asInteger and #bitAt:): + 1..21 Unicode code point (i.e., 0 to: 16r1FFFFF, valid up to 16r10FFFF) + 22 Reserved + 23..30 User data (1 byte, see below about #leadingChar or "encoding tag") + 31..32 VM-specific (i.e., tagged pointers, not accessible from image) - The code point is based on Unicode. Since Unicode is 21-bit wide character set, we have several bits available for other information. As the Unicode Standard states, a Unicode code point doesn't carry the language information. This is going to be a problem with the languages so called CJK (Chinese, Japanese, Korean. Or often CJKV including Vietnamese). Since the characters of those languages are unified and given the same code point, it is impossible to display a bare Unicode code point in an inspector or such tools. To utilize the extra available bits, we use them for identifying the languages. Since the old implementation uses the bits to identify the character encoding, the bits are sometimes called "encoding tag" or neutrally "leading char", but the bits rigidly denotes the concept of languages. + The integer value of my instances you can observe in the image can thus range from 0 up to 16r3FFFFFFF. The two highest bits are not accessible. (For simplicity, we just assume those are at the higher end. The VM can also choose to use the two lowest bits, which does not change the in-image perspective.) - The other languages can have the language tag if you like. This will help to break the large default font (font set) into separately loadable chunk of fonts. However, it is open to the each native speakers and writers to decide how to define the character equality, since the same Unicode code point may have different language tag thus simple #= comparison may return false. + *** + + I. About Character Encoding + + In the early days of Squeak, the bits in each character had the single-byte MacRoman encoding. There was only ByteString, no WideString. The VM (primitives/plugins) provided user-input values in MacRoman, the fonts expected MacRoman for glyph mapping, and source code was stored (.changes, .sources, .st, .cs) in MacRoman. The most prominent non-ASCII character was probably the #annotationSeparator ($· MacRoman code point 225). + + With the release of Squeak 3.8 in June 2005, support for multilingualization (m17n) was added. There were now various text converters (e.g., UTF8TextConverter) and an extensible mechanism to decode platform-specific encodings for Squeak. Since byte streams from files or sockets can have any encoding, the relevant ones concerned user/keyboard input, file paths/names, the platform clipboard, and source code. See the following (sub-)classes: + + - TextConverter + - KeyboardInputInterpreter + - ClipboardInterpreter + + Squeak's internal encoding changed from MacRoman to Latin-1 (i.e., ISO 8859-1), the helper #macToSqueak was introduced, and the #annotationSeparator now had the code point 183 (via SqueakV39.sources). Since the release of Squeak 3.9 in March 2008, both .sources and .changes files have been using the UTF8TextConverter. So, actually, Squeaks character encoding was now plain Unicode code points, which includes Latin-1 for code points 0 to 255 (and ASCII from 0 to 127). + + Older VMs provided MacRoman encoding on all supported platforms. Keyboard input, file paths, clipboard contents. With the introduction of Unicode to Squeak, VMs could now be able to provide Unicode code points (e.g., #win32VMUsesUnicode). However, VMs may just have passed on platform-specifc encodings into the image such as X11 or Windows on a Japanese platform. In that case, Squeak needs to be aware of how to decode that content to get plain Unicode code points. Read more about LanguageEnvironment below. + + + II. Unicode and Han Unification, the "Leading Char" + + As the Unicode standard states, a Unicode code point does not carry the language information. This is a challenge for languages called CJK[V] (i.e., Chinese, Japanese, Korean, [Vietnamese]). Since the characters of those languages are unified and given the same code point, it is not possible to derive language-specific rules for text composition and display directly from characters. + + With the release of Squeak 3.8 and its m17n support, some of the higher bits in each character were used to denote language information. Each time, platform content was decoded (e.g., via UTF8TextConverter), each character was tagged with the currently known LanguageEnvironment via Unicode class >> value: or Character class >> #leadingChar:code:. That tag is known as "encoding tag" or #leadingChar. + + Now, the #leadingChar offers language information that can be used in text composition and display. For example, the (soft) line-break rules in Japanese are not based on whitespace but other characters. See JapaneseEnvironment class >> #isBreakableAt:in:. Also, the concept of "font sets" (see StrikeFontSet and TTCFontSet) uses the tag to select a specific (limited-range) font during text display. See TTCFontSet >> #widthOf: as an example. + + The leading char 0 denotes a language without language-specific information. For historic reasons, this implies a rule set for text composition and display suitable for Western languages. Also, any text converter that processes Latin-1 (i.e., code point < 256) will not set its own leading character so that ByteString can still be used in such situations. For example, the Japanese leading char 5 and a Latin-1 character $a would otherwise result in "(5 << 22) + 97" and thus produce a WideString instead of a more compact ByteString. + + See also: + Unicode class >> #value: + Character class >> #leadingChar:code: + Character >> #leadingChar + Character >> #charCode + + You can browse all senders of 16r3FFFFF to learn about how performance can be improved when working with characters that have a leading char 0. + + + III. Language Environment + + At any given point in time, Squeak has a single, system-wide (i.e., global) language environment. Such a language environment drives the selection of platform-specific content convertes as well as language-specific rules for text composition and display. Each environment has its own #leadingChar, which can be used to tag characters to then find your way back during character-specific operations such as the ones in CharacterScanner. It can also be used to find the correct glyph in a font set (i.e., StrikeFontSet or TTCFontSet). + + In theory, the language environment could be the place where users are informed about missing fonts to display text in a certain language. There is basic support for that via #isFontAvailable and #installFont. Yet, those paths do not scan the current platform for available fonts but only a remote location in the Internet (i.e., #fontDownloadUrls). + + Note that LanguageEnvironment is part of the "Multilingual" package. Applications should therefore use the Locale interface to only depend on the "System" package. + + See: + Locale >> #leadingChar + String >> #applyLanguageInformation: + Text >> #applyLanguageInformation: + + Also note that "language translation" via a NaturalLanguageTranslator is a mechanism independent of language environments and content encoding. That is, for example, your (platform) locale may be "ja-JP" (Japanese/JAPAN) and your environment be JapaneseEnvironment, but your translation still into English (en-US) or German (de-DE) if you prefer that. + + + IV. Chunk Format, ]lang[ tag, and UTF8 .sources/.changes + + Most source code can be expressed with the printable portion of ASCII, that is, code points from 32 to 126. Non-printable control characters can be accessed via selected class-side methods on Character such as "Character cr" and "Character tab" and even "Character space." Only a few go up to code point 255, and even fewer beyond that. All of this is fine since source code files are encoded in UTF8. + + See + Unicode class >> #browseMethodsWithNonAsciiEncoding + Unicode class >> #browseMethodsWithLeadingCharEncoding + + Now, it may happen that some methods store, for example, literal strings that have their #leadingChar set. This affects string comparison (#=), which cannot ignore the leading char for performance reasons. For example, JapaneseEnvironment class >> #isBreakableAt:in: configures the CompositionScanner only when tagged a WideString is composed. One cannot easily see this but exploring the method's literals will reveal it. + + UTF8 encoding can only handle Unicode code points and will thus discard the Squeak-specific leading char (or language information). For Squeak's chunk (i.e., source code) format, similar to the ]style[ tag for storing stand-off text attributes for a string, the language information is stored in a ]lang[ tag for all different ranges in the source string. Consequently, reading source code that has tagged characters will work. + + BE AWARE THAT the systems current #leadingChar may differ from what is stored in source code (literals). That is, the UTF8TextConverter will apply the system's leading char via Unicode class >> value: but that will then be overwritten when the ]lang[ tag is parsed from the chunk. You will not remove these tags by accident with simple insert/remove edits BUT involving the clipboard will often trigger UTF8 conversion and then reset all leading chars on paste. + + + V. Future Work (as of March 2022) + + The use of #leadingChar entails somewhat high maintenance costs. For its currently known use cases -- namely text composition and font selection -- it is simply not worth the effort and not even necessary. + First, text composition can easily be configured through TextStyle and TextAttribute. While the defaults may reside in the system-wide LanguageEnvironment, TextStyle can be specific to an application (or text field), and TextAttribute (maybe a new TextLanguage) can specify language per range like HTML/CSS does it. A quick check whether a certain code point is affected (e.g., cp > 255 or "is in CJK Unified Ideographs" ...) might help with performance. + Second, font selection needs to be more sophisticated than per language. There are fallback fonts, symbol fonts, language-specific fonts. Any font stack must be modeled on the basis of Unicode code points (and Unicode blocks), not a Squeak-specific encoding tag or leading char. + + There are several decoding-specific helpers in very generic places: + - Character >> #asUnicode + - Character >> #isTraditionalDomestic + - WideString >> #isUnicodeStringWithCJK + - WideString >> #includesUnifiedCharacter + - WideString >> #mutateJISX0208StringToUnicode + - WideSymbol >> #mutateJISX0208StringToUnicode + + I think those should be moved to the few places they are actually needed, which is around TextConverter. + + Note that both StrikeFontSet and TTCFontSet are considered "legacy" at this point. Their use is discouraged even though they have not been deprecated along with #leadingChar yet and should work as usual. + + Also note that if we would add a Utf8String (besides ByteString and WideString) in the future, it would not be possible any more to store user data such as the #leadingChar for the characters in such strings. This extra info can only be hold in WideString.! - I represent a character by storing its associated ASCII code (extended to 256 codes). My instances are created uniquely, so that all instances of a character ($R, for example) are identical.! Item was removed: - ----- Method: Character class>>characterTable (in category 'constants') ----- - characterTable - "Answer the class variable in which unique Characters are stored." - - ^CharacterTable! Item was changed: ----- Method: Character class>>constantNames (in category 'private') ----- constantNames + ^ #( backspace delete return lf enter delete escape null space tab arrowDown arrowUp arrowLeft arrowRight end home pageDown pageUp euro insert )! - ^ #( backspace cr delete escape lf null newPage space tab ).! Item was changed: ----- Method: Character class>>digitValue: (in category 'instance creation') ----- digitValue: x + "Answer the Character whose digit value is x. For example, + answer $9 for x=9, $0 for x=0, $A for x=10, $Z for x=35." - "Answer the Character whose digit value is x. For example, answer $9 for - x=9, $0 for x=0, $A for x=10, $Z for x=35." + | n | + n := x asInteger. + ^self value: (n < 10 ifTrue: [n + 48] ifFalse: [n + 55])! - | index | - index := x asInteger. - ^CharacterTable at: - (index < 10 - ifTrue: [48 + index] - ifFalse: [55 + index]) - + 1! Item was changed: ----- Method: Character class>>euro (in category 'accessing untypeable characters') ----- euro "The Euro currency sign, that E with two dashes. The code point is a official unicode ISO/IEC-10646-1" + ^self value: 16r20AC! - ^ Unicode value: 16r20AC! Item was changed: ----- Method: Character class>>initialize (in category 'class initialization') ----- initialize + "Character initialize" - "Create the table of unique Characters, and DigitsValues." - "Character initializeClassificationTable" + self + initializeClassificationTable; + initializeDigitValues; + initializeCharacterTable + ! - CharacterTable ifNil: [ - "Initialize only once to ensure that byte characters are unique" - CharacterTable := Array new: 256. - 1 to: 256 do: [:i | CharacterTable at: i put: (self basicNew setValue: i - 1)]]. - self initializeDigitValues! Item was added: + ----- Method: Character class>>initializeCharacterTable (in category 'class initialization') ----- + initializeCharacterTable + CharacterTable + ifNil: ["Initialize only once to ensure that byte characters are unique" + CharacterTable := Array new: 256. + 1 + to: 256 + do: [:i | CharacterTable + at: i + put: (self basicNew setValue: i - 1)]]. + ! Item was changed: ----- Method: Character class>>initializeClassificationTable (in category 'class initialization') ----- initializeClassificationTable "Initialize the classification table. The classification table is a compact encoding of upper and lower cases and digits of characters with - bits 0-7: The lower case value of this character or 0, if its greater than 255. - bits 8-15: The upper case value of this character or 0, if its greater than 255. - bit 16: lowercase bit (isLowercase == true) - bit 17: uppercase bit (isUppercase == true) - bit 18: digit bit (isDigit == true)" " self initializeClassificationTable " | encodedCharSet newClassificationTable | "Base the table on the EncodedCharset of these characters' leadingChar - 0." encodedCharSet := EncodedCharSet charsetAt: 0. LowercaseBit := 1 bitShift: 16. UppercaseBit := 1 bitShift: 17. DigitBit := 1 bitShift: 18. "Initialize the letter mask (e.g., isLetter == true)" LetterMask := LowercaseBit bitOr: UppercaseBit. "Initialize the alphanumeric mask (e.g. isAlphaNumeric == true)" AlphaNumericMask := LetterMask bitOr: DigitBit. "Initialize the table based on encodedCharSet." + newClassificationTable := WordArray new: 256. - newClassificationTable := Array new: 256. 0 to: 255 do: [ :code | | isLowercase isUppercase isDigit lowercaseCode uppercaseCode value | isLowercase := encodedCharSet isLowercaseCode: code. isUppercase := encodedCharSet isUppercaseCode: code. isDigit := encodedCharSet isDigitCode: code. lowercaseCode := encodedCharSet toLowercaseCode: code. lowercaseCode > 255 ifTrue: [ lowercaseCode := 0 ]. uppercaseCode := encodedCharSet toUppercaseCode: code. uppercaseCode > 255 ifTrue: [ uppercaseCode := 0 ]. value := (uppercaseCode bitShift: 8) + lowercaseCode. isLowercase ifTrue: [ value := value bitOr: LowercaseBit ]. isUppercase ifTrue: [ value := value bitOr: UppercaseBit ]. isDigit ifTrue: [ value := value bitOr: DigitBit ]. newClassificationTable at: code + 1 put: value ]. ClassificationTable := newClassificationTable! Item was changed: ----- Method: Character class>>initializeDigitValues (in category 'class initialization') ----- initializeDigitValues "Initialize the well known digit value of ascii characters. Note that the DigitValues table is 1-based while ascii values are 0-based, thus the offset +1." + | newDigitValues | + newDigitValues := Array new: 256 withAll: -1. - DigitValues := Array new: 256 withAll: -1. "the digits" + 0 to: 9 do: [:i | newDigitValues at: 48 + i + 1 put: i]. - 0 to: 9 do: [:i | DigitValues at: 48 + i + 1 put: i]. "the uppercase letters" + 10 to: 35 do: [:i | newDigitValues at: 55 + i + 1 put: i]. - 10 to: 35 do: [:i | DigitValues at: 55 + i + 1 put: i]. "the lowercase letters" + 10 to: 35 do: [:i | newDigitValues at: 87 + i + 1 put: i]. + DigitValues := newDigitValues! - 10 to: 35 do: [:i | DigitValues at: 87 + i + 1 put: i].! Item was changed: ----- Method: Character class>>leadingChar:code: (in category 'instance creation') ----- leadingChar: leadChar code: code + code <= 16rFF ifTrue: [ ^ self value: code "ascii or latin-1" ]. + code > 16r1FFFFF ifTrue: [ self error: 'code is out of range' ]. + + leadChar = 0 ifTrue: [ ^ self value: code "no language info" ]. + leadChar > 16rFF ifTrue: [ self error: 'lead is out of range' ]. + + ^ self value: (leadChar bitShift: 22) + code! - code >= 16r400000 ifTrue: [ - self error: 'code is out of range'. - ]. - leadChar >= 256 ifTrue: [ - self error: 'lead is out of range'. - ]. - code < 256 ifTrue: [ ^self value: code ]. - ^self value: (leadChar bitShift: 22) + code.! Item was changed: ----- Method: Character class>>nbsp (in category 'accessing untypeable characters') ----- nbsp + "non-breakable space" - "non-breakable space. Latin1 encoding common usage." + ^self value: 160! - ^ Character value: 160! Item was added: + ----- Method: Character class>>return (in category 'accessing untypeable characters') ----- + return + "Answer the Character representing a carriage return." + + ^self value: 13! Item was changed: ----- Method: Character class>>separators (in category 'instance creation') ----- separators "Answer a collection of the standard ASCII separator characters." + ^ { Character value: 32. "space" + Character value: 13. "cr" + Character value: 9. "tab" + Character value: 10. "line feed" + Character value: 12. "form feed" + Character value: 1. "start of heading" + } as: String! - ^ #(32 "space" - 13 "cr" - 9 "tab" - 10 "line feed" - 12 "form feed") - collect: [:v | Character value: v] as: String! Item was added: + ----- Method: Character class>>startOfHeader (in category 'accessing untypeable characters') ----- + startOfHeader + + ^ self value: 1 ! Item was changed: ----- Method: Character>>< (in category 'comparing') ----- < aCharacter "Answer true if the receiver's value < aCharacter's value." + ^self asInteger < aCharacter asInteger! - ^value < aCharacter asciiValue! Item was changed: ----- Method: Character>><= (in category 'comparing') ----- <= aCharacter "Answer true if the receiver's value <= aCharacter's value." + ^self asInteger <= aCharacter asInteger! - ^value <= aCharacter asciiValue! Item was changed: ----- Method: Character>>> (in category 'comparing') ----- > aCharacter "Answer true if the receiver's value > aCharacter's value." + ^self asInteger > aCharacter asInteger! - ^value > aCharacter asciiValue! Item was changed: ----- Method: Character>>>= (in category 'comparing') ----- >= aCharacter "Answer true if the receiver's value >= aCharacter's value." + ^self asInteger >= aCharacter asInteger! - ^value >= aCharacter asciiValue! Item was added: + ----- Method: Character>>adaptToNumber:andSend: (in category 'converting') ----- + adaptToNumber: rcvr andSend: selector + "If I am involved in arithmetic with a number, convert me to an integer." + + ^ rcvr perform: selector with: self asInteger! Item was changed: ----- Method: Character>>asLowercase (in category 'converting') ----- asLowercase "Answer the receiver's matching lowercase Character." + | integerValue | + (integerValue := self asInteger) > 255 ifFalse: [ - value > 255 ifFalse: [ | result | + (result := (ClassificationTable at: integerValue + 1) bitAnd: 16rFF) > 0 - (result := (ClassificationTable at: value + 1) bitAnd: 16rFF) > 0 ifTrue: [ ^self class value: result ] ]. + ^self class value: (self encodedCharSet toLowercaseCode: integerValue)! - ^self class value: (self encodedCharSet toLowercaseCode: value)! Item was changed: ----- Method: Character>>asSymbol (in category 'converting') ----- asSymbol "Answer a Symbol consisting of the receiver as the only element." + ^Symbol intern: self asString! - ^Symbol internCharacter: self! Item was changed: ----- Method: Character>>asUnicode (in category 'converting') ----- asUnicode + "Answer the unicode encoding of the receiver. Use this method only in a TextConverter or similar. Maybe we should move this out of Character because it is very specific to the point in time where external content is decoded into Unicode code points. See senders. The indirection via #leadingChar and #encodedCharSet is unnecessarily complicated." + + | integerValue | + (integerValue := self asInteger) <= 16r3FFFFF ifTrue: [ ^integerValue ]. + ^self encodedCharSet convertToUnicode: (integerValue bitAnd: 16r3FFFFF) - "Answer the unicode encoding of the receiver" - self leadingChar = 0 ifTrue: [^ value]. - ^self encodedCharSet charsetClass convertToUnicode: self charCode ! Item was changed: ----- Method: Character>>asUppercase (in category 'converting') ----- asUppercase "Answer the receiver's matching uppercase Character." + | integerValue | + (integerValue := self asInteger) > 255 ifFalse: [ - value > 255 ifFalse: [ | result | + (result := ((ClassificationTable at: integerValue + 1) bitShift: -8) bitAnd: 16rFF) > 0 - (result := ((ClassificationTable at: value + 1) bitShift: -8) bitAnd: 16rFF) > 0 ifTrue: [ ^self class value: result ] ]. + ^self class value: (self encodedCharSet toUppercaseCode: integerValue)! - ^self class value: (self encodedCharSet toUppercaseCode: value)! Item was changed: ----- Method: Character>>charCode (in category 'accessing') ----- charCode + "Drop the #leadingChar. See #leadingChar:code:." + ^ self asInteger bitAnd: 16r3FFFFF! - ^ (value bitAnd: 16r3FFFFF). - ! Item was removed: - ----- Method: Character>>clone (in category 'copying') ----- - clone - "Characters from 0 to 255 are unique, copy only the rest." - - value < 256 ifTrue: [ ^self ]. - ^super clone! Item was changed: ----- Method: Character>>codePoint (in category 'accessing') ----- codePoint + "Return the encoding value of the receiver. Until we stop supporting #leadingChar, we must forward to #charCode not #asInteger to get actual Unicode code points." - "Return the encoding value of the receiver." - #Fundmntl. + ^ self charCode! - ^value! Item was removed: - ----- Method: Character>>copy (in category 'copying') ----- - copy - "Characters from 0 to 255 are unique, copy only the rest." - - value < 256 ifTrue: [ ^self ]. - ^super copy! Item was changed: ----- Method: Character>>digitValue (in category 'accessing') ----- digitValue "Answer 0-9 if the receiver is $0-$9, 10-35 if it is $A-$Z, and < 0 otherwise. This is used to parse literal numbers of radix 2-36." + | integerValue | + (integerValue := self asInteger) > 16rFF ifTrue: [^self encodedCharSet digitValueOf: self]. + ^DigitValues at: integerValue + 1! - value > 16rFF ifTrue: [^self encodedCharSet digitValueOf: self]. - ^DigitValues at: 1 + value! Item was changed: ----- Method: Character>>encodedCharSet (in category 'accessing') ----- encodedCharSet + self asInteger <= 16r3FFFFF ifTrue: [ ^Unicode ]. "Shortcut" - value < 16r400000 ifTrue: [ ^Unicode ]. "Shortcut" ^EncodedCharSet charsetAt: self leadingChar ! Item was changed: ----- Method: Character>>isAlphaNumeric (in category 'testing') ----- isAlphaNumeric "Answer whether the receiver is a letter or a digit." + | integerValue | + (integerValue := self asInteger) > 255 ifFalse: [ + ^((ClassificationTable at: integerValue + 1) bitAnd: AlphaNumericMask) > 0 ]. - value > 255 ifFalse: [ ^((ClassificationTable at: value + 1) bitAnd: AlphaNumericMask) > 0 ]. ^self encodedCharSet isAlphaNumeric: self! Item was changed: ----- Method: Character>>isAscii (in category 'testing') ----- isAscii + + ^self asInteger < 128! - ^ value between: 0 and: 127! Item was changed: ----- Method: Character>>isDigit (in category 'testing') ----- isDigit + | integerValue | + (integerValue := self asInteger) > 255 ifFalse: [ + ^((ClassificationTable at: integerValue + 1) bitAnd: DigitBit) > 0 ]. - value > 255 ifFalse: [ ^((ClassificationTable at: value + 1) bitAnd: DigitBit) > 0 ]. ^self encodedCharSet isDigit: self. ! Item was changed: ----- Method: Character>>isLetter (in category 'testing') ----- isLetter + | integerValue | + (integerValue := self asInteger) > 255 ifFalse: [ + ^((ClassificationTable at: integerValue + 1) bitAnd: LetterMask) > 0 ]. - value > 255 ifFalse: [ ^((ClassificationTable at: value + 1) bitAnd: LetterMask) > 0 ]. ^self encodedCharSet isLetter: self! Item was changed: ----- Method: Character>>isLowercase (in category 'testing') ----- isLowercase + | integerValue | + (integerValue := self asInteger) > 255 ifFalse: [ + ^((ClassificationTable at: integerValue + 1) bitAnd: LowercaseBit) > 0 ]. - value > 255 ifFalse: [ ^((ClassificationTable at: value + 1) bitAnd: LowercaseBit) > 0 ]. ^self encodedCharSet isLowercase: self. ! Item was changed: ----- Method: Character>>isSeparator (in category 'testing') ----- isSeparator "Answer whether the receiver is one of the separator characters--space, cr, tab, line feed, or form feed." + | integerValue | + (integerValue := self asInteger) > 32 ifTrue: [ ^false ]. + integerValue + caseOf: { + [ 32 "space" ] -> [ ^true ]. + [ 9 "tab" ] -> [ ^true ]. + [ 13 "cr"] -> [ ^true ]. + [ 10 "line feed" ] -> [ ^true ]. + [ 12 "form feed"] -> [ ^true ]. + [ 1 "start of heading"] -> [ ^true ] } + otherwise: [ ^false ]! - value = 32 ifTrue: [^true]. "space" - value = 13 ifTrue: [^true]. "cr" - value = 9 ifTrue: [^true]. "tab" - value = 10 ifTrue: [^true]. "line feed" - value = 12 ifTrue: [^true]. "form feed" - ^false! Item was changed: ----- Method: Character>>isUppercase (in category 'testing') ----- isUppercase + | integerValue | + (integerValue := self asInteger) > 255 ifFalse: [ + ^((ClassificationTable at: integerValue + 1) bitAnd: UppercaseBit) > 0 ]. - value > 255 ifFalse: [ ^((ClassificationTable at: value + 1) bitAnd: UppercaseBit) > 0 ]. ^self encodedCharSet isUppercase: self. ! Item was changed: ----- Method: Character>>isoToSqueak (in category 'converting') ----- isoToSqueak + + self flag: #deprecated. ^self "no longer needed"! Item was added: + ----- Method: Character>>printAsLiteralOn: (in category 'printing') ----- + printAsLiteralOn: aStream + aStream nextPut: $$; nextPut: self! Item was changed: ----- Method: Character>>printOn: (in category 'printing') ----- printOn: aStream + | integerValue | + ((integerValue := self asInteger) > 32 and: [integerValue ~= 127]) ifTrue: + [^self printAsLiteralOn: aStream]. + (self class constantNameFor: self) + ifNotNil: [ :name | aStream nextPutAll: self class name; space; nextPutAll: name ] + ifNil: [ aStream nextPutAll: self class name; nextPutAll: ' value: '; print: integerValue ]! - | name | - (value > 32 and: [value ~= 127]) - ifTrue: [ aStream nextPut: $$; nextPut: self ] - ifFalse: [ - name := self class constantNameFor: self. - name notNil - ifTrue: [ aStream nextPutAll: self class name; space; nextPutAll: name ] - ifFalse: [ aStream nextPutAll: self class name; nextPutAll: ' value: '; print: value ] ].! Item was changed: ----- Method: Character>>shouldBePrintedAsLiteral (in category 'testing') ----- shouldBePrintedAsLiteral + | integerValue | + (integerValue := self asInteger) < 33 ifTrue: [ ^false ]. + 255 < integerValue ifTrue: [ ^false ]. + ^integerValue ~= 127! - ^(value between: 33 and: 255) and: [value ~= 127]! Item was changed: ----- Method: Character>>squeakToIso (in category 'converting') ----- squeakToIso + + self flag: #deprecated. ^self "no longer needed"! Item was changed: ----- Method: Character>>storeBinaryOn: (in category 'printing') ----- storeBinaryOn: aStream "Store the receiver on a binary (file) stream" + | integerValue | + (integerValue := self asInteger) < 256 - value < 256 ifTrue: [ aStream basicNextPut: self ] + ifFalse: [ aStream nextInt32Put: integerValue ]! - ifFalse: [ aStream nextInt32Put: value ]! Item was changed: ----- Method: Character>>storeDataOn: (in category 'object fileIn') ----- storeDataOn: aDataStream " Store characters in reference-like way, with value like instvar. This is compatible with various Squeak Memory Systems" aDataStream beginInstance: self class + size: 1; + nextPut: self asInteger! - size: 1. - aDataStream nextPut: self asInteger.! Item was changed: ----- Method: Character>>storeOn: (in category 'printing') ----- storeOn: aStream "Common character literals are preceded by '$', however special need to be encoded differently: for some this might be done by using one of the shortcut constructor methods for the rest we have to create them by ascii-value." + self shouldBePrintedAsLiteral ifTrue: + [^self printAsLiteralOn: aStream]. + (self class constantNameFor: self) ifNotNil: [ :name | + aStream nextPutAll: self class name; space; nextPutAll: name. + ^self ]. + aStream + nextPut: $(; nextPutAll: self class name; + nextPutAll: ' value: '; print: self asInteger; nextPut: $)! - | name | - self shouldBePrintedAsLiteral - ifTrue: [ aStream nextPut: $$; nextPut: self ] - ifFalse: [ - name := self class constantNameFor: self. - name notNil - ifTrue: [ aStream nextPutAll: self class name; space; nextPutAll: name ] - ifFalse: [ - aStream - nextPut: $(; nextPutAll: self class name; - nextPutAll: ' value: '; print: value; nextPut: $) ] ].! Item was changed: Collection subclass: #CharacterSet + instanceVariableNames: 'byteArrayMap' + classVariableNames: 'Ascii CrLf NonAscii NonSeparators Separators' - instanceVariableNames: 'map' - classVariableNames: 'CrLf NonSeparators Separators' poolDictionaries: '' category: 'Collections-Support'! + !CharacterSet commentStamp: 'nice 11/17/2019 12:26' prior: 0! + A set of characters. Lookups for inclusion are very fast. + CharacterSet is the abstract class that is visible to the outside world. + Subclasses should be considered as implementation details.! - !CharacterSet commentStamp: '<historical>' prior: 0! - A set of characters. Lookups for inclusion are very fast.! Item was changed: ----- Method: CharacterSet class>>allCharacters (in category 'instance creation') ----- allCharacters "return a set containing all characters" + ^ self empty complement! - | set | - set := self empty. - 0 to: 255 do: [ :ascii | set add: (Character value: ascii) ]. - ^set! Item was added: + ----- Method: CharacterSet class>>ascii (in category 'accessing') ----- + ascii + "return a set containing all the ASCII characters" + + ^Ascii ifNil: [ Ascii := self newFrom: ((1 to: 127) collect: [:code | code asCharacter]) ]! Item was changed: ----- Method: CharacterSet class>>cleanUp: (in category 'initialize-release') ----- cleanUp: aggressive + CrLf := NonSeparators := Separators := Ascii := NonAscii := nil! - CrLf := NonSeparators := Separators := nil! Item was added: + ----- Method: CharacterSet class>>isAbstract (in category 'testing') ----- + isAbstract + ^self = CharacterSet! Item was added: + ----- Method: CharacterSet class>>new (in category 'instance creation') ----- + new + self = CharacterSet ifTrue: [^ByteCharacterSet new]. + ^super new! Item was added: + ----- Method: CharacterSet class>>nonAscii (in category 'accessing') ----- + nonAscii + "return a set containing all the non ASCII characters" + + ^NonAscii ifNil: [ NonAscii := self ascii complement ]! Item was removed: - ----- Method: CharacterSet>>= (in category 'comparison') ----- - = anObject - ^self species == anObject species and: [ - self byteArrayMap = anObject byteArrayMap ]! Item was removed: - ----- Method: CharacterSet>>add: (in category 'collection ops') ----- - add: aCharacter - "I automatically become a WideCharacterSet if you add a wide character to myself" - - aCharacter asciiValue >= 256 - ifTrue: [| wide | - wide := WideCharacterSet new. - wide addAll: self. - wide add: aCharacter. - self becomeForward: wide. - ^aCharacter]. - map at: aCharacter asciiValue + 1 put: 1. - ^aCharacter! Item was added: + ----- Method: CharacterSet>>any: (in category 'accessing') ----- + any: numberOfElements + + ^ self any: numberOfElements as: Array! Item was added: + ----- Method: CharacterSet>>any:as: (in category 'accessing') ----- + any: numberOfElements as: aClass + + self canBeEnumerated + ifTrue: [^ super any: numberOfElements as: aClass] + ifFalse: [self shouldNotImplement]! Item was added: + ----- Method: CharacterSet>>as: (in category 'converting') ----- + as: otherClass + otherClass = CharacterSet ifTrue: [^self]. + ^super as: otherClass! Item was removed: - ----- Method: CharacterSet>>asString (in category 'conversion') ----- - asString - "Convert the receiver into a String" - - ^String new: self size streamContents:[:s| - self do:[:ch| s nextPut: ch]. - ].! Item was changed: + ----- Method: CharacterSet>>byteArrayMap (in category 'accessing') ----- - ----- Method: CharacterSet>>byteArrayMap (in category 'private') ----- byteArrayMap "return a ByteArray mapping each ascii value to a 1 if that ascii value is in the set, and a 0 if it isn't. Intended for use by primitives only" + ^byteArrayMap ifNil: [byteArrayMap := self createByteArrayMap]! - ^map! Item was changed: + ----- Method: CharacterSet>>byteComplement (in category 'converting') ----- - ----- Method: CharacterSet>>byteComplement (in category 'conversion') ----- byteComplement "return a character set containing precisely the single byte characters the receiver does not" + ^ ByteCharacterSet fromMap: (self byteArrayMap collect: [:i | 1 - i])! - | set | - set := CharacterSet allCharacters. - self do: [ :c | set remove: c ]. - ^set! Item was added: + ----- Method: CharacterSet>>canBeEnumerated (in category 'testing') ----- + canBeEnumerated + ^true! Item was changed: + ----- Method: CharacterSet>>complement (in category 'converting') ----- - ----- Method: CharacterSet>>complement (in category 'conversion') ----- complement "return a character set containing precisely the characters the receiver does not" ^CharacterSetComplement of: self copy! Item was added: + ----- Method: CharacterSet>>createByteArrayMap (in category 'private') ----- + createByteArrayMap + ^ (0 to: 255) + collect: [:i | (self includesCode: i) ifTrue: [1] ifFalse: [0]] + as: ByteArray! Item was removed: - ----- Method: CharacterSet>>do: (in category 'collection ops') ----- - do: aBlock - "evaluate aBlock with each character in the set" - - Character allByteCharacters do: [ :c | - (self includes: c) ifTrue: [ aBlock value: c ] ] - ! Item was added: + ----- Method: CharacterSet>>enumerationCost (in category 'private') ----- + enumerationCost + "Answer an integer giving a scale of cost, especially for do: loops." + + ^self subclassResponsibility! Item was changed: + ----- Method: CharacterSet>>findFirstInByteString:startingAt: (in category 'enumerating') ----- - ----- Method: CharacterSet>>findFirstInByteString:startingAt: (in category 'collection ops') ----- findFirstInByteString: aByteString startingAt: startIndex "Double dispatching: since we know this is a ByteString, we can use a superfast primitive using a ByteArray map with 0 slots for byte characters not included and 1 for byte characters included in the receiver." ^ByteString findFirstInString: aByteString inSet: self byteArrayMap startingAt: startIndex! Item was removed: - ----- Method: CharacterSet>>hasWideCharacters (in category 'testing') ----- - hasWideCharacters - ^false! Item was removed: - ----- Method: CharacterSet>>hash (in category 'comparison') ----- - hash - ^self byteArrayMap hash! Item was changed: + ----- Method: CharacterSet>>includes: (in category 'testing') ----- + includes: anObject + anObject isCharacter ifFalse: [ ^false ]. + ^self includesCode: anObject asInteger! - ----- Method: CharacterSet>>includes: (in category 'collection ops') ----- - includes: aCharacter - aCharacter asciiValue >= 256 - ifTrue: ["Guard against wide characters" - ^false]. - ^(map at: aCharacter asciiValue + 1) > 0! Item was added: + ----- Method: CharacterSet>>includesCode: (in category 'testing') ----- + includesCode: anInteger + ^self subclassResponsibility! Item was removed: - ----- Method: CharacterSet>>initialize (in category 'private') ----- - initialize - map := ByteArray new: 256 withAll: 0.! Item was added: + ----- Method: CharacterSet>>intersection: (in category 'enumerating') ----- + intersection: aCollection + (self species = aCollection species and: [aCollection enumerationCost < self enumerationCost]) ifTrue: [^aCollection intersection: self]. + ^ self select: [:each | aCollection includes: each]! Item was added: + ----- Method: CharacterSet>>isCharacters: (in category 'testing') ----- + isCharacters: aCollection + "Answer whether this collection contains characters" + ^self species = aCollection species or: [aCollection isString or: [aCollection allSatisfy: [:e | e isCharacter]]]! Item was added: + ----- Method: CharacterSet>>occurrencesOf: (in category 'enumerating') ----- + occurrencesOf: anObject + "Answer how many of the receiver's elements are equal to anObject. Optimized version." + + (self includes: anObject) ifTrue: [ ^1 ]. + ^0! Item was changed: ----- Method: CharacterSet>>postCopy (in category 'copying') ----- postCopy super postCopy. + byteArrayMap := byteArrayMap copy! - map := map copy! Item was removed: - ----- Method: CharacterSet>>remove: (in category 'collection ops') ----- - remove: aCharacter - aCharacter asciiValue >= 256 - ifFalse: ["Guard against wide characters" - map at: aCharacter asciiValue + 1 put: 0]. - ^aCharacter! Item was removed: - ----- Method: CharacterSet>>remove:ifAbsent: (in category 'collection ops') ----- - remove: aCharacter ifAbsent: aBlock - (self includes: aCharacter) ifFalse: [^aBlock value]. - ^self remove: aCharacter! Item was changed: ----- Method: CharacterSet>>removeAll (in category 'removing') ----- removeAll + self becomeForward: ByteCharacterSet new! - - map atAllPut: 0! Item was removed: - ----- Method: CharacterSet>>size (in category 'collection ops') ----- - size - ^map sum! Item was changed: + ----- Method: CharacterSet>>species (in category 'private') ----- - ----- Method: CharacterSet>>species (in category 'comparison') ----- species ^CharacterSet! Item was added: + ----- Method: CharacterSet>>union: (in category 'enumerating') ----- + union: aCollection + (self isCharacters: aCollection) ifFalse: [^super union: aCollection]. + (self species = aCollection species and: [aCollection enumerationCost > self enumerationCost]) ifTrue: [^aCollection union: self]. + ^self copy addAll: aCollection; yourself! Item was removed: - ----- Method: CharacterSet>>wideCharacterMap (in category 'private') ----- - wideCharacterMap - "used for comparing with WideCharacterSet" - - | wide | - wide := WideCharacterSet new. - wide addAll: self. - ^wide wideCharacterMap! Item was changed: + CharacterSet subclass: #CharacterSetComplement + instanceVariableNames: 'absent' - Collection subclass: #CharacterSetComplement - instanceVariableNames: 'absent byteArrayMapCache' classVariableNames: '' poolDictionaries: '' category: 'Collections-Support'! !CharacterSetComplement commentStamp: 'nice 8/31/2008 14:53' prior: 0! CharacterSetComplement is a space efficient implementation of (CharacterSet complement) taking care of WideCharacter (code > 255) However, it will maintain a byteArrayMap for character <= 255 in a cache keeping instance variables: absent <CharacterSet> contains character that are not in the set (i.e. my complement) byteArrayMapCache <ByteArray | nil> cache this information because it has to be used in tight loops where efficiency matters! Item was changed: + ----- Method: CharacterSetComplement>>add: (in category 'adding') ----- - ----- Method: CharacterSetComplement>>add: (in category 'collection ops') ----- add: aCharacter "a character is present if not absent, so adding a character is removing it from the absent" (absent includes: aCharacter) ifTrue: + [byteArrayMap := nil. - [byteArrayMapCache := nil. absent remove: aCharacter]. ^ aCharacter! Item was removed: - ----- Method: CharacterSetComplement>>byteArrayMap (in category 'private') ----- - byteArrayMap - "return a ByteArray mapping each ascii value to a 1 if that ascii value is in the set, and a 0 if it isn't. Intended for use by primitives only" - - ^byteArrayMapCache ifNil: [byteArrayMapCache := absent byteArrayMap collect: [:i | 1 - i]]! Item was added: + ----- Method: CharacterSetComplement>>canBeEnumerated (in category 'testing') ----- + canBeEnumerated + ^false! Item was changed: ----- Method: CharacterSetComplement>>complement: (in category 'initialize-release') ----- complement: aCharacterSet "initialize with the complement" + byteArrayMap := nil. - byteArrayMapCache := nil. absent := aCharacterSet. ! Item was changed: + ----- Method: CharacterSetComplement>>do: (in category 'enumerating') ----- - ----- Method: CharacterSetComplement>>do: (in category 'collection ops') ----- do: aBlock "evaluate aBlock with each character in the set. don't do it, there are too many..." self shouldNotImplement! Item was added: + ----- Method: CharacterSetComplement>>enumerationCost (in category 'private') ----- + enumerationCost + "The maximum cost. I can't even do: loops, it's too expensive." + + ^100! Item was removed: - ----- Method: CharacterSetComplement>>findFirstInByteString:startingAt: (in category 'collection ops') ----- - findFirstInByteString: aByteString startingAt: startIndex - "Double dispatching: since we know this is a ByteString, we can use a superfast primitive using a ByteArray map with 0 slots for byte characters not included and 1 for byte characters included in the receiver." - ^ByteString - findFirstInString: aByteString - inSet: self byteArrayMap - startingAt: startIndex! Item was removed: - ----- Method: CharacterSetComplement>>includes: (in category 'collection ops') ----- - includes: aCharacter - ^(absent includes: aCharacter) not! Item was added: + ----- Method: CharacterSetComplement>>includesCode: (in category 'testing') ----- + includesCode: anInteger + (absent includesCode: anInteger) ifTrue: [ ^false ]. + ^true! Item was added: + ----- Method: CharacterSetComplement>>intersection: (in category 'enumerating') ----- + intersection: aCollection + aCollection class = self class ifTrue: [^(self complement union: aCollection complement) complement]. + ^(aCollection intersection: self) as: CharacterSet! Item was changed: + ----- Method: CharacterSetComplement>>reject: (in category 'enumerating') ----- - ----- Method: CharacterSetComplement>>reject: (in category 'collection ops') ----- reject: aBlock + ^LazyCharacterSet including: [:c | (absent includes: c) not and: [(aBlock value: c) not]]! - "Implementation note: rejecting present is selecting absent" - - ^(absent select: aBlock) complement! Item was changed: + ----- Method: CharacterSetComplement>>remove: (in category 'removing') ----- - ----- Method: CharacterSetComplement>>remove: (in category 'collection ops') ----- remove: aCharacter "This means aCharacter is now absent from myself. It must be added to my absent." + byteArrayMap := nil. - byteArrayMapCache := nil. ^absent add: aCharacter! Item was changed: + ----- Method: CharacterSetComplement>>remove:ifAbsent: (in category 'removing') ----- - ----- Method: CharacterSetComplement>>remove:ifAbsent: (in category 'collection ops') ----- remove: aCharacter ifAbsent: aBlock (self includes: aCharacter) ifFalse: [^aBlock value]. ^self remove: aCharacter! Item was removed: - ----- Method: CharacterSetComplement>>removeAll (in category 'collection ops') ----- - removeAll - - self becomeForward: CharacterSet new! Item was changed: + ----- Method: CharacterSetComplement>>select: (in category 'enumerating') ----- - ----- Method: CharacterSetComplement>>select: (in category 'collection ops') ----- select: aBlock + ^LazyCharacterSet including: [:c | (absent includes: c) not and: [aBlock value: c]]! - "Implementation note: selecting present is rejecting absent" - - ^(absent reject: aBlock) complement! Item was removed: - ----- Method: CharacterSetComplement>>size (in category 'collection ops') ----- - size - "Is this 2**32-absent size ?" - - ^self shouldNotImplement! Item was added: + ----- Method: CharacterSetComplement>>union: (in category 'enumerating') ----- + union: aCollection + aCollection class = self class ifTrue: [^(self complement intersection: aCollection complement) complement]. + (self isCharacters: aCollection) ifFalse: [^super union: aCollection]. + ^(absent reject: [:e | aCollection includes: e]) complement! 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 added: + ----- Method: Collection class>>isAbstract (in category 'testing') ----- + isAbstract + ^self = Collection! Item was added: + ----- Method: Collection>>any: (in category 'accessing') ----- + any: numberOfElements + + ^ self any: numberOfElements as: self species! Item was added: + ----- Method: Collection>>any:as: (in category 'accessing') ----- + any: numberOfElements as: aClass + "Enumerate this collection and return the specified number of elements. Signals an error if this collection has not enough elements." + + | index result | + index := 0. + result := aClass new: numberOfElements. + + result fillFrom: self with: [:each | + (index := index + 1) > numberOfElements + ifTrue: [^ result] + ifFalse: [each]]. + + index = numberOfElements + ifFalse: [self error: 'Not enough elements in this collection.']. + + ^ result! Item was changed: ----- Method: Collection>>anyOne (in category 'accessing') ----- anyOne "Answer a representative sample of the receiver. This method can be helpful when needing to preinfer the nature of the contents of semi-homogeneous collections." + self do: [:each | ^ each]. + self errorEmptyCollection! - self emptyCheck. - self do: [:each | ^ each]! Item was changed: + ----- Method: Collection>>asCommaString (in category 'printing - obsolete') ----- - ----- Method: Collection>>asCommaString (in category 'printing') ----- asCommaString "Return collection printed as 'a, b, c' " + self flag: #deprecate. + ^ self asArray joinSeparatedBy: ', ' - ^String streamContents: [:s | self asStringOn: s delimiter: ', '] ! Item was changed: + ----- Method: Collection>>asCommaStringAnd (in category 'printing - obsolete') ----- - ----- Method: Collection>>asCommaStringAnd (in category 'printing') ----- asCommaStringAnd "Return collection printed as 'a, b and c' " + self flag: #deprecate. ^String streamContents: [:s | self asStringOn: s delimiter: ', ' last: ' and '] ! Item was changed: + ----- Method: Collection>>asStringOn:delimiter: (in category 'printing - obsolete') ----- - ----- Method: Collection>>asStringOn:delimiter: (in category 'printing') ----- asStringOn: aStream delimiter: delimString - "Print elements on a stream separated - with a delimiter String like: 'a, b, c' - Uses #asString instead of #print:." + self flag: #deprecate. + ^ self asArray joinOn: aStream separatedBy: delimString! - self do: [:elem | aStream nextPutAll: elem asString] - separatedBy: [aStream nextPutAll: delimString]! Item was changed: + ----- Method: Collection>>asStringOn:delimiter:last: (in category 'printing - obsolete') ----- - ----- Method: Collection>>asStringOn:delimiter:last: (in category 'printing') ----- asStringOn: aStream delimiter: delimString last: lastDelimString "Print elements on a stream separated with a delimiter between all the elements and with a special one before the last like: 'a, b and c'. Uses #asString instead of #print: Note: Feel free to improve the code to detect the last element." | n sz | + self flag: #deprecate. + n := 1. sz := self size. self do: [:elem | n := n + 1. aStream nextPutAll: elem asString] separatedBy: [ aStream nextPutAll: (n = sz ifTrue: [lastDelimString] ifFalse: [delimString])]! Item was changed: ----- Method: Collection>>detect: (in category 'enumerating') ----- detect: aBlock "Evaluate aBlock with each of the receiver's elements as the argument. + Answer the first element for which aBlock evaluates to true. If there is + no such element, raise an error." - Answer the first element for which aBlock evaluates to true." + ^ self + detect: aBlock + ifFound: [:element | element] + ifNone: [self errorNotFound: aBlock]! - ^ self detect: aBlock ifNone: [self errorNotFound: aBlock]! Item was added: + ----- Method: Collection>>detect:ifFound: (in category 'enumerating') ----- + detect: aBlock ifFound: foundBlock + "Evaluate aBlock with each of the receiver's elements as the argument. + Answer the first element for which aBlock evaluates to true. If there is + no such element, return nil." + + ^ self + detect: aBlock + ifFound: foundBlock + ifNone: nil! Item was changed: ----- Method: Collection>>detect:ifFound:ifNone: (in category 'enumerating') ----- detect: aBlock ifFound: foundBlock ifNone: exceptionBlock + "Evaluate aBlock with each of the receiver's elements as the argument. + If there is any element for which aBlock evaluates to true, then evaluate + foundBlock with that element and answer the result of that foundBlock. + If aBlock does never evaluate to true, evaluate exceptionBlock, which + may or may not raise an error." + + self do: [:each | (aBlock value: each) ifTrue: [^ foundBlock value: each]]. + ^ exceptionBlock value - "foundBlock takes one argument, the found object." - self - do: [ :element | (aBlock value: element) ifTrue: [ ^foundBlock value: element ] ]. - ^exceptionBlock value ! Item was changed: ----- Method: Collection>>detect:ifNone: (in category 'enumerating') ----- detect: aBlock ifNone: exceptionBlock "Evaluate aBlock with each of the receiver's elements as the argument. + Answer the first element for which aBlock evaluates to true. If there is + no such element, evaluate exceptionBlock." - Answer the first element for which aBlock evaluates to true. If none - evaluate to true, then evaluate the argument, exceptionBlock." + ^ self + detect: aBlock + ifFound: [:element | element] + ifNone: exceptionBlock! - self do: [:each | (aBlock value: each) ifTrue: [^ each]]. - ^ exceptionBlock value! Item was changed: ----- Method: Collection>>detectMax: (in category 'enumerating') ----- detectMax: aBlock "Evaluate aBlock with each of the receiver's elements as the argument. Answer the element for which aBlock evaluates to the highest magnitude. If collection empty, return nil. This method might also be called elect:." | maxElement maxValue | self do: [:each | | val | + maxValue + ifNotNil: [ + (val := aBlock value: each) > maxValue + ifTrue: [ + maxElement := each. + maxValue := val ] ] + ifNil: [ + "first element" - maxValue == nil - ifFalse: [ - (val := aBlock value: each) > maxValue ifTrue: [ - maxElement := each. - maxValue := val]] - ifTrue: ["first element" maxElement := each. + maxValue := aBlock value: each ]. - maxValue := aBlock value: each]. "Note that there is no way to get the first element that works for all kinds of Collections. Must test every one."]. ^ maxElement! Item was changed: ----- Method: Collection>>detectMin: (in category 'enumerating') ----- detectMin: aBlock "Evaluate aBlock with each of the receiver's elements as the argument. Answer the element for which aBlock evaluates to the lowest number. If collection empty, return nil." | minElement minValue | self do: [:each | | val | + minValue + ifNotNil: [ + (val := aBlock value: each) < minValue + ifTrue: [ + minElement := each. + minValue := val ] ] + ifNil: [ + "first element" - minValue == nil - ifFalse: [ - (val := aBlock value: each) < minValue ifTrue: [ - minElement := each. - minValue := val]] - ifTrue: ["first element" minElement := each. + minValue := aBlock value: each ]. - minValue := aBlock value: each]. "Note that there is no way to get the first element that works for all kinds of Collections. Must test every one."]. ^ minElement! Item was changed: + ----- Method: Collection>>difference: (in category 'set logic') ----- - ----- Method: Collection>>difference: (in category 'enumerating') ----- difference: aCollection "Answer the set theoretic difference of two collections." ^ self reject: [:each | aCollection includes: each]! Item was added: + ----- Method: Collection>>errorDifferentSize (in category 'private') ----- + errorDifferentSize + + ^ self error: 'Other collection must be the same size' translated! Item was changed: ----- Method: Collection>>errorEmptyCollection (in category 'private') ----- errorEmptyCollection + ^ self error: 'This collection is empty' translated! - self error: 'this collection is empty'! Item was changed: ----- Method: Collection>>errorNoMatch (in category 'private') ----- errorNoMatch + ^ self error: 'Collection sizes do not match' translated! - self error: 'collection sizes do not match'! Item was added: + ----- Method: Collection>>histogramOf: (in category 'converting') ----- + histogramOf: aBlock + + ^ self collect: aBlock as: Bag! Item was changed: ----- Method: Collection>>ifEmpty: (in category 'testing') ----- ifEmpty: aBlock + "Evaluate aBlock if I'm empty, return myself otherwise." - "Evaluate the block if I'm empty" + self isEmpty ifTrue: [^ aBlock value].! - self isEmpty ifTrue: [ ^aBlock value ]! Item was changed: ----- Method: Collection>>ifEmpty:ifNotEmpty: (in category 'testing') ----- ifEmpty: emptyBlock ifNotEmpty: notEmptyBlock + "Evaluate emptyBlock if I'm empty, notEmptyBlock otherwise. If the notEmptyBlock has an argument, evalualte it with myself as its argument. See also #ifEmpty:ifNotEmptyDo:." - "Evaluate emptyBlock if I'm empty, notEmptyBlock otherwise" - " If the notEmptyBlock has an argument, eval with the receiver as its argument" + self isEmpty ifTrue: [^ emptyBlock value]. + ^ notEmptyBlock cull: self! - self isEmpty ifTrue: [ ^emptyBlock value ]. - ^notEmptyBlock valueWithPossibleArgument: self! Item was changed: ----- Method: Collection>>ifNotEmpty: (in category 'testing') ----- ifNotEmpty: aBlock + "Evaluate aBlock if I'm not empty, return myself otherwise. If aBlock has an argument, evaluate it with myself as its argument. See also #ifNotEmptyDo:." - "Evaluate the given block unless the receiver is empty. + self isEmpty ifFalse: [^ aBlock cull: self].! - If the block has an argument, eval with the receiver as its argument, - but it might be better to use ifNotEmptyDo: to make the code easier to - understand" - - self isEmpty ifFalse: [^ aBlock valueWithPossibleArgument: self]. - ! Item was changed: ----- Method: Collection>>ifNotEmpty:ifEmpty: (in category 'testing') ----- ifNotEmpty: notEmptyBlock ifEmpty: emptyBlock + "Evaluate emptyBlock if I'm empty, notEmptyBlock otherwise. If the notEmptyBlock has an argument, evaluate it with myself as its argument. See also #ifNotEmptyDo:ifEmpty:." - "Evaluate emptyBlock if I'm empty, notEmptyBlock otherwise - If the notEmptyBlock has an argument, eval with the receiver as its argument" + self isEmpty ifFalse: [^notEmptyBlock cull: self]. + ^ emptyBlock value! - self isEmpty ifFalse: [ ^notEmptyBlock valueWithPossibleArgument: self ]. - ^emptyBlock value! Item was changed: ----- Method: Collection>>includesSubstringAnywhere: (in category 'testing') ----- includesSubstringAnywhere: testString "Answer whether the receiver includes, anywhere in its nested structure, a string that has testString as a substring" self do: [:element | (element isString) ifTrue: + [(element includesSubstring: testString) ifTrue: [^ true]]. - [(element includesSubString: testString) ifTrue: [^ true]]. (element isCollection) ifTrue: [(element includesSubstringAnywhere: testString) ifTrue: [^ true]]]. ^ false "#(first (second third) ((allSentMessages ('Elvis' includes:)))) includesSubstringAnywhere: 'lvi'"! Item was changed: + ----- Method: Collection>>intersection: (in category 'set logic') ----- - ----- Method: Collection>>intersection: (in category 'enumerating') ----- intersection: aCollection "Answer the set theoretic intersection of two collections." ^ self select: [:each | aCollection includes: each]! Item was changed: ----- Method: Collection>>isEmpty (in category 'testing') ----- isEmpty + "Answer whether the receiver contains any elements. + This implementation uses the do: block rather than + self size = 0 since size may be implemented in terms + of do:, and hence is slow for all but very small collections." - "Answer whether the receiver contains any elements." + self do: [:element | ^false]. + ^true! - ^self size = 0! Item was added: + ----- Method: Collection>>isOfSameSizeCheck: (in category 'private') ----- + isOfSameSizeCheck: otherCollection + + otherCollection size = self size ifFalse: [self errorDifferentSize]! Item was added: + ----- Method: Collection>>isSignedIntegerArray (in category 'testing') ----- + isSignedIntegerArray + ^false! Item was added: + ----- Method: Collection>>isUnsignedIntegerArray (in category 'testing') ----- + isUnsignedIntegerArray + ^false! Item was added: + ----- Method: Collection>>log2 (in category 'math functions') ----- + log2 + ^ self collect: [:each | each log2]! Item was removed: - ----- Method: Collection>>median (in category 'math functions') ----- - median - ^ self asSortedCollection median! Item was added: + ----- Method: Collection>>name (in category 'printing') ----- + name + + ^ String streamContents: [:stream | + self printNameOn: stream]! Item was changed: + ----- Method: Collection>>occurrencesOf: (in category 'enumerating') ----- - ----- Method: Collection>>occurrencesOf: (in category 'testing') ----- occurrencesOf: anObject "Answer how many of the receiver's elements are equal to anObject." | tally | tally := 0. self do: [:each | anObject = each ifTrue: [tally := tally + 1]]. ^tally! Item was changed: ----- Method: Collection>>printElementsOn: (in category 'printing') ----- printElementsOn: aStream - "The original code used #skip:, but some streams do not support that, - and we don't really need it." aStream nextPut: $(. + + self + printElementsOn: aStream + separatedBy: String space. + + aStream nextPut: $).! - self do: [:element | aStream print: element] separatedBy: [aStream space]. - aStream nextPut: $)! Item was added: + ----- Method: Collection>>printElementsOn:separatedBy: (in category 'printing') ----- + printElementsOn: aStream separatedBy: delimiter + "Do not use #print: on the delemiter to have more control over the output. Strings get quoted, Characters get prefixed, etc." + + self + do: [:element | aStream print: element] + separatedBy: [aStream nextPutAll: delimiter asString].! Item was changed: + ----- Method: Collection>>printOn:delimiter: (in category 'printing - obsolete') ----- - ----- Method: Collection>>printOn:delimiter: (in category 'printing') ----- printOn: aStream delimiter: delimString - "Print elements on a stream separated - with a delimiter String like: 'a, b, c' " + self flag: #deprecated. + self + printElementsOn: aStream + separatedBy: delimString.! - self do: [:elem | aStream print: elem] separatedBy: [aStream print: delimString] - ! Item was changed: + ----- Method: Collection>>printOn:delimiter:last: (in category 'printing - obsolete') ----- - ----- Method: Collection>>printOn:delimiter:last: (in category 'printing') ----- printOn: aStream delimiter: delimString last: lastDelimString "Print elements on a stream separated with a delimiter between all the elements and with a special one before the last like: 'a, b and c' Note: Feel free to improve the code to detect the last element." | n sz | + self flag: #deprecated. n := 1. sz := self size. self do: [:elem | n := n + 1. aStream print: elem] separatedBy: [ n = sz ifTrue: [aStream print: lastDelimString] ifFalse: [aStream print: delimString]]! Item was added: + ----- Method: Collection>>sortedSafely (in category 'sorting') ----- + sortedSafely + "A variation of #sorted that uses #compareSafely: instead of #<= to compare its elements. Thus, collections of arbitrary objects can be sorted, which usually involves an object's #printString. See implementors of #compareSafely:." + + ^ self sorted: [:x :y | x compareSafely: y]! Item was added: + ----- Method: Collection>>symmetricDifference: (in category 'set logic') ----- + symmetricDifference: aCollection + "Answer the set theoretic symmetric difference of two collections." + + ^ (self difference: aCollection) union: (aCollection difference: self) + ! Item was added: + ----- Method: Collection>>take: (in category 'accessing') ----- + take: maxNumberOfElements + "Returns maxNumberOfElements as a new collection (using my #species) or less if the collection is not large enough." + + ^ self any: (maxNumberOfElements min: self size)! Item was added: + ----- Method: Collection>>try: (in category 'enumerating') ----- + try: aBlock + "Evaluate aBlock with each of the receiver's elements as the argument. On error, skip that element and continue." + + ^ self try: aBlock ignore: Error! Item was added: + ----- Method: Collection>>try:ignore: (in category 'enumerating') ----- + try: aBlock ignore: exceptionOrExceptionSet + "Evaluate aBlock with each of the receiver's elements as the argument. On error, skip that element and continue." + + ^ self + try: aBlock + ignore: exceptionOrExceptionSet + ifException: nil! Item was added: + ----- Method: Collection>>try:ignore:ifException: (in category 'enumerating') ----- + try: aBlock ignore: exceptionOrExceptionSet ifException: unaryBlockOrNil + "Evaluate aBlock with each of the receiver's elements as the argument. On error, evaluate a block and/or continue." + + ^ self do: [:ea | + [aBlock value: ea] + on: exceptionOrExceptionSet + do: [:err | unaryBlockOrNil ifNotNil: [unaryBlockOrNil value: err]]]! Item was added: + ----- Method: Collection>>try:ignore:logged: (in category 'enumerating') ----- + try: aBlock ignore: exceptionOrExceptionSet logged: aBoolean + "Evaluate aBlock with each of the receiver's elements as the argument. On error, skip that element and continue." + + ^ self + try: aBlock + ignore: exceptionOrExceptionSet + ifException: (aBoolean ifTrue: [[:err| Transcript showln: err messageText]])! Item was changed: + ----- Method: Collection>>union: (in category 'set logic') ----- - ----- Method: Collection>>union: (in category 'enumerating') ----- union: aCollection "Answer the set theoretic union of two collections." ^ self asSet addAll: aCollection; yourself! Item was changed: + RawBitsArray variableWordSubclass: #ColorArray - ArrayedCollection variableWordSubclass: #ColorArray instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Collections-Arrayed'! + + !ColorArray commentStamp: 'nice 5/2/2020 17:11' prior: 0! + A ColorArray is an array of colors encoded on 32-bits. + + The encoding of colors follows the ARGB scheme. + See https://en.wikipedia.org/wiki/RGBA_color_model + + The color is decomposed into 4 channels of 8 bits (4 bytes) + - the most significant byte A is alpha channel which governs transparency + 0 means a completely transparent (invisible) color + 255 means an opaque color. + - the second most significant byte R encodes the level of red + the lower, the darker and/or least saturated + - the third most significant byte G encodes the level of green + - the least significant byte B encodes the level of blue + + Color white is encoded as 16rFFFFFFFF. + ((ColorArray with: Color white) basicAt: 1) hex. + For historical reasons, notice that Color black is encoded as a very dark blue 16rFF000001 rather than 16rFF000000. + ((ColorArray with: Color black) basicAt: 1) hex. + Other example of pure red, pure green and pure blue showing the bit position of those channels: + ((ColorArray with: Color red) basicAt: 1) hex. + ((ColorArray with: Color green) basicAt: 1) hex. + ((ColorArray with: Color blue) basicAt: 1) hex. + Color transparent is encoded as zero on all channels: + ((ColorArray with: Color transparent) basicAt: 1) hex.! 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 4/6/2019 15:08' prior: 0! + A DefaultSortFunction is a collator using the default three way compare <=> 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 <=> 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>>collate:with: (in category 'evaluating') ----- + collate: anObject with: anotherObject + ^anObject <=> anotherObject! Item was changed: ----- Method: Dictionary class>>newFrom: (in category 'instance creation') ----- newFrom: aDict "Answer an instance of me containing the same associations as aDict. Error if any key appears twice." | newDictionary | newDictionary := self new: aDict size. aDict associationsDo: [:x | (newDictionary includesKey: x key) ifTrue: [self error: 'Duplicate key: ', x key printString] ifFalse: [newDictionary add: x copy]]. ^ newDictionary + " Dictionary newFrom: {1->#a. 2->#b. 3->#c} + {1->#a. 2->#b. 3->#c} as: Dictionary + Dictionary newFrom: {1->#a. 2->#b. 1->#c} + {1->#a. 2->#b. 1->#c} as: Dictionary - " NewDictionary newFrom: {1->#a. 2->#b. 3->#c} - {1->#a. 2->#b. 3->#c} as: NewDictionary - NewDictionary newFrom: {1->#a. 2->#b. 1->#c} - {1->#a. 2->#b. 1->#c} as: NewDictionary "! Item was changed: ----- Method: Dictionary>>= (in category 'comparing') ----- + = anObject - = aDictionary "Two dictionaries are equal if (a) they are the same 'kind' of thing. (b) they have the same set of keys. (c) for each (common) key, they have the same value" + self == anObject ifTrue: [ ^true ]. + self species == anObject species ifFalse: [ ^false ]. + self size = anObject size ifFalse: [ ^false ]. + self associationsDo: [ :association | + (anObject at: association key ifAbsent: [ ^false ]) = association value + ifFalse: [ ^false ] ]. + ^true! - self == aDictionary ifTrue: [ ^ true ]. - aDictionary isDictionary ifFalse: [^false]. - self size = aDictionary size ifFalse: [^false]. - self associationsDo: [:assoc| - (aDictionary at: assoc key ifAbsent: [^false]) = assoc value - ifFalse: [^false]]. - ^true - - ! Item was added: + ----- Method: Dictionary>>associationClass (in category 'accessing') ----- + associationClass + + ^Association! Item was changed: ----- Method: Dictionary>>at:ifPresent: (in category 'accessing') ----- at: key ifPresent: aBlock "Lookup the given key in the receiver. If it is present, answer the value of evaluating the given block with the value associated with the key. Otherwise, answer nil." + ^(array at: (self scanFor: key)) ifNotNil: [:assoc| aBlock value: assoc value]! - | v | - v := self at: key ifAbsent: [^ nil]. - ^ aBlock value: v - ! Item was changed: ----- Method: Dictionary>>at:ifPresent:ifAbsent: (in category 'accessing') ----- at: key ifPresent: oneArgBlock ifAbsent: absentBlock + "Lookup the given key in the receiver. If it is present, answer the + value of evaluating the oneArgBlock with the value associated + with the key, otherwise answer the value of absentBlock." + ^(array at: (self scanFor: key)) + ifNil: [absentBlock value] + ifNotNil: [:association| oneArgBlock value: association value]! - "Lookup the given key in the receiver. If it is present, answer the value of evaluating the oneArgBlock with the value associated with the key, otherwise answer the value of absentBlock." - self at: key ifPresent:[:v| ^oneArgBlock value: v]. - ^absentBlock value! Item was added: + ----- Method: Dictionary>>at:ifPresent:ifAbsentPut: (in category 'accessing') ----- + at: key ifPresent: oneArgBlock ifAbsentPut: absentBlock + "Lookup the given key in the receiver. If it is present, answer the value of + evaluating oneArgBlock with the value associated with the key. Otherwise + add the value of absentBlock under the key, and answer that value." + + | index value | + index := self scanFor: key. + (array at: index) ifNotNil: + [:element| + ^oneArgBlock value: element value]. + value := absentBlock value. + self atNewIndex: index put: (self associationClass key: key value: value). + ^value! Item was changed: ----- Method: Dictionary>>at:put: (in category 'accessing') ----- at: key put: anObject "Set the value at key to be anObject. If key is not found, create a new entry for key and set is value to anObject. Answer anObject." | index | index := self scanFor: key. (array at: index) + ifNil: [ self atNewIndex: index put: (self associationClass key: key value: anObject) ] - ifNil: [ self atNewIndex: index put: (Association key: key value: anObject) ] ifNotNil: [ :association | association value: anObject ]. ^anObject! Item was changed: ----- Method: Dictionary>>errorValueNotFound (in category 'private') ----- errorValueNotFound + ^ self error: 'Value not found' translated! - self error: 'value not found'! Item was removed: - ----- Method: Dictionary>>fasterKeys (in category 'accessing') ----- - fasterKeys - "Contrary to old version of #keys, this method returned an Array rather than a Set. - This was faster because no lookup: was performed. - But now, #keys also return an Array, so don't use #fasterKeys anymore." - - self deprecated: 'use #keys'. - - ^self keys. - ! Item was changed: ----- Method: Dictionary>>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." + aCollection isDictionary + ifFalse: [ + aCollection do: [ :element | + self add: (aBlock value: element) ] ] + ifTrue: [ + aCollection associationsDo: [ :association | + self at: association key put: (aBlock value: association value) ] ]! - aCollection keysAndValuesDo: [ :key :value | - self at: key put: (aBlock value: value) ]! Item was changed: ----- Method: Dictionary>>includesKey: (in category 'testing') ----- includesKey: key "Answer whether the receiver has a key equal to the argument, key." + (array at: (self scanFor: key)) ifNil: [ ^false ] ifNotNil: [ ^true ]! - ^(array at: (self scanFor: key)) notNil! Item was removed: - ----- Method: Dictionary>>keyForIdentity: (in category 'accessing') ----- - keyForIdentity: anObject - "If anObject is one of the values of the receive, return its key, else return nil. Contrast #keyAtValue: in which there is only an equality check, here there is an identity check" - - self deprecated: 'Use #keyAtIdentityValue:ifAbsent:'. - ^self keyAtIdentityValue: anObject ifAbsent: nil! Item was added: + ----- Method: Dictionary>>keysInOrder (in category 'accessing') ----- + keysInOrder + "Answer the keys of the receiver in a particular sequence. This default is alphabetical, but subclasses like OrderedDictionary maintain their own sequence." + ^ self keysSortedSafely! Item was changed: ----- Method: Dictionary>>keysSortedSafely (in category 'accessing') ----- keysSortedSafely + + ^ self keys sortedSafely! - "Answer a sorted Array containing the receiver's keys." - ^ self keys sort: - [ : x : y | x compareSafely: y ]! Item was changed: ----- Method: Dictionary>>printElementsOn: (in category 'printing') ----- printElementsOn: aStream aStream nextPut: $(. self size > 100 ifTrue: [aStream nextPutAll: 'size '. self size printOn: aStream] + ifFalse: [self keysInOrder - ifFalse: [self keysSortedSafely do: [:key | aStream print: key; nextPutAll: '->'; print: (self at: key); space]]. aStream nextPut: $)! Item was changed: ----- Method: Dictionary>>removeKey:ifAbsent: (in category 'removing') ----- removeKey: key ifAbsent: aBlock "Remove key (and its associated value) from the receiver. If key is not in the receiver, answer the result of evaluating aBlock. Otherwise, answer the value externally named by key." | index association | index := self scanFor: key. association := (array at: index) ifNil: [ ^aBlock value ]. + tally := tally - 1. "Update tally first, so that read-only hashed collections raise an error before modifying array." array at: index put: nil. - tally := tally - 1. self fixCollisionsFrom: index. ^association value! Item was added: + ----- Method: Dictionary>>replace: (in category 'enumerating') ----- + replace: aBlock + "Destructively replace the values in this Dictionary by applying aBlock, keeping the same keys. + Implementation note: subclasses not storing the key-value pairs as a list of Associations shall refine this method." + tally = 0 ifTrue: [ ^self]. + 1 to: array size do: [ :index | + (array at: index) ifNotNil: [ :element | + element value: (aBlock value: element value) ] ]! Item was changed: ----- Method: Dictionary>>scanFor: (in category 'private') ----- scanFor: anObject "Scan the key array for the first slot containing either a nil (indicating an empty slot) or an element that matches anObject. Answer the index of that slot or raise an error if no slot is found. This method will be overridden in various subclasses that have different interpretations for matching elements." + | index start size | + index := start := anObject hash \\ (size := array size) + 1. - | index start | - index := start := anObject hash \\ array size + 1. [ | element | ((element := array at: index) == nil or: [ anObject = element key ]) ifTrue: [ ^index ]. + (index := index \\ size + 1) = start ] whileFalse. - (index := index \\ array size + 1) = start ] whileFalse. self errorNoFreeSpace! Item was changed: ----- Method: Dictionary>>unreferencedKeys (in category 'removing') ----- unreferencedKeys "| uk | (Time millisecondsToRun: [uk := TextConstants unreferencedKeys]) -> uk" ^'Scanning for references . . .' displayProgressFrom: 0 to: Smalltalk classNames size * 2 during: [ :bar | | currentClass n associations referencedAssociations | currentClass := nil. n := 0. associations := self associations asIdentitySet. referencedAssociations := IdentitySet new: associations size. self systemNavigation allSelectorsAndMethodsDo: [ :behavior :selector :method | behavior == currentClass ifFalse: [ currentClass := behavior. bar value: (n := n + 1) ]. + method allLiteralsDo: [ :literal | - method literalsDo: [ :literal | (literal isVariableBinding and: [ associations includes: literal ]) ifTrue: [ referencedAssociations add: literal ] ] ]. (associations reject: [ :assoc | referencedAssociations includes: assoc ]) collect: [ :assoc| assoc key ] ]! Item was removed: - ----- Method: Dictionary>>valueAtNewKey:put:atIndex:declareFrom: (in category 'private') ----- - valueAtNewKey: aKey put: anObject atIndex: index declareFrom: aDictionary - "Support for coordinating class variable and global declarations - with variables that have been put in Undeclared so as to - redirect all references to the undeclared variable." - - (aDictionary includesKey: aKey) - ifTrue: - [self atNewIndex: index - put: ((aDictionary associationAt: aKey) value: anObject). - aDictionary removeKey: aKey] - ifFalse: - [self atNewIndex: index put: (Association key: aKey value: anObject)]! Item was added: + ----- Method: Dictionary>>withKeysSorted: (in category 'sorting') ----- + withKeysSorted: aSortBlockOrNil + + | sorted | + sorted := OrderedDictionary new: self size. + (self keys sorted: aSortBlockOrNil) do: [:key | + sorted at: key put: (self at: key)]. + ^ sorted! Item was added: + ----- Method: Dictionary>>withKeysSortedSafely (in category 'sorting') ----- + withKeysSortedSafely + + | sorted | + sorted := OrderedDictionary new: self size. + self keysSortedSafely do: [:key | sorted at: key put: (self at: key)]. + ^ sorted! Item was added: + UnsignedIntegerArray variableDoubleWordSubclass: #DoubleWordArray + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Collections-Arrayed'! + + !DoubleWordArray commentStamp: 'nice 5/10/2020 17:32' prior: 0! + A DoubleWordArrays store 64-bit unsigned Integer values.! Item was added: + ----- Method: DoubleWordArray>>bytesPerElement (in category 'accessing') ----- + bytesPerElement + "Number of bytes in each item. This multiplied by (self size)*8 gives the number of bits stored." + ^ 8! Item was changed: + ----- Method: EndOfStream>>defaultAction (in category 'handling') ----- - ----- Method: EndOfStream>>defaultAction (in category 'exceptionDescription') ----- defaultAction "Answer ReadStream>>next default reply." ^ nil! Item was added: + FloatArray variableWordSubclass: #Float32Array + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Collections-Arrayed'! + + !Float32Array commentStamp: 'nice 5/10/2020 17:32' prior: 0! + A Float32Array store single precision IEEE 754 (32 bits) floating point numbers.! Item was added: + ----- Method: Float32Array class>>fromFloat64Array: (in category 'instance creation') ----- + fromFloat64Array: aFloat64Array + ^(self new: aFloat64Array size) copyFromFloat64Array: aFloat64Array! Item was added: + ----- Method: Float32Array>>= (in category 'comparing') ----- + = aFloatArray + <primitive: 'primitiveEqual' module: 'FloatArrayPlugin'> + ^super = aFloatArray! Item was added: + ----- Method: Float32Array>>asFloat32Array (in category 'converting') ----- + asFloat32Array + ^self! Item was added: + ----- Method: Float32Array>>asFloat64Array (in category 'converting') ----- + asFloat64Array + ^Float64Array fromFloatArray: self! Item was added: + ----- Method: Float32Array>>at: (in category 'accessing') ----- + at: index + <primitive: 'primitiveAt' module: 'FloatArrayPlugin'> + ^Float fromIEEE32Bit: (self basicAt: index)! Item was added: + ----- Method: Float32Array>>at:put: (in category 'accessing') ----- + at: index put: value + <primitive: 'primitiveAtPut' module: 'FloatArrayPlugin'> + value isFloat + ifTrue:[self basicAt: index put: value asIEEE32BitWord] + ifFalse:[self at: index put: value asFloat]. + ^value! Item was added: + ----- Method: Float32Array>>bytesPerElement (in category 'accessing') ----- + bytesPerElement + "Number of bytes in each item. This multiplied by (self size)*8 gives the number of bits stored." + ^ 4! Item was added: + ----- Method: Float32Array>>copyFromFloat64Array: (in category 'initialize-release') ----- + copyFromFloat64Array: aFloat64Array + "Destructively replace the elements of self with those of aFloat64Array" + <primitive: 'primitiveFromFloat64Array' module: 'FloatArrayPlugin'> + self isOfSameSizeCheck: aFloat64Array. + 1 to: self size do:[:i| self at: i put: (aFloat64Array at: i)].! Item was added: + ----- Method: Float32Array>>defaultElement (in category 'accessing') ----- + defaultElement + "Return the default element of the receiver" + ^0.0! Item was added: + ----- Method: Float32Array>>dot: (in category 'arithmetic') ----- + dot: aFloatVector + "Primitive. Return the dot product of the receiver and the argument. + Fail if the argument is not of the same size as the receiver." + + | result | + <primitive: 'primitiveDotProduct' module: 'FloatArrayPlugin'> + self size = aFloatVector size ifFalse:[^self error:'Must be equal size']. + result := 0.0. + 1 to: self size do:[:i| + result := result + ((self at: i) * (aFloatVector at: i)). + ]. + ^result! Item was added: + ----- Method: Float32Array>>hash (in category 'comparing') ----- + hash + | result | + <primitive:'primitiveHashArray' module: 'FloatArrayPlugin'> + result := 0. + 1 to: self size do:[:i| result := result + (self basicAt: i) ]. + ^result bitAnd: 16r1FFFFFFF! Item was added: + ----- Method: Float32Array>>normalize (in category 'arithmetic') ----- + normalize + "Unsafely normalize the receiver in-place (become a unit vector). + Div-by-Zero raised if len 0." + <primitive: 'primitiveNormalize' module: 'FloatArrayPlugin'> + self /= self length.! Item was added: + ----- Method: Float32Array>>primAddArray: (in category 'primitives-plugin') ----- + primAddArray: floatArray + + <primitive: 'primitiveAddFloatArray' module: 'FloatArrayPlugin'> + self isOfSameSizeCheck: floatArray. + 1 to: self size do:[:i| self at: i put: (self at: i) + (floatArray at: i)].! Item was added: + ----- Method: Float32Array>>primAddScalar: (in category 'primitives-plugin') ----- + primAddScalar: scalarValue + + <primitive: 'primitiveAddScalar' module: 'FloatArrayPlugin'> + 1 to: self size do:[:i| self at: i put: (self at: i) + scalarValue].! Item was added: + ----- Method: Float32Array>>primDivArray: (in category 'primitives-plugin') ----- + primDivArray: floatArray + + <primitive: 'primitiveDivFloatArray' module: 'FloatArrayPlugin'> + self isOfSameSizeCheck: floatArray. + 1 to: self size do:[:i| self at: i put: (self at: i) / (floatArray at: i)].! Item was added: + ----- Method: Float32Array>>primDivScalar: (in category 'primitives-plugin') ----- + primDivScalar: scalarValue + + <primitive: 'primitiveDivScalar' module: 'FloatArrayPlugin'> + 1 to: self size do:[:i| self at: i put: (self at: i) / scalarValue].! Item was added: + ----- Method: Float32Array>>primMulArray: (in category 'primitives-plugin') ----- + primMulArray: floatArray + + <primitive: 'primitiveMulFloatArray' module: 'FloatArrayPlugin'> + self isOfSameSizeCheck: floatArray. + 1 to: self size do:[:i| self at: i put: (self at: i) * (floatArray at: i)].! Item was added: + ----- Method: Float32Array>>primMulScalar: (in category 'primitives-plugin') ----- + primMulScalar: scalarValue + + <primitive: 'primitiveMulScalar' module: 'FloatArrayPlugin'> + 1 to: self size do:[:i| self at: i put: (self at: i) * scalarValue].! Item was added: + ----- Method: Float32Array>>primSubArray: (in category 'primitives-plugin') ----- + primSubArray: floatArray + + <primitive: 'primitiveSubFloatArray' module: 'FloatArrayPlugin'> + self isOfSameSizeCheck: floatArray. + 1 to: self size do:[:i| self at: i put: (self at: i) - (floatArray at: i)].! Item was added: + ----- Method: Float32Array>>primSubScalar: (in category 'primitives-plugin') ----- + primSubScalar: scalarValue + + <primitive: 'primitiveSubScalar' module: 'FloatArrayPlugin'> + 1 to: self size do:[:i| self at: i put: (self at: i) - scalarValue].! Item was added: + ----- Method: Float32Array>>sum (in category 'primitives-plugin') ----- + sum + + <primitive: 'primitiveSum' module: 'FloatArrayPlugin'> + ^ super sum! Item was added: + FloatArray variableDoubleWordSubclass: #Float64Array + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Collections-Arrayed'! + + !Float64Array commentStamp: 'nice 5/10/2020 17:33' prior: 0! + A Float64Array store double precision IEEE 754 (64 bits) floating point numbers.! Item was added: + ----- Method: Float64Array class>>fromFloatArray: (in category 'instance creation') ----- + fromFloatArray: aFloatArray + ^(self new: aFloatArray size) copyFromFloatArray: aFloatArray! Item was added: + ----- Method: Float64Array>>= (in category 'comparing') ----- + = aFloat64Array + <primitive: 'primitiveEqual' module: 'Float64ArrayPlugin'> + ^super = aFloat64Array! Item was added: + ----- Method: Float64Array>>asFloat32Array (in category 'converting') ----- + asFloat32Array + ^Float32Array fromFloat64Array: self! Item was added: + ----- Method: Float64Array>>asFloat64Array (in category 'converting') ----- + asFloat64Array + ^self! Item was added: + ----- Method: Float64Array>>at: (in category 'accessing') ----- + at: index + <primitive: 'primitiveAt' module: 'Float64ArrayPlugin'> + | f64 u64 | + u64 := self basicAt: index. + (f64 := Float basicNew) + basicAt: 1 put: (u64 >> 32); + basicAt: 2 put: (u64 bitAnd: 16rFFFFFFFF). + ^f64 * 1.0! Item was added: + ----- Method: Float64Array>>at:put: (in category 'accessing') ----- + at: index put: value + <primitive: 'primitiveAtPut' module: 'Float64ArrayPlugin'> + value isFloat + ifTrue:[self basicAt: index put: (value basicAt: 1) << 32 + (value basicAt: 2)] + ifFalse:[self at: index put: value asFloat]. + ^value! Item was added: + ----- Method: Float64Array>>bytesPerElement (in category 'accessing') ----- + bytesPerElement + "Number of bytes in each item. This multiplied by (self size)*8 gives the number of bits stored." + ^ 8! Item was added: + ----- Method: Float64Array>>copyFromFloatArray: (in category 'initialize-release') ----- + copyFromFloatArray: aFloatArray + "Destructively replace the elements of self with those of aFloatArray" + <primitive: 'primitiveFromFloatArray' module: 'Float64ArrayPlugin'> + self isOfSameSizeCheck: aFloatArray. + 1 to: self size do:[:i| self at: i put: (aFloatArray at: i)].! Item was added: + ----- Method: Float64Array>>dot: (in category 'arithmetic') ----- + dot: aFloatVector + "Primitive. Return the dot product of the receiver and the argument. + Fail if the argument is not of the same size as the receiver." + + | result | + <primitive: 'primitiveDotProduct' module: 'Float64ArrayPlugin'> + self size = aFloatVector size ifFalse:[^self error:'Must be equal size']. + result := 0.0. + 1 to: self size do:[:i| + result := result + ((self at: i) * (aFloatVector at: i)). + ]. + ^result! Item was added: + ----- Method: Float64Array>>hash (in category 'comparing') ----- + hash + | result | + <primitive:'primitiveHashArray' module: 'Float64ArrayPlugin'> + result := 0. + 1 to: self size do:[:i| result := result + (self basicAt: i) ]. + ^result bitAnd: 16r1FFFFFFF! Item was added: + ----- Method: Float64Array>>normalize (in category 'arithmetic') ----- + normalize + "Unsafely normalize the receiver in-place (become a unit vector). + Div-by-Zero raised if len 0." + <primitive: 'primitiveNormalize' module: 'Float64ArrayPlugin'> + self /= self length.! Item was added: + ----- Method: Float64Array>>primAddArray: (in category 'primitives-plugin') ----- + primAddArray: floatArray + + <primitive: 'primitiveAddFloat64Array' module: 'Float64ArrayPlugin'> + self isOfSameSizeCheck: floatArray. + 1 to: self size do:[:i| self at: i put: (self at: i) + (floatArray at: i)].! Item was added: + ----- Method: Float64Array>>primAddScalar: (in category 'primitives-plugin') ----- + primAddScalar: scalarValue + + <primitive: 'primitiveAddScalar' module: 'Float64ArrayPlugin'> + 1 to: self size do:[:i| self at: i put: (self at: i) + scalarValue].! Item was added: + ----- Method: Float64Array>>primDivArray: (in category 'primitives-plugin') ----- + primDivArray: floatArray + + <primitive: 'primitiveDivFloat64Array' module: 'Float64ArrayPlugin'> + self isOfSameSizeCheck: floatArray. + 1 to: self size do:[:i| self at: i put: (self at: i) / (floatArray at: i)].! Item was added: + ----- Method: Float64Array>>primDivScalar: (in category 'primitives-plugin') ----- + primDivScalar: scalarValue + + <primitive: 'primitiveDivScalar' module: 'Float64ArrayPlugin'> + 1 to: self size do:[:i| self at: i put: (self at: i) / scalarValue].! Item was added: + ----- Method: Float64Array>>primMulArray: (in category 'primitives-plugin') ----- + primMulArray: floatArray + + <primitive: 'primitiveMulFloat64Array' module: 'Float64ArrayPlugin'> + self isOfSameSizeCheck: floatArray. + 1 to: self size do:[:i| self at: i put: (self at: i) * (floatArray at: i)].! Item was added: + ----- Method: Float64Array>>primMulScalar: (in category 'primitives-plugin') ----- + primMulScalar: scalarValue + + <primitive: 'primitiveMulScalar' module: 'Float64ArrayPlugin'> + 1 to: self size do:[:i| self at: i put: (self at: i) * scalarValue].! Item was added: + ----- Method: Float64Array>>primSubArray: (in category 'primitives-plugin') ----- + primSubArray: floatArray + + <primitive: 'primitiveSubFloat64Array' module: 'Float64ArrayPlugin'> + self isOfSameSizeCheck: floatArray. + 1 to: self size do:[:i| self at: i put: (self at: i) - (floatArray at: i)].! Item was added: + ----- Method: Float64Array>>primSubScalar: (in category 'primitives-plugin') ----- + primSubScalar: scalarValue + + <primitive: 'primitiveSubScalar' module: 'Float64ArrayPlugin'> + 1 to: self size do:[:i| self at: i put: (self at: i) - scalarValue].! Item was added: + ----- Method: Float64Array>>sum (in category 'primitives-plugin') ----- + sum + + <primitive: 'primitiveSum' module: 'Float64ArrayPlugin'> + ^ super sum! Item was changed: + RawBitsArray subclass: #FloatArray - ArrayedCollection variableWordSubclass: #FloatArray instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Collections-Arrayed'! + !FloatArray commentStamp: 'nice 5/10/2020 16:57' prior: 0! + FloatArray is an abstract class for representing arrays of floating point values of some given precision. + Subclasses notably provide support for IEEE 754 single precision (32bits) and double precision (64) floats. + ! - !FloatArray commentStamp: '<historical>' prior: 0! - FloatArrays store 32bit IEEE floating point numbers.! Item was added: + ----- Method: FloatArray class>>basicNew: (in category 'instance creation') ----- + basicNew: anInteger + "For backward compatibility, create a 32bits FloatArray" + + self == FloatArray + ifTrue: [^Float32Array basicNew: anInteger]. + ^super basicNew: anInteger! Item was changed: ----- Method: FloatArray>>* (in category 'arithmetic') ----- * anObject + + ^self shallowCopy *= anObject! - ^self clone *= anObject! Item was changed: ----- Method: FloatArray>>*= (in category 'arithmetic') ----- *= anObject ^anObject isNumber ifTrue:[self primMulScalar: anObject asFloat] ifFalse:[self primMulArray: anObject]! Item was changed: ----- Method: FloatArray>>+ (in category 'arithmetic') ----- + anObject + + ^self shallowCopy += anObject! - ^self clone += anObject! Item was changed: ----- Method: FloatArray>>+= (in category 'arithmetic') ----- += anObject ^anObject isNumber ifTrue:[self primAddScalar: anObject asFloat] ifFalse:[self primAddArray: anObject]! Item was changed: ----- Method: FloatArray>>- (in category 'arithmetic') ----- - anObject + + ^self shallowCopy -= anObject! - ^self clone -= anObject! Item was changed: ----- Method: FloatArray>>-= (in category 'arithmetic') ----- -= anObject ^anObject isNumber ifTrue:[self primSubScalar: anObject asFloat] ifFalse:[self primSubArray: anObject]! Item was changed: ----- Method: FloatArray>>/ (in category 'arithmetic') ----- / anObject + + ^self shallowCopy /= anObject! - ^self clone /= anObject! Item was changed: ----- Method: FloatArray>>/= (in category 'arithmetic') ----- /= anObject ^anObject isNumber ifTrue:[self primDivScalar: anObject asFloat] ifFalse:[self primDivArray: anObject]! Item was removed: - ----- Method: FloatArray>>= (in category 'comparing') ----- - = aFloatArray - | length | - <primitive: 'primitiveEqual' module: 'FloatArrayPlugin'> - aFloatArray class = self class ifFalse: [^ false]. - length := self size. - length = aFloatArray size ifFalse: [^ false]. - 1 to: self size do: [:i | (self at: i) - = (aFloatArray at: i) ifFalse: [^ false]]. - ^ true! Item was changed: ----- Method: FloatArray>>\\= (in category 'arithmetic') ----- \\= other other isNumber ifTrue: [ 1 to: self size do: [:i | self at: i put: (self at: i) \\ other ]. ^ self. ]. 1 to: (self size min: other size) do: [:i | self at: i put: (self at: i) \\ (other at: i). ]. ! Item was changed: ----- Method: FloatArray>>adaptToNumber:andSend: (in category 'arithmetic') ----- adaptToNumber: rcvr andSend: selector "If I am involved in arithmetic with a Number. If possible, convert it to a float and perform the (more efficient) primitive operation." selector == #+ ifTrue:[^self + rcvr]. selector == #* ifTrue:[^self * rcvr]. selector == #- ifTrue:[^self negated += rcvr]. selector == #/ ifTrue:[ "DO NOT USE TRIVIAL CODE ^self reciprocal * rcvr BECAUSE OF GRADUAL UNDERFLOW self should: (1.0e-39 / (FloatArray with: 1.0e-39)) first < 2." ^(self class new: self size withAll: rcvr) / self ]. ^super adaptToNumber: rcvr andSend: selector! Item was changed: ----- Method: FloatArray>>asFloatArray (in category 'converting') ----- asFloatArray ^self! Item was removed: - ----- Method: FloatArray>>at: (in category 'accessing') ----- - at: index - <primitive: 'primitiveAt' module: 'FloatArrayPlugin'> - ^Float fromIEEE32Bit: (self basicAt: index)! Item was removed: - ----- Method: FloatArray>>at:put: (in category 'accessing') ----- - at: index put: value - <primitive: 'primitiveAtPut' module: 'FloatArrayPlugin'> - value isFloat - ifTrue:[self basicAt: index put: value asIEEE32BitWord] - ifFalse:[self at: index put: value asFloat]. - ^value! Item was changed: ----- Method: FloatArray>>defaultElement (in category 'accessing') ----- defaultElement "Return the default element of the receiver" ^0.0! Item was removed: - ----- Method: FloatArray>>dot: (in category 'arithmetic') ----- - dot: aFloatVector - "Primitive. Return the dot product of the receiver and the argument. - Fail if the argument is not of the same size as the receiver." - - | result | - <primitive: 'primitiveDotProduct' module: 'FloatArrayPlugin'> - self size = aFloatVector size ifFalse:[^self error:'Must be equal size']. - result := 0.0. - 1 to: self size do:[:i| - result := result + ((self at: i) * (aFloatVector at: i)). - ]. - ^result! Item was removed: - ----- Method: FloatArray>>hash (in category 'comparing') ----- - hash - | result | - <primitive:'primitiveHashArray' module: 'FloatArrayPlugin'> - result := 0. - 1 to: self size do:[:i| result := result + (self basicAt: i) ]. - ^result bitAnd: 16r1FFFFFFF! Item was changed: ----- Method: FloatArray>>length (in category 'accessing') ----- length "Return the length of the receiver" ^self squaredLength sqrt! Item was changed: ----- Method: FloatArray>>negated (in category 'arithmetic') ----- negated + + ^self shallowCopy *= -1! - ^self clone *= -1! Item was removed: - ----- Method: FloatArray>>normalize (in category 'arithmetic') ----- - normalize - "Unsafely normalize the receiver in-place (become a unit vector). - Div-by-Zero raised if len 0." - <primitive: 'primitiveNormalize' module: 'FloatArrayPlugin'> - self /= self length.! Item was removed: - ----- Method: FloatArray>>primAddArray: (in category 'primitives-plugin') ----- - primAddArray: floatArray - - <primitive: 'primitiveAddFloatArray' module: 'FloatArrayPlugin'> - 1 to: self size do:[:i| self at: i put: (self at: i) + (floatArray at: i)].! Item was removed: - ----- Method: FloatArray>>primAddScalar: (in category 'primitives-plugin') ----- - primAddScalar: scalarValue - - <primitive: 'primitiveAddScalar' module: 'FloatArrayPlugin'> - 1 to: self size do:[:i| self at: i put: (self at: i) + scalarValue].! Item was removed: - ----- Method: FloatArray>>primDivArray: (in category 'primitives-plugin') ----- - primDivArray: floatArray - - <primitive: 'primitiveDivFloatArray' module: 'FloatArrayPlugin'> - 1 to: self size do:[:i| self at: i put: (self at: i) / (floatArray at: i)].! Item was removed: - ----- Method: FloatArray>>primDivScalar: (in category 'primitives-plugin') ----- - primDivScalar: scalarValue - - <primitive: 'primitiveDivScalar' module: 'FloatArrayPlugin'> - 1 to: self size do:[:i| self at: i put: (self at: i) / scalarValue].! Item was removed: - ----- Method: FloatArray>>primMulArray: (in category 'primitives-plugin') ----- - primMulArray: floatArray - - <primitive: 'primitiveMulFloatArray' module: 'FloatArrayPlugin'> - 1 to: self size do:[:i| self at: i put: (self at: i) * (floatArray at: i)].! Item was removed: - ----- Method: FloatArray>>primMulScalar: (in category 'primitives-plugin') ----- - primMulScalar: scalarValue - - <primitive: 'primitiveMulScalar' module: 'FloatArrayPlugin'> - 1 to: self size do:[:i| self at: i put: (self at: i) * scalarValue].! Item was removed: - ----- Method: FloatArray>>primSubArray: (in category 'primitives-plugin') ----- - primSubArray: floatArray - - <primitive: 'primitiveSubFloatArray' module: 'FloatArrayPlugin'> - 1 to: self size do:[:i| self at: i put: (self at: i) - (floatArray at: i)].! Item was removed: - ----- Method: FloatArray>>primSubScalar: (in category 'primitives-plugin') ----- - primSubScalar: scalarValue - - <primitive: 'primitiveSubScalar' module: 'FloatArrayPlugin'> - 1 to: self size do:[:i| self at: i put: (self at: i) - scalarValue].! Item was changed: ----- Method: FloatArray>>replaceFrom:to:with:startingAt: (in category 'private') ----- replaceFrom: start to: stop with: replacement startingAt: repStart "Primitive. This destructively replaces elements from start to stop in the receiver starting at index, repStart, in the collection, replacement. Answer the receiver. Range checks are performed in the primitive only. Optional. See Object documentation whatIsAPrimitive." <primitive: 105> super replaceFrom: start to: stop with: replacement startingAt: repStart! Item was changed: ----- Method: FloatArray>>squaredLength (in category 'accessing') ----- squaredLength "Return the squared length of the receiver" ^self dot: self! Item was removed: - ----- Method: FloatArray>>sum (in category 'primitives-plugin') ----- - sum - - <primitive: 'primitiveSum' module: 'FloatArrayPlugin'> - ^ super sum! Item was changed: + NonPointersOrderedCollection subclass: #FloatCollection - OrderedCollection subclass: #FloatCollection instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Collections-Sequenceable'! !FloatCollection commentStamp: 'cmm 1/28/2013 19:49' prior: 0! FloatCollctions store 32bit IEEE floating point numbers.! Item was removed: - ----- Method: FloatCollection class>>arrayType (in category 'overriding') ----- - arrayType - ^ FloatArray! Item was removed: - ----- Method: FloatCollection>>addLast: (in category 'adding') ----- - addLast: aFloat - aFloat isNumber ifFalse: [ self error: 'This collection can only store Floats.' ]. - ^ super addLast: aFloat! Item was added: + ----- Method: FloatCollection>>arrayType (in category 'private') ----- + arrayType + ^ Float32Array! Item was added: + ----- Method: FloatCollection>>asFloat32Array (in category 'converting') ----- + asFloat32Array + "Optimized version" + + ^array copyFrom: firstIndex to: lastIndex! Item was removed: - ----- Method: FloatCollection>>asFloatArray (in category 'adding') ----- - asFloatArray - "Optimized version" - - ^array copyFrom: firstIndex to: lastIndex! Item was changed: Stream subclass: #Generator instanceVariableNames: 'block next continue home' classVariableNames: '' poolDictionaries: '' category: 'Collections-Streams'! + !Generator commentStamp: 'eem 3/30/2017 17:31' prior: 0! - !Generator commentStamp: 'ar 2/10/2010 20:51' prior: 0! A Generator transforms callback interfaces into stream interfaces. When a producer algorithm provide results as callbacks (blocks) and a consumer algorithm expects streamable input, a Generator transforms one into the other, for example: | generator | generator := Generator on: [:g| Integer primesUpTo: 100 do:[:prime| g yield: prime]]. [generator atEnd] whileFalse:[Transcript show: generator next]. Instance Variables + block: <BlockClosure> The block associated with the generator. + continue: <Context> The continuation to return to. + home: <Context> The home (root) context of the activated block + next: <Object> The next object to return from the Generator.! - block: <BlockClosure> The block associated with the generator. - continue: <MethodContext> The continuation to return to. - home: <MethodContext> The home (root) context of the activated block - next: <Object> The next object to return from the Generator. - ! Item was changed: + ----- Method: Generator class>>on: (in category 'instance creation') ----- - ----- Method: Generator class>>on: (in category 'instance-creation') ----- on: aBlock ^ self basicNew initializeOn: aBlock! Item was changed: Collection subclass: #HashedCollection instanceVariableNames: 'tally array' + classVariableNames: 'GoodPrimes' - classVariableNames: '' poolDictionaries: '' category: 'Collections-Abstract'! !HashedCollection commentStamp: 'ul 4/12/2010 22:37' prior: 0! I am an abstract collection of objects that implement hash and equality in a consitent way. This means that whenever two objects are equal, their hashes have to be equal too. If two objects are equal then I can only store one of them. Hashes are expected to be integers (preferably SmallIntegers). I also expect that the objects contained by me do not change their hashes. If that happens, hash invariants have to be re-established, which can be done by #rehash. Since I'm abstract, no instances of me should exist. My subclasses should implement #scanFor:, #fixCollisionsFrom: and #noCheckNoGrowFillFrom:. Instance Variables array: <ArrayedCollection> (typically Array or WeakArray) tally: <Integer> (non-negative) array - An array whose size is a prime number, it's non-nil elements are the elements of the collection, and whose nil elements are empty slots. There is always at least one nil. In fact I try to keep my "load" at 75% or less so that hashing will work well. tally - The number of elements in the collection. The array size is always greater than this. Implementation details: I implement a hash table which uses open addressing with linear probing as the method of collision resolution. Searching for an element or a free slot for an element is done by #scanFor: which should return the index of the slot in array corresponding to it's argument. When an element is removed #fixCollisionsFrom: should rehash all elements in array between the original index of the removed element, wrapping around after the last slot until reaching an empty slot. My maximum load factor (75%) is hardcoded in #atNewIndex:put:, so it can only be changed by overriding that method. When my load factor reaches this limit I replace my array with a larger one (see #grow) ensuring that my load factor will be less than or equal to 50%. The new array is filled by #noCheckNoGrowFillFrom: which should use #scanForEmptySlotFor: instead of #scanFor: for better performance. I do not shrink. ! Item was removed: - ----- Method: HashedCollection class>>arrayType (in category 'private') ----- - arrayType - ^ Array! Item was changed: ----- Method: HashedCollection class>>compactAll (in category 'initialize-release') ----- compactAll "HashedCollection compactAll" + self allSubclassesDo: [ :each | each compactAllInstances ]! - self allSubclassesDo: #compactAllInstances! Item was changed: ----- Method: HashedCollection class>>compactAllInstances (in category 'initialize-release') ----- compactAllInstances + "Do not use #allInstancesDo: because #compact may create new instances. Ignore immutable instances." - "Do not use #allInstancesDo: because #compact may create new instances." + self allInstances do: [ :each | + each isReadOnlyObject ifFalse: [ each compact ] ]! - self allInstances do: [ :each | each compact ]! Item was changed: ----- Method: HashedCollection class>>goodPrimeAtLeast: (in category 'sizing') ----- goodPrimeAtLeast: lowerLimit + "Answer the smallest good prime >= lowerlimit. + If lowerLimit is larger than the largest known good prime, just make it odd. + Use linear search, and exponential search to speed up cases when lowerLimit is small (<2500 and <100000, respectively). + Assume that there are goodPrimes greater than 100000." - "Answer the next good prime >= lowerlimit. - If lowerLimit is larger than the largest known good prime, - just make it odd." + | highIndex midIndex lowIndex prime | + lowerLimit < 2500 ifTrue: [ + "Use linear search when the limit is small. The boundary is based on measurements." + highIndex := 1. + [ (GoodPrimes at: highIndex) < lowerLimit ] whileTrue: [ + highIndex := highIndex + 1 ]. + ^GoodPrimes at: highIndex ]. + lowerLimit < 100000 + ifTrue: [ + "Use exponential search when the limit is not too large. The boundary is based on measurements." + highIndex := 1. + [ (GoodPrimes at: highIndex) < lowerLimit ] whileTrue: [ + highIndex := highIndex * 2 ]. + lowIndex := highIndex // 2 + 1. "highIndex // 2 was smaller than lowerLimit" ] + ifFalse: [ + "Regular binary search." + lowIndex := 1. + highIndex := GoodPrimes size. + "Check whether the largest prime would fit" + (GoodPrimes at: highIndex) < lowerLimit ifTrue: [ + ^lowerLimit bitOr: 1 ]. ]. + [ highIndex - lowIndex <= 1 ] whileFalse: [ + midIndex := highIndex + lowIndex // 2. + prime := GoodPrimes at: midIndex. + lowerLimit < prime + ifTrue: [ highIndex := midIndex ] + ifFalse: [ + lowerLimit > prime + ifTrue: [ lowIndex := midIndex ] + ifFalse: [ ^prime ] ] ]. + (GoodPrimes at: lowIndex) >= lowerLimit ifTrue: [ ^GoodPrimes at: lowIndex ]. + ^GoodPrimes at: highIndex! - | primes low mid high prime | - primes := self goodPrimes. - low := 1. - high := primes size. - lowerLimit > (primes at: high) ifTrue: [ - ^lowerLimit bitOr: 1 ]. - [ high - low <= 1 ] whileFalse: [ - mid := high + low // 2. - prime := primes at: mid. - prime = lowerLimit ifTrue: [ ^prime ]. - prime < lowerLimit - ifTrue: [ low := mid ] - ifFalse: [ high := mid ] ]. - (primes at: low) >= lowerLimit ifTrue: [ ^primes at: low ]. - ^primes at: high! Item was changed: ----- Method: HashedCollection class>>goodPrimes (in category 'sizing') ----- goodPrimes + "Answer a sorted array of prime numbers less than one billion that make good hash table sizes. See #initializeGoodPrimes." - "Answer a sorted array of prime numbers less than one billion that make good - hash table sizes. Should be expanded as needed. See comments below code" + ^GoodPrimes ifNil: [ + self initializeGoodPrimes. + GoodPrimes ]! - ^#( - 5 11 17 23 31 43 59 79 107 149 199 269 359 479 641 857 1151 1549 2069 - 2237 2423 2617 2797 2999 3167 3359 3539 3727 3911 - 4441 4787 5119 5471 5801 6143 6521 6827 7177 7517 7853 - 8783 9601 10243 10867 11549 12239 12919 13679 14293 15013 15731 - 17569 19051 20443 21767 23159 24611 25847 27397 28571 30047 31397 - 35771 38201 40841 43973 46633 48989 51631 54371 57349 60139 62969 - 70589 76091 80347 85843 90697 95791 101051 106261 111143 115777 120691 126311 - 140863 150523 160969 170557 181243 190717 201653 211891 221251 232591 242873 251443 - 282089 300869 321949 341227 362353 383681 401411 422927 443231 464951 482033 504011 - 562621 605779 647659 681607 723623 763307 808261 844709 886163 926623 967229 1014617 - 1121987 1201469 1268789 1345651 1429531 1492177 1577839 1651547 1722601 1800377 1878623 1942141 2028401 - 2242727 2399581 2559173 2686813 2836357 3005579 3144971 3283993 3460133 3582923 3757093 3903769 4061261 - 4455361 4783837 5068529 5418079 5680243 6000023 6292981 6611497 6884641 7211599 7514189 7798313 8077189 - 9031853 9612721 10226107 10745291 11338417 11939203 12567671 13212697 13816333 14337529 14938571 15595673 16147291 - 17851577 18993941 20180239 21228533 22375079 23450491 24635579 25683871 26850101 27921689 29090911 30153841 31292507 32467307 - 35817611 37983761 40234253 42457253 44750177 46957969 49175831 51442639 53726417 55954637 58126987 60365939 62666977 64826669 - 71582779 76039231 80534381 84995153 89500331 93956777 98470819 102879613 107400389 111856841 116365721 120819287 125246581 129732203 - 143163379 152076289 161031319 169981667 179000669 187913573 196826447 205826729 214748357 223713691 232679021 241591901 250504801 259470131 - 285162679 301939921 318717121 335494331 352271573 369148753 385926017 402603193 419480419 436157621 453034849 469712051 486589307 503366497 520043707 - 570475349 603929813 637584271 671138659 704693081 738247541 771801929 805356457 838910803 872365267 905919671 939574117 973128521 1006682977 1040137411 - 1073741833) - - "The above primes past 2069 were chosen carefully so that they do not interact badly with 1664525 (used by hashMultiply), and so that gcd(p, (256^k) +/- a) = 1, for 0<a<=32 and 0<k<=8. See Knuth's TAOCP for details." - - "The above primes also try to map the values of ((0 to: 4095) collect: [ :each | each << 18 \\ prime ]) sort to an equidistant sequence of numbers. This helps to avoid the collision of chains in identity-based hashed collections. To do that they were chosen to return a low value when the following block is evaluated with them as argument: - [ :prime | - | slots cost optimalDistance previous | - slots := Array new: 4097. - 0 to: 4095 do: [ :ea | slots at: ea + 1 put: ea * 262144 \\ prime ]. - slots at: 4097 put: prime. - slots sort. - cost := 0. - optimalDistance := prime // 4096. - 2 to: 4097 do: [ :index | - | newCost | - newCost := optimalDistance - ((slots at: index) - (slots at: index - 1)). - newCost > cost ifTrue: [ cost := newCost ] ]. - cost ]."! Item was added: + ----- Method: HashedCollection class>>initialize (in category 'sizing') ----- + initialize + + self initializeGoodPrimes! Item was added: + ----- Method: HashedCollection class>>initializeGoodPrimes (in category 'sizing') ----- + initializeGoodPrimes + "GoodPrimes is a sorted array of prime numbers less than one billion that make good hash table sizes. Should be expanded as needed. See comments below code." + + GoodPrimes := #(3 5 7 11 13 17 23 31 43 59 79 107 149 199 269 359 479 641 857 1151 1549 2069 + 2237 2423 2617 2797 2999 3167 3359 3539 3727 3911 + 4441 4787 5119 5471 5801 6143 6521 6827 7177 7517 7853 + 8783 9601 10243 10867 11549 12239 12919 13679 14293 15013 15731 + 17569 19051 20443 21767 23159 24611 25847 27397 28571 30047 31397 + 35771 38201 40841 43973 46633 48989 51631 54371 57349 60139 62969 + 70589 76091 80347 85843 90697 95791 101051 106261 111143 115777 120691 126311 + 140863 150523 160969 170557 181243 190717 201653 211891 221251 232591 242873 251443 + 282089 300869 321949 341227 362353 383681 401411 422927 443231 464951 482033 504011 + 562621 605779 647659 681607 723623 763307 808261 844709 886163 926623 967229 1014617 + 1121987 1201469 1268789 1345651 1429531 1492177 1577839 1651547 1722601 1800377 1878623 1942141 2028401 + 2242727 2399581 2559173 2686813 2836357 3005579 3144971 3283993 3460133 3582923 3757093 3903769 4061261 + 4455361 4783837 5068529 5418079 5680243 6000023 6292981 6611497 6884641 7211599 7514189 7798313 8077189 + 9031853 9612721 10226107 10745291 11338417 11939203 12567671 13212697 13816333 14337529 14938571 15595673 16147291 + 17851577 18993941 20180239 21228533 22375079 23450491 24635579 25683871 26850101 27921689 29090911 30153841 31292507 32467307 + 35817611 37983761 40234253 42457253 44750177 46957969 49175831 51442639 53726417 55954637 58126987 60365939 62666977 64826669 + 71582779 76039231 80534381 84995153 89500331 93956777 98470819 102879613 107400389 111856841 116365721 120819287 125246581 129732203 + 143163379 152076289 161031319 169981667 179000669 187913573 196826447 205826729 214748357 223713691 232679021 241591901 250504801 259470131 + 285162679 301939921 318717121 335494331 352271573 369148753 385926017 402603193 419480419 436157621 453034849 469712051 486589307 503366497 520043707 + 570475349 603929813 637584271 671138659 704693081 738247541 771801929 805356457 838910803 872365267 905919671 939574117 973128521 1006682977 1040137411 + 1073741833) + + "The above primes past 2069 were chosen carefully so that they do not interact badly with 1664525 (used by hashMultiply), and so that gcd(p, (256^k) +/- a) = 1, for 0<a<=32 and 0<k<=8. See Knuth's TAOCP for details." + + "The above primes also try to map the values of ((0 to: 4095) collect: [ :each | each << 18 \\ prime ]) sort to an equidistant sequence of numbers. This helps to avoid the collision of chains in identity-based hashed collections. To do that they were chosen to return a low value when the following block is evaluated with them as argument: + [ :prime | + | n slots cost optimalDistance | + n := 1 bitShift: 22. + slots := Array new: n + 1. + 0 to: n - 1 do: [ :ea | slots at: ea + 1 put: (ea bitShift: 8) \\ prime ]. + slots at: n + 1 put: prime. + slots sort. + cost := 0. + optimalDistance := prime // n. + 2 to: n + 1 do: [ :index | + | newCost | + newCost := optimalDistance - ((slots at: index) - (slots at: index - 1)). + newCost > cost ifTrue: [ cost := newCost ] ]. + result add: prime -> cost ] + + The shifts in the block relate to the numer of bits the #identityHash consists of (22) and the number of bits #scaledIdentityHash shifts it (8)"! Item was added: + ----- Method: HashedCollection class>>isAbstract (in category 'testing') ----- + isAbstract + ^self = HashedCollection! Item was changed: ----- Method: HashedCollection class>>new (in category 'instance creation') ----- new + "Create a HashedCollection large enough to hold 3 different objects without growing." + + ^self basicNew initialize: 5 "For performance, inline the value 5 which would normally be returned by #sizeFor:."! - ^ self basicNew initialize: 5! Item was changed: ----- Method: HashedCollection class>>new: (in category 'instance creation') ----- + new: numberOfElements + "Create a HashedCollection large enough to hold numberOfElements different objects without growing." + + ^self basicNew initialize: (numberOfElements <= 3 + ifFalse: [ self sizeFor: numberOfElements ] + ifTrue: [ "Inline values returned by #sizeFor: to ensure that #new: is not significantly slower than #new for small values." + numberOfElements < 3 + ifTrue: [ 3 ] + ifFalse: [ 5 ] ])! - new: nElements - "Create a Set large enough to hold nElements without growing" - ^ self basicNew initialize: (self sizeFor: nElements)! Item was changed: ----- Method: HashedCollection class>>rehashAll (in category 'initialize-release') ----- rehashAll "HashedCollection rehashAll" + self allSubclassesDo: [ :each | each rehashAllInstances ]! - self allSubclassesDo: #rehashAllInstances! Item was changed: ----- Method: HashedCollection class>>rehashAllInstances (in category 'initialize-release') ----- rehashAllInstances + "Do not use #allInstancesDo: because #rehash may create new instances. Ignore immutable instances." - "Do not use #allInstancesDo: because #rehash may create new instances." + self allInstances do: [ :each | + each isReadOnlyObject ifFalse: [ + each rehash ] ]! - self allInstances do: [ :each | each rehash ]! Item was changed: ----- Method: HashedCollection class>>sizeFor: (in category 'sizing') ----- + sizeFor: numberOfElements + "Return a large enough prime (or odd if too large), the size of the internal array to hold numberOfElements with at most 75% load factor." - sizeFor: nElements - "Large enough prime (or odd if too large) size to hold nElements with some slop (see fullCheck)" + ^self goodPrimeAtLeast: numberOfElements * 4 + 2 // 3 "Optimized version of (numberOfElements * 4 / 3) ceiling."! - nElements < 4 ifTrue: [ ^5 ]. - ^self goodPrimeAtLeast: nElements + 1 * 4 // 3! Item was added: + ----- Method: HashedCollection>>arrayType (in category 'private') ----- + arrayType + ^ Array! Item was changed: ----- Method: HashedCollection>>atNewIndex:put: (in category 'private') ----- atNewIndex: index put: anObject + tally := tally + 1. "Update tally first, so that read-only hashed collections raise an error before modifying array." array at: index put: anObject. - tally := tally + 1. "Keep array at least 1/4 free for decent hash behavior" array size * 3 < (tally * 4) ifTrue: [ self grow ]! Item was changed: ----- Method: HashedCollection>>capacity (in category 'accessing') ----- capacity + "Answer the current capacity of the receiver - aka the number of elements the receiver can hold without growing." - "Answer the current capacity of the receiver." + ^ array size * 3 // 4! - ^ array size! Item was changed: ----- Method: HashedCollection>>compact (in category 'private') ----- compact "Reduce the size of array so that the load factor will be ~75%." + | newArraySize | + newArraySize := self class sizeFor: self slowSize. + array size = newArraySize ifFalse: [ + self growTo: newArraySize ]! - | newCapacity | - newCapacity := self class goodPrimeAtLeast: tally * 4 // 3. - self growTo: newCapacity! Item was removed: - ----- Method: HashedCollection>>doWithIndex: (in category 'enumerating') ----- - doWithIndex: aBlock2 - "Support Set enumeration with a counter, even though not ordered" - | index | - index := 0. - self do: [:item | aBlock2 value: item value: (index := index+1)]! Item was changed: ----- Method: HashedCollection>>errorNoFreeSpace (in category 'private') ----- errorNoFreeSpace + ^ self error: 'There is no free space in this collection!!' translated! - self error: 'There is no free space in this collection!!'! Item was removed: - ----- Method: HashedCollection>>findElementOrNil: (in category 'compatibility') ----- - findElementOrNil: anObject - "This method has been superseeded by #scanFor: - It is here for compatibility with external packages only." - ^self scanFor: anObject! Item was removed: - ----- Method: HashedCollection>>fullCheck (in category 'compatibility') ----- - fullCheck - "This is a private method, formerly implemented in Set, that is no longer required. - It is here for compatibility with external packages only." - "Keep array at least 1/4 free for decent hash behavior" - - array size * 3 < (tally * 4) ifTrue: [ self grow ]! Item was changed: ----- Method: HashedCollection>>growSize (in category 'private') ----- growSize "Answer what my next higher table size should be" + ^self class sizeFor: self slowSize * 2! - ^self class goodPrimeAtLeast: array size * 3 // 2 + 2! Item was changed: ----- Method: HashedCollection>>growTo: (in category 'private') ----- growTo: anInteger + "Reallocate the elements array with the given size and reinsert the old elements. Do it even if the size of the array is the same as the argument because this method is also used to rehash the collection." + - "Grow the elements array and reinsert the old elements" - | oldElements | oldElements := array. + array := self arrayType new: anInteger. - array := self class arrayType new: anInteger. self noCheckNoGrowFillFrom: oldElements! Item was changed: ----- Method: HashedCollection>>initialize: (in category 'private') ----- initialize: n "Initialize array to an array size of n" + array := self arrayType new: n. - array := self class arrayType new: n. tally := 0! Item was added: + ----- Method: HashedCollection>>isCompact (in category 'testing') ----- + isCompact + "Answer true if I have the smallest possible capacity to store the elements." + + ^array size = (self class sizeFor: self slowSize)! Item was added: + ----- Method: HashedCollection>>isEmpty (in category 'testing') ----- + isEmpty + "For non-weak collections, we can use the tally to speed up the empty check. For weak collections, we must use the traditional way because the tally is unreliable. Also see #size vs. #slowSize." + + tally = 0 ifTrue: [ ^true ]. + ^array class isWeak and: [ super isEmpty ]! Item was changed: ----- Method: HashedCollection>>removeAll (in category 'removing') ----- removeAll "remove all elements from this collection. Preserve the capacity" + self initialize: array size! - self initialize: self capacity! Item was changed: ----- Method: HashedCollection>>scanForEmptySlotFor: (in category 'private') ----- scanForEmptySlotFor: anObject "Scan the key array for the first slot containing an empty slot (indicated by a nil). Answer the index of that slot. This method will be overridden in various subclasses that have different interpretations for matching elements." + | index start size | + index := start := anObject hash \\ (size := array size) + 1. - | index start | - index := start := anObject hash \\ array size + 1. [ (array at: index) ifNil: [ ^index ]. + (index := index \\ size + 1) = start ] whileFalse. - (index := index \\ array size + 1) = start ] whileFalse. self errorNoFreeSpace! Item was added: + ----- Method: HashedCollection>>slowSize (in category 'accessing') ----- + slowSize + "Answer an upper bound of the number of elements in this collection. For regular collections, this can simply be the value of tally, but for collections that cannot maintain an exact value, like current weak collections, this has to be calculated on the fly." + + ^tally! Item was changed: + ----- Method: HashedCollection>>union: (in category 'set logic') ----- - ----- Method: HashedCollection>>union: (in category 'enumerating') ----- union: aCollection "Answer the set theoretic union of the receiver and aCollection, using the receiver's notion of equality and not side effecting the receiver at all." ^ self copy addAll: aCollection; yourself ! Item was added: + ----- Method: HashedCollection>>withIndexDo: (in category 'enumerating') ----- + withIndexDo: aBlock2 + "Support Set enumeration with a counter, even though not ordered" + | index | + index := 0. + self do: [:item | aBlock2 value: item value: (index := index+1)]! Item was changed: + Collection subclass: #Heap - SequenceableCollection subclass: #Heap instanceVariableNames: 'array tally sortBlock indexUpdateBlock' classVariableNames: '' poolDictionaries: '' + category: 'Collections-Heap'! - category: 'Collections-Sequenceable'! + !Heap commentStamp: 'ul 6/2/2016 23:45' prior: 0! + I implement a special data structure called Binary Heap [ https://en.wikipedia.org/wiki/Binary_heap ], which is the most commonly used variant of the Heap data structure [ https://en.wikipedia.org/wiki/Heap_%28data_structure%29 ]. - !Heap commentStamp: 'nice 9/30/2010 23:22' prior: 0! - Class Heap implements a special data structure commonly referred to as 'heap' [ http://en.wikipedia.org/wiki/Heap_%28data_structure%29 ] A Heap is a kind of binary tree stored in a linear array - see details after the instance variables description. Heaps are good at handling priority queues because: 1) greatest priority element according to the sort block will be stored in first position and thus accessed in O(1) operations 2) worse time for inserting or removing an element is in O(log n) operations, where n is the size of the Heap Insertion/Removal times are more efficient than above upper bound, provided that: a) Elements are only removed at the beginning b) Elements are added with arbitrary sort order. 3) there is no need to fully sort the Heap, which makes it more efficient than a SortedCollection + The heap can be fully sorted by sending the message #sort. - The heap can be fully sorted by sending the message #fullySort. Worse time for fully sorting the Heap is in O(n log n) operations, but this is rarely used a feature. Remind that the Heap does not fully sort the collection if you don't ask. Thus don't expect #do: and other iterators to enumerate elements according to the sortBlock order. Instance variables: + array <Array> The data repository - array <Array> The data repository tally <Integer> The number of elements in the heap sortBlock <Block|nil> A two-argument block defining the sort order, or nil in which case the default sort order is [:element1 :element2| element1 <= element2] indexUpdateBlock <Block|nil> A two-argument block of the form [:data :index | ... ] which allows an application object to keep track of its index within the heap. Useful for quick heap update when object's sort value changes (for example, when an object in a priority queue has its priority increased by an external event, you don't want to have to search through the whole heap to find the index before fixing the heap). No update occurs if nil. The Heap can be viewed as a binary tree (every node in the tree has at most two children). The root is stored in first slot of internal array. The children are stored in next two slots. The children of children in next four slots. etc... For a node A of index i (1 based), the two children B1 and B2 are thus stored in indices (2*i) and (2*i+1). Of course, the children indices must be less than the tally otherwise they are considered inexistent. The Heap does arrange to preserve the following invariant: + For any children B of a node A, A is sorted before B, in other words, (sortBlock value: A value: B) = true - For any children B of a node A, A is sorted before B, in other words, (self sort: A before: B) = true This implies that the root is always the first element according to sort order. ! 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 isCompact ifTrue: [ ^self ]. + 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 removed: - ----- Method: Heap>>fullySort (in category 'accessing') ----- - fullySort - "Fully sort the heap. - This method preserves the heap invariants and can thus be sent safely" - self privateReverseSort. - 1 to: tally // 2 do: [:i | array swap: i with: 1 + tally - i]! 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>>isCompact (in category 'growing') ----- + isCompact + "Answer true if I have the smallest possible capacity to store the elements." + + ^array size = tally! 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 removed: - ----- Method: Heap>>reSort (in category 'accessing') ----- - reSort - "Resort the entire heap" - self isEmpty ifTrue:[^self]. - tally // 2 to: 1 by: -1 do:[:i| self downHeap: i].! 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>>removeFirst (in category 'removing') ----- removeFirst + "Remove the root element and make sure the sorting order is okay. Optimized version for the most common use case." + + | removed | + tally = 0 ifTrue: [ self errorSubscriptBounds: 1 ]. + removed := array at: 1. + array + at: 1 put: (array at: tally); + at: tally put: nil. + (tally := tally - 1) > 1 ifTrue: [ + "Root node has at least one child." + self downHeapSingle: 1 ]. + ^removed! - "Remove the first element from the receiver" - ^self removeAt: 1! 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 removed: - ----- Method: Heap>>sorts:before: (in category 'testing') ----- - sorts: element1 before: element2 - "Return true if element1 should be sorted before element2. - This method defines the sort order in the receiver" - ^sortBlock == nil - ifTrue:[element1 <= element2] - ifFalse:[sortBlock value: element1 value: element2].! Item was removed: - ----- Method: Heap>>trim (in category 'growing') ----- - trim - "Remove any empty slots in the receiver." - self growTo: self size.! 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: [ + indexUpdateBlock ifNotNil: [ indexUpdateBlock value: (array at: 1) value: 1 ]. + ^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.! Item was removed: - ----- Method: Heap>>updateObjectIndex: (in category 'private') ----- - updateObjectIndex: index - "If indexUpdateBlock is not nil, notify the object at index of its new position in the heap array." - indexUpdateBlock ifNotNil: [ - indexUpdateBlock value: (array at: index) value: index]! Item was changed: TextReadWriter subclass: #HtmlReadWriter + instanceVariableNames: 'count offset runStack runArray string breakLines' - instanceVariableNames: 'count offset runStack runArray string' classVariableNames: '' poolDictionaries: '' category: 'Collections-Text'! + + !HtmlReadWriter commentStamp: 'pre 8/29/2017 16:14' prior: 0! + A HtmlReadWriter is used to read a Text object from a string containing HTML or writing a Text object to a string with HTML tags representing the text attributes. + + It does two things currently: + 1) Setting text attributes on the beginning of tags, e.g. setting a bold text attribute when seeing a <b> tag. + 2) Changing the resulting string, e.g. replacing a <br> with a Character cr. + + The implementation works by pushing attributes on a stack on every opening tag. On the corresponding closing tag, the attribute is poped from the stack and stored in an array of attribute runs. From this array the final string is constructed. + + ## Notes on the implementation + - The final run array is completely constructed while parsing so it has to be correct with regard to the length of the runs. There is no consolidation except for merging neighboring runs which include the same attributes. + - The *count* variable is the position in the source string, the *offset* is the number of skipped characters, for example ones that denote a tag. + - The stack contains elements which are of the form: {text attributes. current start index. original start}! Item was added: + ----- Method: HtmlReadWriter>>activateAttributesEnding:starting: (in category 'private') ----- + activateAttributesEnding: ending starting: starting + + starting + select: [:attribute | attribute shouldFormBlocks] + thenDo: [: attribute | + (ending includes: attribute) ifFalse: [self writeStartTagFor: attribute]]; + reject: [:attribute | attribute shouldFormBlocks] + thenDo: [: attribute | self writeStartTagFor: attribute].! Item was added: + ----- Method: HtmlReadWriter>>addCharacter: (in category 'private') ----- + addCharacter: aCharacter + + string add: aCharacter. + count := count + 1.! Item was added: + ----- Method: HtmlReadWriter>>addString: (in category 'private') ----- + addString: aString + + string addAll: aString. + count := count + aString size.! Item was added: + ----- Method: HtmlReadWriter>>breakLines (in category 'accessing') ----- + breakLines + + ^ breakLines! Item was added: + ----- Method: HtmlReadWriter>>breakLines: (in category 'accessing') ----- + breakLines: aBoolean + + breakLines := aBoolean! Item was added: + ----- Method: HtmlReadWriter>>cr (in category 'stream emulation') ----- + cr + + self breakLines ifTrue: [stream nextPutAll: '<br>']. + ^ stream cr! Item was added: + ----- Method: HtmlReadWriter>>deactivateAttributesEnding:starting: (in category 'private') ----- + deactivateAttributesEnding: ending starting: starting + + ending reversed + reject: [:attribute | attribute shouldFormBlocks] + thenDo: [: attribute | self writeEndTagFor: attribute]; + select: [:attribute | attribute shouldFormBlocks] + thenDo: [: attribute | + (starting includes: attribute) ifFalse: [self writeEndTagFor: attribute]].! Item was added: + ----- Method: HtmlReadWriter>>httpGetImage: (in category 'private') ----- + httpGetImage: url + "To not add a direct dependency to WebClient, provide this hook for getting am image from an HTTP url. Maybe we can have this via an AppRegistry at some point. Maybe extend WebBrowser." + + (url beginsWith: 'code://') ifTrue: [ + "Same support for Smalltalk expressions as in TextURL >> #actOnClickFor:." + ^ ([Compiler evaluate: (url allButFirst: 7)] ifError: [nil]) + ifNotNil: [:object | object isForm ifTrue: [object] ifFalse: [nil]]]. + + (url beginsWith: 'data:') ifTrue: [ | data mediaType separator | + separator := url indexOf: $, ifAbsent: [^ nil]. + mediaType := url copyFrom: 6 to: separator - 1. + data := url allButFirst: separator. + data := (mediaType endsWith: ';base64') + ifTrue: [ + mediaType := mediaType allButLast: 7. + [Base64MimeConverter mimeDecodeToBytes: data readStream] ifError: [nil]] + ifFalse: [data asByteArray readStream]. + ^ [ImageReadWriter formFromStream: data] ifError: [nil]]. + + ^ (Smalltalk classNamed: 'WebClient') ifNotNil: [:client | + ([client httpGet: url] ifError: [nil]) ifNotNil: [:response | + response code = 200 ifFalse: [nil] ifTrue: [ + [Form fromBinaryStream: response content asByteArray readStream] + ifError: [nil]]]]! Item was added: + ----- Method: HtmlReadWriter>>initialize (in category 'initialize-release') ----- + initialize + + super initialize. + self breakLines: true.! Item was changed: ----- Method: HtmlReadWriter>>isTagIgnored: (in category 'testing') ----- isTagIgnored: aTag | space t | + t := aTag copyWithoutAll: '</>'. + space := t indexOf: Character space. - space := aTag indexOf: Character space. t := space > 0 + ifTrue: [t copyFrom: 1 to: space - 1] + ifFalse: [t]. - ifTrue: [aTag copyFrom: 2 to: space - 1] - ifFalse: [aTag copyFrom: 2 to: aTag size - 1]. ^ self ignoredTags includes: t! Item was changed: ----- Method: HtmlReadWriter>>mapATag: (in category 'mapping') ----- mapATag: aTag | result startIndex stopIndex attribute | result := OrderedCollection new. "<a href=""http://google.de"">" attribute := 'href'. startIndex := aTag findString: attribute. startIndex > 0 ifTrue: [ + startIndex := aTag findString: '"' startingAt: startIndex+attribute size. + startIndex > 0 + ifTrue: [stopIndex := aTag findString: '"' startingAt: startIndex+1] + ifFalse: [ + "URLs without quotes..." + startIndex := aTag findString: '=' startingAt: startIndex+attribute size. + stopIndex := aTag findString: '>' startingAt: startIndex+1]. - startIndex := aTag findString: '=' startingAt: startIndex+attribute size. - stopIndex := aTag findString: ' ' startingAt: startIndex+1. - stopIndex = 0 ifTrue: [ - stopIndex := aTag findString: '>' startingAt: startIndex+1]. - - (aTag at: startIndex + 1) = $" - ifTrue: [startIndex := startIndex + 1]. - (aTag at: stopIndex - 1) = $" - ifTrue: [stopIndex := stopIndex - 1]. result add: (TextURL new url: (aTag copyFrom: startIndex+1 to: stopIndex-1))]. ^ result! Item was added: + ----- Method: HtmlReadWriter>>mapAlignmentTag: (in category 'mapping') ----- + mapAlignmentTag: aTag + + | attributeStart | + " special html case ". + aTag = '<center>' ifTrue: [^ {TextAlignment centered}]. + + "<div align=justify> or <div align=""right"">" + attributeStart := aTag findString: 'align='. + attributeStart > 0 ifTrue: [ + | attributeRest | + attributeRest := aTag copyAfter: $=. + attributeRest first = $" ifTrue: [attributeRest := attributeRest allButFirst]. " quoted case " + ^ self mapAlignmentValue: (attributeRest findTokens: ' ">') first]. + ^ #()! Item was added: + ----- Method: HtmlReadWriter>>mapAlignmentValue: (in category 'mapping') ----- + mapAlignmentValue: aString + + (aString = 'center' or: [aString = 'middle']) ifTrue: [^ {TextAlignment centered}]. + aString = 'left' ifTrue: [^ {TextAlignment leftFlush}]. + aString = 'right' ifTrue: [^ {TextAlignment rightFlush}]. + aString = 'justify' ifTrue: [^ {TextAlignment justified}]. + ^ #()! Item was added: + ----- Method: HtmlReadWriter>>mapCloseCodeTag (in category 'mapping') ----- + mapCloseCodeTag + + | theDoIt | + theDoIt := runStack top first + detect: [:attribute | attribute isKindOf: TextDoIt] + ifNone: [^ self "nothing found, ignore"]. + theDoIt evalString: (String withAll: (string copyFrom: runStack top third to: string size)).! Item was added: + ----- Method: HtmlReadWriter>>mapCodeTag (in category 'mapping') ----- + mapCodeTag + + ^ {TextDoIt new} "yet uninitialized"! Item was added: + ----- Method: HtmlReadWriter>>mapContainerTag: (in category 'mapping') ----- + mapContainerTag: aTag + + | result styleStart styleEnd styleAttributes | + result := OrderedCollection new. + styleStart := (aTag findString: 'style="' ) + 7. + styleStart <= 7 ifTrue: [^#()]. + styleEnd := (aTag findString: '"' startingAt: styleStart) - 1. + styleAttributes := (aTag copyFrom: styleStart to: styleEnd) subStrings: ';'. + styleAttributes do: [:ea | |keyValue key value| + keyValue := (ea subStrings: ':') collect: [:s | s withBlanksTrimmed]. + key := keyValue first asLowercase. + value := keyValue second. + keyValue size = 2 ifTrue: [ + key = 'color' ifTrue: [result add: (TextColor color: (Color fromString: value))]. + (key beginsWith: 'font') ifTrue: [ + (value includesSubstring: 'bold') + ifTrue: [result add: TextEmphasis bold]. + (value includesSubstring: 'italic') + ifTrue: [result add: TextEmphasis italic]]]]. + ^ result! Item was changed: ----- Method: HtmlReadWriter>>mapFontTag: (in category 'mapping') ----- mapFontTag: aTag + | result colorName fontFace fontSize | - | result colorStartIndex colorStopIndex attribute | result := OrderedCollection new. + "<font color=""#00FFCC""> or <font color=""green"">" + "<font face=""Bitmap DejaVu Sans"" size=""12"">" + (#(color face size) collect: [:attribute | + | startIndex stopIndex | + startIndex := aTag findString: attribute. + startIndex > 0 ifTrue: [ + startIndex := aTag findString: '"' startingAt: startIndex+attribute size. + stopIndex := aTag findString: '"' startingAt: startIndex+1. + aTag copyFrom: startIndex+1 to: stopIndex-1]]) + in: [:values | + colorName := values first. + fontFace := values second. + fontSize := values third]. - "<font color=""#00FFCC"">" - attribute := 'color'. - colorStartIndex := aTag findString: attribute. - colorStartIndex > 0 ifTrue: [ - colorStartIndex := aTag findString: '#' startingAt: colorStartIndex+attribute size. - colorStopIndex := aTag findString: '"' startingAt: colorStartIndex+1. - result add: (TextColor color: - (Color fromString: (aTag copyFrom: colorStartIndex to: colorStopIndex-1)))]. + colorName ifNotNil: [ + result add: (TextColor color: (Color fromString: colorName))]. + (fontFace notNil or: [fontSize notNil]) ifTrue: [ + result add: (TextFontReference toFont: (StrikeFont familyName: (fontFace ifNil: [TextStyle defaultFont familyName]) pointSize: (fontSize ifNil: [TextStyle defaultFont pointSize])))]. + ^ result! Item was added: + ----- Method: HtmlReadWriter>>mapImgTag: (in category 'mapping') ----- + mapImgTag: aTag + + | result startIndex stopIndex attribute src form scaleFactor | + result := OrderedCollection new. + + "<img src=""https://squeak.org/img/downloads/image.png"">" + attribute := 'src'. + startIndex := aTag findString: attribute. + startIndex > 0 ifTrue: [ + startIndex := aTag findString: '"' startingAt: startIndex+attribute size. + startIndex > 0 + ifTrue: [stopIndex := aTag findString: '"' startingAt: startIndex+1] + ifFalse: [ + "URLs without quotes..." + startIndex := aTag findString: '=' startingAt: startIndex+attribute size. + stopIndex := aTag findString: '>' startingAt: startIndex+1]. + src := aTag copyFrom: startIndex+1 to: stopIndex-1. + form := (self httpGetImage: src) ifNil: [(Form dotOfSize: 12 color: Color veryLightGray)]. + (scaleFactor := RealEstateAgent scaleFactor) = 1.0 + ifFalse: [form := form scaledToSize: form extent * scaleFactor]. + result + add: form asTextAnchor; + add: (TextColor color: Color transparent)]. + ^ result! Item was changed: ----- Method: HtmlReadWriter>>mapTagToAttribute: (in category 'mapping') ----- mapTagToAttribute: aTag aTag = '<b>' ifTrue: [^ {TextEmphasis bold}]. aTag = '<i>' ifTrue: [^ {TextEmphasis italic}]. aTag = '<u>' ifTrue: [^ {TextEmphasis underlined}]. + aTag = '<s>' ifTrue: [^ {TextEmphasis struckOut}]. + aTag = '<code>' ifTrue: [^ self mapCodeTag]. + aTag = '<pre>' ifTrue: [self breakLines: false. ^ {}]. + (#('<div' '<span' '<center>' ) anySatisfy: [:ea | aTag beginsWith: ea]) + ifTrue: [^(self mapAlignmentTag: aTag) union: (self mapContainerTag: aTag)]. - "aTag = '<code>' ifTrue: [^ {TextFontReference toFont: Preferences standardCodeFont}]." (aTag beginsWith: '<font') ifTrue: [^ self mapFontTag: aTag]. (aTag beginsWith: '<a') ifTrue: [^ self mapATag: aTag]. + (aTag beginsWith: '<img') ifTrue: [^ self mapImgTag: aTag]. "h1, h2, h3, ..." (aTag second = $h and: [aTag third isDigit]) ifTrue: [^ {TextEmphasis bold}]. ^ {}! Item was added: + ----- Method: HtmlReadWriter>>nextPut: (in category 'stream emulation') ----- + nextPut: aCharacter + + ^ stream nextPut: aCharacter! Item was added: + ----- Method: HtmlReadWriter>>nextPutAll: (in category 'stream emulation') ----- + nextPutAll: aCollection + + ^ stream nextPutAll: aCollection! Item was changed: + ----- Method: HtmlReadWriter>>nextPutText: (in category 'private') ----- - ----- Method: HtmlReadWriter>>nextPutText: (in category 'accessing') ----- nextPutText: aText + | previous | + previous := #(). + self activateAttributesEnding: #() starting: previous. "for consistency" aText runs withStartStopAndValueDo: [:start :stop :attributes | + self + deactivateAttributesEnding: previous starting: attributes; + activateAttributesEnding: previous starting: attributes; + writeContent: (aText string copyFrom: start to: stop). + previous := attributes]. + self deactivateAttributesEnding: previous starting: #().! - | att str | - att := aText attributesAt: start. - str := aText string copyFrom: start to: stop. - - att do: [:each | self writeStartTagFor: each]. - self writeContent: str. - att reverse do: [:each | self writeEndTagFor: each]]! Item was changed: + ----- Method: HtmlReadWriter>>nextText (in category 'private') ----- - ----- Method: HtmlReadWriter>>nextText (in category 'accessing') ----- nextText count := 0. offset := 0. "To ignore characters in the input string that are used by tags." runStack := Stack new. runArray := RunArray new. string := OrderedCollection new. + "{text attributes. current start index. original start}" + runStack push: {OrderedCollection new. 1. 1}. - "{text attributes. start index. end index. number of open tags}" - runStack push: {OrderedCollection new. 1. nil. 0}. [stream atEnd] whileFalse: [self processNextTag]. self processRunStackTop. "Add last run." string := String withAll: string. runArray coalesce. ^ Text string: string runs: runArray! Item was changed: ----- Method: HtmlReadWriter>>processEmptyTag: (in category 'reading') ----- processEmptyTag: aTag (aTag beginsWith: '<br') ifTrue: [ + self addCharacter: Character cr. - string add: Character cr. - count := count + 1. ^ self]. + (aTag beginsWith: '<img') ifTrue:[ + ^ self processStartTag: aTag]. + + (self isTagIgnored: aTag) - (self ignoredTags includes: (aTag copyFrom: 2 to: aTag size - 3)) ifTrue: [^ self]. + "TODO... what?"! - "TODO..."! Item was changed: ----- Method: HtmlReadWriter>>processEndTag: (in category 'reading') ----- processEndTag: aTag + | index tagName | - | index | index := count - offset. + tagName := aTag copyFrom: 3 to: aTag size - 1. - - (self ignoredTags includes: (aTag copyFrom: 3 to: aTag size -1)) - ifTrue: [^ self]. + (self isTagIgnored: tagName) ifTrue: [^ self]. + + tagName = 'code' ifTrue: [self mapCloseCodeTag]. + tagName = 'pre' ifTrue: [self breakLines: true]. - "De-Accumulate adjacent tags." - runStack top at: 4 put: runStack top fourth - 1. - runStack top fourth > 0 - ifTrue: [^ self "not yet"]. self processRunStackTop. runStack pop. runStack top at: 2 put: index + 1.! Item was added: + ----- Method: HtmlReadWriter>>processEndTagEagerly: (in category 'reading') ----- + processEndTagEagerly: aTag + "Not all tags need an end tag. Simulate that here." + + (aTag beginsWith: '<img') + ifTrue: [^ self processEndTag: '</img>'].! Item was changed: ----- Method: HtmlReadWriter>>processHtmlEscape: (in category 'reading') ----- processHtmlEscape: aString + | escapeSequence | + escapeSequence := aString copyFrom: 2 to: aString size - 1. + escapeSequence first = $# ifTrue: [^ self processHtmlEscapeNumber: escapeSequence allButFirst]. - (String htmlEntities at: (aString copyFrom: 2 to: aString size - 1) ifAbsent: []) ifNotNil: [:char | + self addCharacter: char].! - string add: char. - count := count + 1].! Item was added: + ----- Method: HtmlReadWriter>>processHtmlEscapeNumber: (in category 'private') ----- + processHtmlEscapeNumber: aString + | number | + number := aString first = $x + ifTrue: [ '16r', aString allButFirst ] + ifFalse: [ aString ]. + self addCharacter: number asNumber asCharacter. + ! Item was changed: ----- Method: HtmlReadWriter>>processNextTag (in category 'reading') ----- processNextTag + | tag htmlEscape lookForNewTag lookForHtmlEscape tagFound valid inComment inTagString | - | tag htmlEscape lookForNewTag lookForHtmlEscape tagFound valid inComment | lookForNewTag := true. lookForHtmlEscape := false. tagFound := false. tag := OrderedCollection new. htmlEscape := OrderedCollection new. inComment := false. + inTagString := false. [stream atEnd not and: [tagFound not]] whileTrue: [ | character | character := stream next. valid := (#(10 13) includes: character asciiValue) not. count := count + 1. character = $< ifTrue: [lookForNewTag := false]. + character = $& ifTrue: [inComment ifFalse: [lookForHtmlEscape := true]]. - character = $& ifTrue: [ - inComment ifFalse: [lookForHtmlEscape := true]]. lookForNewTag ifTrue: [ lookForHtmlEscape + ifFalse: [ + (valid or: [self breakLines not]) + ifTrue: [string add: character] + ifFalse: [offset := offset + 1]] - ifFalse: [valid ifTrue: [string add: character] ifFalse: [offset := offset + 1]] ifTrue: [valid ifTrue: [htmlEscape add: character]. offset := offset + 1]] ifFalse: [valid ifTrue: [tag add: character]. offset := offset + 1]. + "Toggle within tag string/text." + (character = $" and: [lookForNewTag not]) + ifTrue: [inTagString := inTagString not]. + inComment := ((lookForNewTag not and: [tag size >= 4]) and: [tag beginsWith: '<!!--']) and: [(tag endsWith: '-->') not]. + (((character = $> and: [inComment not]) and: [lookForNewTag not]) and: [inTagString not]) ifTrue: [ - ((character = $> and: [inComment not]) and: [lookForNewTag not]) ifTrue: [ lookForNewTag := true. (tag beginsWith: '<!!--') ifTrue: [self processComment: (String withAll: tag)] ifFalse: [tag second ~= $/ ifTrue: [ (tag atLast: 2) == $/ ifTrue: [self processEmptyTag: (String withAll: tag)] ifFalse: [self processStartTag: (String withAll: tag)]] ifFalse: [self processEndTag: (String withAll: tag)]]. tagFound := true]. (((character = $; and: [lookForNewTag]) and: [htmlEscape notEmpty]) and: [htmlEscape first = $&]) ifTrue: [ lookForHtmlEscape := false. self processHtmlEscape: (String withAll: htmlEscape). htmlEscape := OrderedCollection new]]. ! Item was changed: ----- Method: HtmlReadWriter>>processRunStackTop (in category 'reading') ----- processRunStackTop "Write accumulated attributes to run array." + | currentIndex start attrs | + currentIndex := count - offset. - | index start end attrs | - index := count - offset. - - "Set end index." - runStack top at: 3 put: index. - "Write to run array." start := runStack top second. - end := runStack top third. attrs := runStack top first. runArray + add: attrs asArray + withOccurrences: currentIndex - start + 1.! - addLast: attrs asArray - times: end - start + 1.! Item was changed: ----- Method: HtmlReadWriter>>processStartTag: (in category 'reading') ----- processStartTag: aTag | index | (self isTagIgnored: aTag) ifTrue: [^ self]. index := count - offset. aTag = '<br>' ifTrue: [ + self addCharacter: Character cr. - string add: Character cr. - count := count + 1. ^ self]. + (aTag beginsWith: '<img') ifTrue: [ + self addString: Character startOfHeader asString. + offset := offset + 1. + index := index - 1]. - string addAll: '[image]'. - count := count + 7. - ^ self]. + self processRunStackTop. "To add all attributes before the next tag adds some." - "Accumulate adjacent tags." - (runStack size > 1 and: [runStack top second = (index + 1) "= adjacent start tags"]) - ifTrue: [ - runStack top at: 1 put: (runStack top first copy addAll: (self mapTagToAttribute: aTag); yourself). - runStack top at: 4 put: (runStack top fourth + 1). "increase number of open tags" - ^self]. - - self processRunStackTop. - "Remove start/end info to reuse attributes later." - runStack top at: 2 put: nil. - runStack top at: 3 put: nil. "Copy attr list and add new attr." + runStack push: ({runStack top first copy addAll: (self mapTagToAttribute: aTag); yourself. index + 1 . index + 1}). + + "For tags such as <img>, we should simulate the closing tag because there won't be any." + self processEndTagEagerly: aTag.! - runStack push: ({runStack top first copy addAll: (self mapTagToAttribute: aTag); yourself. index + 1. nil. 1}).! Item was changed: ----- Method: HtmlReadWriter>>writeContent: (in category 'writing') ----- writeContent: aString aString do: [:char | (#(10 13) includes: char asciiValue) + ifTrue: [self cr] - ifTrue: [stream nextPutAll: '<br>'; cr] ifFalse: [char = Character tab + ifTrue: [self nextPutAll: ' '] - ifTrue: [stream nextPutAll: ' '] ifFalse: [(String htmlEntities keyAtValue: char ifAbsent: []) + ifNil: [self nextPut: char] - ifNil: [stream nextPut: char] ifNotNil: [:escapeSequence | + self - stream nextPut: $&; nextPutAll: escapeSequence; nextPut: $;]]]].! Item was changed: ----- Method: HtmlReadWriter>>writeEndTagFor: (in category 'writing') ----- writeEndTagFor: aTextAttribute + [aTextAttribute closeHtmlOn: self] - [aTextAttribute closeHtmlOn: stream] on: MessageNotUnderstood do: []! Item was changed: ----- Method: HtmlReadWriter>>writeStartTagFor: (in category 'writing') ----- writeStartTagFor: aTextAttribute + [aTextAttribute openHtmlOn: self] - [aTextAttribute openHtmlOn: stream] on: MessageNotUnderstood do: [].! Item was changed: ----- Method: IdentityDictionary>>keyAtValue:ifAbsent: (in category 'accessing') ----- keyAtValue: value ifAbsent: exceptionBlock "Answer the key that is the external name for the argument, value. If there is none, answer the result of evaluating exceptionBlock." + ^self keyAtIdentityValue: value ifAbsent: exceptionBlock! - ^super keyAtIdentityValue: value ifAbsent: exceptionBlock! Item was changed: ----- Method: IdentityDictionary>>scanFor: (in category 'private') ----- scanFor: anObject "Scan the key array for the first slot containing either a nil (indicating an empty slot) or an element that matches anObject. Answer the index of that slot or raise an error if no slot is found. This method will be overridden in various subclasses that have different interpretations for matching elements." + | index start size | + index := start := anObject scaledIdentityHash \\ (size := array size) + 1. - | index start | - index := start := anObject scaledIdentityHash \\ array size + 1. [ | element | ((element := array at: index) == nil or: [ element key == anObject ]) ifTrue: [ ^index ]. + (index := index \\ size + 1) = start ] whileFalse. - (index := index \\ array size + 1) = start ] whileFalse. self errorNoFreeSpace! Item was changed: ----- Method: IdentityDictionary>>scanForEmptySlotFor: (in category 'private') ----- scanForEmptySlotFor: anObject "Scan the key array for the first slot containing an empty slot (indicated by a nil). Answer the index of that slot. This method will be overridden in various subclasses that have different interpretations for matching elements." + | index start size | + index := start := anObject scaledIdentityHash \\ (size := array size) + 1. - | index start | - index := start := anObject scaledIdentityHash \\ array size + 1. [ (array at: index) ifNil: [ ^index ]. + (index := index \\ size + 1) = start ] whileFalse. - (index := index \\ array size + 1) = start ] whileFalse. self errorNoFreeSpace! Item was changed: ----- Method: IdentitySet>>scanFor: (in category 'private') ----- scanFor: anObject "Scan the key array for the first slot containing either a nil (indicating an empty slot) or an element that matches anObject. Answer the index of that slot or raise an error if no slot is found. This method will be overridden in various subclasses that have different interpretations for matching elements." + | index start size | + index := start := anObject scaledIdentityHash \\ (size := array size) + 1. - | index start | - index := start := anObject scaledIdentityHash \\ array size + 1. [ | element | ((element := array at: index) == nil or: [ element enclosedSetElement == anObject ]) ifTrue: [ ^index ]. + (index := index \\ size + 1) = start ] whileFalse. - (index := index \\ array size + 1) = start ] whileFalse. self errorNoFreeSpace! Item was changed: ----- Method: IdentitySet>>scanForEmptySlotFor: (in category 'private') ----- scanForEmptySlotFor: anObject "Scan the key array for the first slot containing an empty slot (indicated by a nil). Answer the index of that slot. This method will be overridden in various subclasses that have different interpretations for matching elements." + | index start size | + index := start := anObject scaledIdentityHash \\ (size := array size) + 1. - | index start | - index := start := anObject scaledIdentityHash \\ array size + 1. [ (array at: index) ifNil: [ ^index ]. + (index := index \\ size + 1) = start ] whileFalse. - (index := index \\ array size + 1) = start ] whileFalse. self errorNoFreeSpace! Item was changed: + SignedWordArray variableWordSubclass: #IntegerArray - ArrayedCollection variableWordSubclass: #IntegerArray instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Collections-Arrayed'! !IntegerArray commentStamp: '<historical>' prior: 0! IntegerArrays store 32bit signed Integer values. Negative values are stored as 2's complement.! Item was removed: - ----- Method: IntegerArray>>at: (in category 'accessing') ----- - at: index - | word | - <primitive: 165> - word := self basicAt: index. - word < 16r3FFFFFFF ifTrue:[^word]. "Avoid LargeInteger computations" - ^word >= 16r80000000 "Negative?!!" - ifTrue:["word - 16r100000000" - (word bitInvert32 + 1) negated] - ifFalse:[word]! Item was removed: - ----- Method: IntegerArray>>at:put: (in category 'accessing') ----- - at: index put: anInteger - | word | - <primitive: 166> - anInteger < 0 - ifTrue:[anInteger < -16r80000000 ifTrue: [self error: anInteger asString , ' out of range']. - "word := 16r100000000 + anInteger" - word := (anInteger + 1) negated bitInvert32] - ifFalse:[anInteger > 16r7FFFFFFF ifTrue: [self error: anInteger asString , ' out of range']. - word := anInteger]. - self basicAt: index put: word. - ^anInteger! Item was removed: - ----- Method: IntegerArray>>atAllPut: (in category 'accessing') ----- - atAllPut: anInteger - | word | - anInteger < 0 - ifTrue:[anInteger < -16r80000000 ifTrue: [self error: anInteger asString , ' out of range']. - "word := 16r100000000 + anInteger" - word := (anInteger + 1) negated bitInvert32] - ifFalse:[anInteger > 16r7FFFFFFF ifTrue: [self error: anInteger asString , ' out of range']. - word := anInteger]. - self primFill: word.! Item was removed: - ----- Method: IntegerArray>>defaultElement (in category 'accessing') ----- - defaultElement - "Return the default element of the receiver" - ^0! Item was removed: - ----- Method: IntegerArray>>primFill: (in category 'private') ----- - primFill: aPositiveInteger - "Fill the receiver, an indexable bytes or words object, with the given positive integer. The range of possible fill values is [0..255] for byte arrays and [0..(2^32 - 1)] for word arrays." - - <primitive: 145> - self errorImproperStore.! Item was changed: ----- Method: Interval class>>from:to: (in category 'instance creation') ----- from: startInteger to: stopInteger "Answer an instance of me, starting at startNumber, ending at stopNumber, and with an interval increment of 1." + ^((startInteger hasLimitedPrecision or: [stopInteger hasLimitedPrecision]) + ifTrue: [self limitedPrecisionSpecies] + ifFalse: [self]) basicNew - ^self basicNew setFrom: startInteger to: stopInteger by: 1! Item was changed: ----- Method: Interval class>>from:to:by: (in category 'instance creation') ----- from: startInteger to: stopInteger by: stepInteger "Answer an instance of me, starting at startNumber, ending at stopNumber, and with an interval increment of stepNumber." + ^((startInteger hasLimitedPrecision or: [stopInteger hasLimitedPrecision or: [stepInteger hasLimitedPrecision]]) + ifTrue: [self limitedPrecisionSpecies] + ifFalse: [self]) basicNew - ^self basicNew setFrom: startInteger to: stopInteger by: stepInteger! Item was added: + ----- Method: Interval class>>initializedInstance (in category 'instance creation') ----- + initializedInstance + ^self newFrom: #()! Item was added: + ----- Method: Interval class>>limitedPrecisionSpecies (in category 'instance creation') ----- + limitedPrecisionSpecies + "Answer a class able to handle limited precision bounds or step" + + ^LimitedPrecisionInterval! Item was changed: ----- Method: Interval class>>newFrom: (in category 'instance creation') ----- newFrom: aCollection "Answer an instance of me containing the same elements as aCollection." | newInterval n | - (n := aCollection size) <= 1 ifTrue: [ n = 0 ifTrue: [^self from: 1 to: 0]. + ^self from: aCollection anyOne to: aCollection anyOne]. + newInterval := self + from: aCollection first + to: aCollection last + by: (aCollection last - aCollection first) / (n - 1). + (newInterval hasEqualElements: aCollection) + ifFalse: + [self error: 'The argument is not an arithmetic progression']. - ^self from: aCollection first to: aCollection last]. - newInterval := self from: aCollection first to: aCollection last - by: (aCollection last - aCollection first) // (n - 1). - aCollection ~= newInterval - ifTrue: [ - "Give a second chance, because progression might be arithmetic, but = answer false" - (newInterval hasEqualElements: aCollection) ifFalse: [ - self error: 'The argument is not an arithmetic progression']]. ^newInterval " Interval newFrom: {1. 2. 3} {33. 5. -23} as: Interval {33. 5. -22} as: Interval (an error) (-4 to: -12 by: -1) as: Interval #(2 4 6) asByteArray as: Interval. "! Item was added: + ----- Method: Interval>>, (in category 'adding') ----- + , otherCollection + "Override to answer an Interval if otherCollection is an adjacent and congruent interval." + ^(otherCollection isInterval + and: [otherCollection increment = step + and: [otherCollection first = (self last + step)]]) + ifTrue: [self class from: start to: otherCollection last by: step] + ifFalse: [super, otherCollection]! Item was changed: ----- Method: Interval>>= (in category 'comparing') ----- = anObject - ^ self == anObject + or: [anObject isInterval + ifFalse: [super = anObject] + ifTrue: + [start = anObject first + and: [step = anObject increment + and: [self last = anObject last]]]]! - ifTrue: [true] - ifFalse: [anObject isInterval - ifTrue: [start = anObject first - and: [step = anObject increment - and: [self last = anObject last]]] - ifFalse: [super = anObject]]! Item was added: + ----- Method: Interval>>copyFrom:to: (in category 'copying') ----- + copyFrom: startIndex to: stopIndex + (startIndex = 1 and: [stopIndex = self size]) ifTrue: [^self]. + stopIndex < startIndex ifTrue: [^self copyEmpty]. + ^(self at: startIndex) to: (self at: stopIndex) by: step! Item was changed: ----- Method: Interval>>do: (in category 'enumerating') ----- + do: aBlock + + | aValue | + aValue := start. + step < 0 + ifTrue: [[stop <= aValue] + whileTrue: + [aBlock value: aValue. + aValue := aValue + step]] + ifFalse: [[stop >= aValue] + whileTrue: + [aBlock value: aValue. + aValue := aValue + step]]! - do: aBlock - "Evaluate aBlock for each value of the interval. - Implementation note: instead of repeatedly incrementing the value - aValue := aValue + step. - until stop is reached, - We prefer to recompute value from start - aValue := start + (index * step). - This is better for floating points accuracy, while not degrading Integer and Fraction speed too much. - Moreover, this is consistent with methods #at: and #size" - - | aValue index size | - index := 0. - size := self size. - [index < size] - whileTrue: [aValue := start + (index * step). - index := index + 1. - aBlock value: aValue]! Item was changed: ----- Method: Interval>>hash (in category 'comparing') ----- hash "Hash is reimplemented because = is implemented." + ^((start hash hashMultiply bitXor: self last hash) hashMultiply + bitXor: self size)! - - ^(((start hash bitShift: 2) - bitOr: stop hash) - bitShift: 1) - bitOr: self size! Item was added: + ----- Method: Interval>>indexOf:startingAt: (in category 'accessing') ----- + indexOf: anElement startingAt: startIndex + "startIndex is an positive integer, the collection index where the search is started." + + | index | + index := (anElement - start / step) rounded + 1. + (index between: startIndex and: self size) ifFalse: [ ^0 ]. + (self at: index) = anElement ifFalse: [ ^0 ]. + ^index! Item was removed: - ----- Method: Interval>>indexOf:startingAt:ifAbsent: (in category 'accessing') ----- - indexOf: anElement startingAt: startIndex ifAbsent: exceptionBlock - "startIndex is an positive integer, the collection index where the search is started." - "during the computation of val , floats are only used when the receiver contains floats" - - | index val | - (self rangeIncludes: anElement) - ifFalse: [^ exceptionBlock value]. - val := anElement - self first / self increment. - val isFloat - ifTrue: [(val - val rounded) abs * 100000000 < 1 - ifTrue: [index := val rounded + 1] - ifFalse: [^ exceptionBlock value]] - ifFalse: [val isInteger - ifTrue: [index := val + 1] - ifFalse: [^ exceptionBlock value]]. - "finally, the value of startIndex comes into play:" - ^ (index between: startIndex and: self size) - ifTrue: [index] - ifFalse: [exceptionBlock value]! Item was added: + ----- Method: Interval>>isEmpty (in category 'testing') ----- + isEmpty + ^self size = 0! Item was removed: - ----- Method: Interval>>remove: (in category 'removing') ----- - remove: newObject - "Removing from an Interval is not allowed." - - self error: 'elements cannot be removed from an Interval'! Item was changed: ----- Method: Interval>>reverseDo: (in category 'enumerating') ----- reverseDo: aBlock + "Evaluate aBlock for each element of my interval, in reverse order." + | aValue | + aValue := self last. + step < 0 + ifTrue: [[start >= aValue] + whileTrue: [aBlock value: aValue. + aValue := aValue - step]] + ifFalse: [[start <= aValue] + whileTrue: [aBlock value: aValue. + aValue := aValue - step]]! - "Evaluate aBlock for each element of my interval, in reverse order. - Implementation notes: see do: for an explanation on loop detail" - - | aValue index | - index := self size. - [index > 0] - whileTrue: [ - index := index - 1. - aValue := start + (index * step). - aBlock value: aValue]! Item was added: + ----- Method: Interval>>reversed (in category 'converting') ----- + reversed + self isEmpty ifTrue: [^stop to: start by: step negated]. + ^self last to: start by: step negated! Item was added: + ----- Method: Interval>>sorted (in category 'sorting') ----- + sorted + "an Interval is already sorted" + step < 0 ifTrue: [^self reversed]. + ^self! Item was added: + ----- Method: Interval>>start (in category 'accessing') ----- + start + ^ start! Item was added: + ----- Method: Interval>>stop (in category 'accessing') ----- + stop + ^ stop! Item was changed: ----- Method: KeyNotFound>>messageText (in category 'accessing') ----- messageText + + ^ messageText ifNil: ['Key not found: {1}' translated format: {self key}]! - "Return a textual description of the exception." - ^messageText ifNil:['Key not found: ', key]! Item was changed: ----- Method: KeyedIdentitySet>>scanFor: (in category 'private') ----- scanFor: anObject "Scan the key array for the first slot containing either a nil (indicating an empty slot) or an element that matches anObject. Answer the index of that slot or raise an error if no slot is found. This method will be overridden in various subclasses that have different interpretations for matching elements." + | index start size | + index := start := anObject scaledIdentityHash \\ (size := array size) + 1. - | index start | - index := start := anObject scaledIdentityHash \\ array size + 1. [ | element | ((element := array at: index) == nil or: [ (keyBlock value: element enclosedSetElement) == anObject ]) ifTrue: [ ^index ]. + (index := index \\ size + 1) = start ] whileFalse. - (index := index \\ array size + 1) = start ] whileFalse. self errorNoFreeSpace! Item was changed: ----- Method: KeyedIdentitySet>>scanForEmptySlotFor: (in category 'private') ----- scanForEmptySlotFor: anObject "Scan the key array for the first slot containing an empty slot (indicated by a nil). Answer the index of that slot. This method will be overridden in various subclasses that have different interpretations for matching elements." + | index start size | + index := start := anObject scaledIdentityHash \\ (size := array size) + 1. - | index start | - index := start := anObject scaledIdentityHash \\ array size + 1. [ (array at: index) ifNil: [ ^index ]. + (index := index \\ size + 1) = start ] whileFalse. - (index := index \\ array size + 1) = start ] whileFalse. self errorNoFreeSpace! Item was changed: ----- Method: KeyedSet>>at:ifPresent: (in category 'accessing') ----- at: key ifPresent: aBlock "Lookup the given key in the receiver. If it is present, answer the value of evaluating the given block with the value associated with the key. Otherwise, answer nil." + ^(array at: (self scanFor: key)) ifNotNil: [:obj| aBlock value: obj enclosedSetElement]! - | v | - v := self at: key ifAbsent: [^ nil]. - ^ aBlock value: v - ! Item was added: + ----- Method: KeyedSet>>at:ifPresent:ifAbsent: (in category 'accessing') ----- + at: key ifPresent: oneArgBlock ifAbsent: absentBlock + "Lookup the given key in the receiver. If it is present, answer the + value of evaluating the oneArgBlock with the value associated + with the key, otherwise answer the value of absentBlock." + + ^(array at: (self scanFor: key)) + ifNil: [ absentBlock value ] + ifNotNil: [ :value | oneArgBlock value: value enclosedSetElement ]! Item was changed: ----- Method: KeyedSet>>includesKey: (in category 'testing') ----- includesKey: key + (array at: (self scanFor: key)) ifNil: [ ^false ] ifNotNil: [ ^true ]! - ^ (array at: (self scanFor: key)) notNil! Item was removed: - ----- Method: KeyedSet>>noCheckAdd: (in category 'private') ----- - noCheckAdd: anObject - - self deprecated: 'This method should not be used anymore.'. - array at: (self scanFor: (keyBlock value: anObject)) put: anObject asSetElement. - tally := tally + 1! Item was added: + ----- Method: KeyedSet>>put: (in category 'accessing') ----- + put: newObject + "Include newObject as one of the receiver's elements even if there is already an element with the same key. Answer the replaced SetElement object or nil if no element existed with newObject's key. This method's behavior is similar to Dictionary >> #at:put:'s, hence the name." + + | index | + index := self scanFor: (keyBlock value: newObject). + (array at: index) + ifNil: [ + self atNewIndex: index put: newObject asSetElement. + ^nil ] + ifNotNil: [ :oldObject | + array at: index put: newObject asSetElement. + ^oldObject ]! Item was changed: ----- Method: KeyedSet>>remove:ifAbsent: (in category 'removing') ----- remove: oldObject ifAbsent: aBlock | index | index := self scanFor: (keyBlock value: oldObject). + (array at: index) ifNil: [ ^ aBlock value ]. + tally := tally - 1. "Update tally first, so that read-only hashed collections raise an error before modifying array." - (array at: index) == nil ifTrue: [ ^ aBlock value ]. array at: index put: nil. - tally := tally - 1. self fixCollisionsFrom: index. ^ oldObject! Item was changed: ----- Method: KeyedSet>>removeKey:ifAbsent: (in category 'removing') ----- removeKey: key ifAbsent: aBlock | index obj | index := self scanFor: key. + obj := (array at: index) ifNil: [ ^ aBlock value ]. + tally := tally - 1. "Update tally first, so that read-only hashed collections raise an error before modifying array." - (obj := array at: index) == nil ifTrue: [ ^ aBlock value ]. array at: index put: nil. - tally := tally - 1. self fixCollisionsFrom: index. ^ obj enclosedSetElement! Item was changed: ----- Method: KeyedSet>>scanFor: (in category 'private') ----- scanFor: anObject "Scan the key array for the first slot containing either a nil (indicating an empty slot) or an element that matches anObject. Answer the index of that slot or raise an error if no slot is found. This method will be overridden in various subclasses that have different interpretations for matching elements." + | index start size | + index := start := anObject hash \\ (size := array size) + 1. - | index start | - index := start := anObject hash \\ array size + 1. [ | element | ((element := array at: index) == nil or: [ (keyBlock value: element enclosedSetElement) = anObject ]) ifTrue: [ ^index ]. + (index := index \\ size + 1) = start ] whileFalse. - (index := index \\ array size + 1) = start ] whileFalse. self errorNoFreeSpace! Item was added: + CharacterSet subclass: #LazyCharacterSet + instanceVariableNames: 'block' + classVariableNames: '' + poolDictionaries: '' + category: 'Collections-Support'! + + !LazyCharacterSet commentStamp: 'nice 2/12/2019 22:36' prior: 0! + A LazyCharacterSet is a kind of CharacterSet which does not know in advance which Character it contains or not. + If will lazily evaluate a block on demand if ever one ask whether it includes: a character. + It is not feasible to enumerate a LazyCharacterSet, because there are way too many characters. + + Instance Variables + block: <BlockContext | Symbol> + byteArrayMapCache: <ByteArray | nil> + + block + - a valuable, answering either true or false when sent the message value: - true means that this set includes the character passed as value: argument. + + byteArrayMapCache + - a cache holding 0 or 1 for the first 256 character codes - 0 meaning not included, 1 included. This is used in some primitives + ! Item was added: + ----- Method: LazyCharacterSet class>>including: (in category 'instance creation') ----- + including: aBlock + "Create the set of Character for which aBlock evaluates to true" + ^self new block: aBlock! Item was added: + ----- Method: LazyCharacterSet>>add: (in category 'adding') ----- + add: aCharacter + | oldBlock | + oldBlock := block. + block := [:c | c = aCharacter or: [oldBlock value: c]]. + ^aCharacter! Item was added: + ----- Method: LazyCharacterSet>>addAll: (in category 'adding') ----- + addAll: aCollection + | oldBlock | + oldBlock := block. + block := [:c | (aCollection includes: c) or: [oldBlock value: c]]. + ^aCollection! Item was added: + ----- Method: LazyCharacterSet>>block (in category 'accessing') ----- + block + ^block! Item was added: + ----- Method: LazyCharacterSet>>block: (in category 'accessing') ----- + block: aValuable + "Set the block used to determine if I include a Character or not. + aValuable is an object that shoud answer true or false when sent value:" + + byteArrayMap := nil. + block := aValuable! Item was added: + ----- Method: LazyCharacterSet>>canBeEnumerated (in category 'testing') ----- + canBeEnumerated + ^false! Item was added: + ----- Method: LazyCharacterSet>>do: (in category 'enumerating') ----- + do: aBlock + "evaluate aBlock with each character in the set. + don't do it, there are too many loop..." + + self shouldNotImplement! Item was added: + ----- Method: LazyCharacterSet>>enumerationCost (in category 'private') ----- + enumerationCost + "The maximum cost. I can't even do: loops, it's too expensive." + + ^100! Item was added: + ----- Method: LazyCharacterSet>>includes: (in category 'testing') ----- + includes: aCharacter + ^block value: aCharacter! Item was added: + ----- Method: LazyCharacterSet>>includesCode: (in category 'testing') ----- + includesCode: anInteger + ^block value: (Character value: anInteger)! Item was added: + ----- Method: LazyCharacterSet>>intersection: (in category 'enumerating') ----- + intersection: aCollection + ^((self isCharacters: aCollection) + ifTrue: [aCollection select: block] + ifFalse: + ["protect feeding block with non character" + aCollection select: [:e |e isCharacter and: [block value: e]]]) as: CharacterSet + ! Item was added: + ----- Method: LazyCharacterSet>>printElementsOn: (in category 'printing') ----- + printElementsOn: aString + "Do nothing,elements cannot be directly enumerated"! Item was added: + ----- Method: LazyCharacterSet>>reject: (in category 'enumerating') ----- + reject: aBlock + ^self class including: [:char | (aBlock value: char) not and: [block value: char]]! Item was added: + ----- Method: LazyCharacterSet>>remove: (in category 'removing') ----- + remove: aCharacter + | oldBlock | + oldBlock := block. + block := [:c | (c = aCharacter) not and: [oldBlock value: c]]. + ^aCharacter! Item was added: + ----- Method: LazyCharacterSet>>remove:ifAbsent: (in category 'removing') ----- + remove: aCharacter ifAbsent: aBlock + (self includes: aCharacter) ifFalse: [^aBlock value]. + ^self remove: aCharacter! Item was added: + ----- Method: LazyCharacterSet>>removeAll: (in category 'removing') ----- + removeAll: aCollection + | oldBlock | + oldBlock := block. + block := [:c | (aCollection includes: c) not and: [oldBlock value: c]]. + ^aCollection! Item was added: + ----- Method: LazyCharacterSet>>select: (in category 'enumerating') ----- + select: aBlock + ^self class including: [:char | (block value: char) and: [aBlock value: char]]! Item was added: + ----- Method: LazyCharacterSet>>union: (in category 'enumerating') ----- + union: aCollection + (self isCharacters: aCollection) ifFalse: [^super union: aCollection]. + ^self class including: [:c | (aCollection includes: c) or: [block value: c]]! Item was added: + Interval subclass: #LimitedPrecisionInterval + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Collections-Sequenceable'! + + !LimitedPrecisionInterval commentStamp: 'nice 3/3/2021 01:47' prior: 0! + A LimitedPrecisionInterval is an Interval whose bounds or step haveLimitedPrecision. + Due to inexact arithmetic, special precautions must be taken in the implementation, + in order to avoid unconsistent and surprising behavior as much as possible. + + Despite those efforts, LimitedPrecisionInterval is full of pitfalls. + It is recommended to avoid using LimitedPrecisionInterval unless understanding those pitfalls. + For example, (0.2 to: 0.6 by: 0.1) last = 0.5. + This interval does not includes 0.6 because (0.1*4+0.2) is slightly greater than 0.6. + Another example is that (0.2 to: 0.6 by: 0.1) does not include 0.3 but a Float slightly greater. + + A usual workaround is to use an Integer interval, and reconstruct the Float inside the loop. + For example: + (0 to: 4) collect: [:i | 0.1*i+0.2]. + or better if we want to have 0.3 and 0.6: + (2 to: 6) collect: [:i | i / 10.0]. + Another workaround is to not use limited precision at all, but Fraction or ScaledDecimal when possible: + (1/10 to: 7/10 by: 1/10). + (0.1s to: 0.7s by: 0.1s). + + Yet another pitfall is that optimized to:by:do: might differ from (to:by:) do: + In the former case, repeated addition of increment is used, in the later, a multiplication is used. + Observe the differences: + Array streamContents: [:str | 0 to: 3 by: 0.3 do: [:e | str nextPut: e]]. + Array streamContents: [:str | (0 to: 3 by: 0.3) do: [:e | str nextPut: e]]. + + There are many more discrepancies, so use carefully, or not use it at all.! Item was added: + ----- Method: LimitedPrecisionInterval>>collect: (in category 'enumerating') ----- + collect: aBlock + "Evaluate aBlock with each of the receiver's elements as the argument. + Collect the resulting values into a collection like the receiver. Answer + the new collection. + Implementation notes: see do: for an explanation on loop detail" + | result | + result := self species new: self size. + 1 to: result size do: + [:i | + "(self at: i) is inlined here to avoid repeated bound checking" + result at: i put: (aBlock value: i - 1 * step + start)]. + ^ result! Item was added: + ----- Method: LimitedPrecisionInterval>>copyFrom:to: (in category 'copying') ----- + copyFrom: startIndex to: stopIndex + startIndex = 1 ifTrue: [^super copyFrom: startIndex to: stopIndex]. + stopIndex < startIndex ifTrue: [^self copyEmpty]. + ^Array new: stopIndex - startIndex + 1 streamContents: [:stream | + startIndex to: stopIndex do: [:i | stream nextPut: (self at: i)]]! Item was added: + ----- Method: LimitedPrecisionInterval>>do: (in category 'enumerating') ----- + do: aBlock + "Evaluate aBlock for each value of the interval. + Implementation note: instead of repeatedly incrementing the value + aValue := aValue + step. + until stop is reached, + We prefer to recompute value from start + aValue := start + (index * step). + This is better for floating points accuracy, while not degrading Integer and Fraction speed too much. + Moreover, this is consistent with methods #at: and #size" + + | aValue index size | + index := 0. + size := self size. + [index < size] + whileTrue: [aValue := start + (index * step). + index := index + 1. + aBlock value: aValue]! Item was added: + ----- Method: LimitedPrecisionInterval>>last (in category 'accessing') ----- + last + "Refer to the comment in SequenceableCollection|last." + + ^start + (step * (self size - 1))! Item was added: + ----- Method: LimitedPrecisionInterval>>reverseDo: (in category 'enumerating') ----- + reverseDo: aBlock + "Evaluate aBlock for each element of my interval, in reverse order. + Implementation notes: see do: for an explanation on loop detail" + + | aValue index | + index := self size. + [index > 0] + whileTrue: [ + index := index - 1. + aValue := start + (index * step). + aBlock value: aValue]! Item was added: + ----- Method: LimitedPrecisionInterval>>reversed (in category 'converting') ----- + reversed + "There is no guaranty that super reversed would contain same elements. + Answer an Array instead" + + ^Array new: self size streamContents: [:stream | self reverseDo: [:each | stream nextPut: each]]! Item was added: + ----- Method: LimitedPrecisionInterval>>size (in category 'accessing') ----- + size + "Answer how many elements the receiver contains." + + | candidateSize | + candidateSize := (stop - start / step max: 0) rounded. + step > 0 + ifTrue: [candidateSize * step + start <= stop ifTrue: [^candidateSize + 1]] + ifFalse: [candidateSize * step + start >= stop ifTrue: [^candidateSize + 1]]. + ^candidateSize! Item was added: + ----- Method: LimitedWriteStream>>next:putAll:startingAt: (in category 'writing') ----- + next: anInteger putAll: aCollection startingAt: startIndex + "Store the next anInteger elements from the given collection." + + | newEnd | + anInteger > 0 ifFalse: [ ^aCollection ]. + + newEnd := position + anInteger. + newEnd > limit ifTrue: [ + super next: (limit - position max: 0) putAll: aCollection startingAt: startIndex. + limitBlock value. + ^ aCollection]. + + ^ super next: anInteger putAll: aCollection startingAt: startIndex! Item was changed: + ----- Method: LimitedWriteStream>>nextPutAll: (in category 'writing') ----- - ----- Method: LimitedWriteStream>>nextPutAll: (in category 'as yet unclassified') ----- nextPutAll: aCollection | newEnd | collection class == aCollection class ifFalse: [^ super nextPutAll: aCollection ]. newEnd := position + aCollection size. newEnd > limit ifTrue: [ super nextPutAll: (aCollection copyFrom: 1 to: (limit - position max: 0)). limitBlock value. ^aCollection ]. newEnd > writeLimit ifTrue: [ + self growTo: newEnd - self growTo: newEnd + 10 ]. collection replaceFrom: position+1 to: newEnd with: aCollection startingAt: 1. position := newEnd. ^aCollection! Item was changed: + ----- Method: LimitedWriteStream>>pastEndPut: (in category 'private') ----- - ----- Method: LimitedWriteStream>>pastEndPut: (in category 'as yet unclassified') ----- pastEndPut: anObject collection size >= limit ifTrue: [limitBlock value]. "Exceptional return" ^ super pastEndPut: anObject! Item was changed: + ----- Method: LimitedWriteStream>>setLimit:limitBlock: (in category 'initialize-release') ----- - ----- Method: LimitedWriteStream>>setLimit:limitBlock: (in category 'as yet unclassified') ----- setLimit: sizeLimit limitBlock: aBlock "Limit the numer of elements this stream will write..." limit := sizeLimit. "Execute this (typically ^ contents) when that limit is exceded" limitBlock := aBlock! Item was changed: ----- Method: LimitingLineStreamWrapper>>next (in category 'accessing') ----- next "Provide character-based access" + position ifNil: [ ^nil ]. - position isNil ifTrue: [^nil]. position < line size ifTrue: [^line at: (position := position + 1)]. line := stream nextLine. self updatePosition. ^ Character cr! Item was added: + ----- Method: Link>>asLink (in category 'converting') ----- + asLink + + ^ self! Item was changed: ----- Method: Link>>nextLink (in category 'accessing') ----- nextLink - "Answer the link to which the receiver points." + ^ nextLink! - ^nextLink! Item was changed: ----- Method: Link>>nextLink: (in category 'accessing') ----- nextLink: aLink "Store the argument, aLink, as the link to which the receiver refers. Answer aLink." + ^ nextLink := aLink! - ^nextLink := aLink! Item was changed: SequenceableCollection subclass: #LinkedList instanceVariableNames: 'firstLink lastLink' classVariableNames: '' poolDictionaries: '' category: 'Collections-Sequenceable'! + !LinkedList commentStamp: 'topa 12/6/2016 14:17' prior: 0! + I represent a collection of links, which are containers for other objects. Using the message sequence addFirst:/removeLast causes the receiver to behave as a stack; using addLast:/removeFirst causes the receiver to behave as a queue. + + If you attempt to add any object into a LinkedList that is not a Link, it will automatically be wrapped by a ValueLink. A LinkedList therefore behaves very much like any collection, except that certain calls such as atIndex: are linear rather than constant time.! - !LinkedList commentStamp: '<historical>' prior: 0! - I represent a collection of links, which are containers for other objects. Using the message sequence addFirst:/removeLast causes the receiver to behave as a stack; using addLast:/removeFirst causes the receiver to behave as a queue.! Item was added: + ----- Method: LinkedList class>>new: (in category 'instance creation') ----- + new: anInt + "LinkedList don't need capacity" + ^self new! Item was added: + ----- Method: LinkedList class>>new:streamContents: (in category 'stream creation') ----- + new: size streamContents: aBlock + ^ self withAll: (super new: size streamContents: aBlock)! Item was added: + ----- Method: LinkedList class>>newFrom: (in category 'instance creation') ----- + newFrom: aCollection + "Answer an instance with same elements as aCollection." + ^self new + addAll: aCollection; + yourself! Item was changed: ----- Method: LinkedList>>add: (in category 'adding') ----- + add: aLinkOrObject - add: aLink "Add aLink to the end of the receiver's list. Answer aLink." + ^self addLast: aLinkOrObject! - ^self addLast: aLink! Item was changed: ----- Method: LinkedList>>add:after: (in category 'adding') ----- + add: link after: otherLinkOrObject - add: link after: otherLink - "Add otherLink after link in the list. Answer aLink." + | otherLink | + otherLink := self linkAt: (self indexOf: otherLinkOrObject). + ^ self add: link afterLink: otherLink! - | savedLink | - lastLink == otherLink ifTrue: [^ self addLast: link]. - savedLink := otherLink nextLink. - otherLink nextLink: link. - link nextLink: savedLink. - ^link.! Item was added: + ----- Method: LinkedList>>add:afterLink: (in category 'adding') ----- + add: aLinkOrObject afterLink: otherLink + + "Add otherLink after link in the list. Answer aLink." + + | savedLink aLink | + lastLink == otherLink ifTrue: [^ self addLast: aLinkOrObject]. + savedLink := otherLink nextLink. + aLink := aLinkOrObject asLink. + otherLink nextLink: aLink. + aLink nextLink: savedLink. + ^aLink.! Item was changed: ----- Method: LinkedList>>add:before: (in category 'adding') ----- + add: link before: otherLinkOrObject + "Add otherLink after link in the list. Answer aLink." - add: link before: otherLink + | otherLink | + otherLink := self linkAt: (self indexOf: otherLinkOrObject). + ^ self add: link beforeLink: otherLink! - | aLink | - firstLink == otherLink ifTrue: [^ self addFirst: link]. - aLink := firstLink. - [aLink == nil] whileFalse: [ - aLink nextLink == otherLink ifTrue: [ - link nextLink: aLink nextLink. - aLink nextLink: link. - ^ link - ]. - aLink := aLink nextLink. - ]. - ^ self errorNotFound: otherLink! Item was added: + ----- Method: LinkedList>>add:beforeLink: (in category 'adding') ----- + add: aLinkOrObject beforeLink: otherLink + + | currentLink| + + firstLink == otherLink ifTrue: [^ self addFirst: aLinkOrObject]. + + currentLink := firstLink. + [currentLink == nil] whileFalse: [ + currentLink nextLink == otherLink ifTrue: [ + | aLink | + aLink := aLinkOrObject asLink. + aLink nextLink: currentLink nextLink. + currentLink nextLink: aLink. + ^ aLink + ]. + currentLink := currentLink nextLink. + ]. + ^ self errorNotFound: otherLink! Item was changed: ----- Method: LinkedList>>addFirst: (in category 'adding') ----- + addFirst: aLinkOrObject - addFirst: aLink "Add aLink to the beginning of the receiver's list. Answer aLink." + |aLink| + aLink := aLinkOrObject asLink. - self isEmpty ifTrue: [lastLink := aLink]. aLink nextLink: firstLink. firstLink := aLink. ^aLink! Item was changed: ----- Method: LinkedList>>addLast: (in category 'adding') ----- + addLast: aLinkOrObject - addLast: aLink "Add aLink to the end of the receiver's list. Answer aLink." + |aLink| + aLink := aLinkOrObject asLink. - self isEmpty ifTrue: [firstLink := aLink] ifFalse: [lastLink nextLink: aLink]. lastLink := aLink. ^aLink! Item was changed: ----- Method: LinkedList>>at: (in category 'accessing') ----- at: index + ^(self linkAt: index) value! - | i | - i := 0. - self do: [:link | - (i := i + 1) = index ifTrue: [^ link]]. - ^ self errorSubscriptBounds: index! Item was added: + ----- Method: LinkedList>>at:put: (in category 'accessing') ----- + at: index put: anObject + + ^self at: index putLink: (self linkOf: anObject ifAbsent: [anObject asLink])! Item was added: + ----- Method: LinkedList>>at:putLink: (in category 'accessing') ----- + at: index putLink: aLink + | previousLink nextLink | + "Please don't put a link which is already in the list, or you will create an infinite loop" + (self validIndex: index) ifFalse: [^ self errorOutOfBounds]. + + index = 1 ifTrue: [ + aLink nextLink: self firstLink nextLink. + firstLink := aLink. + aLink nextLink ifNil: [lastLink := aLink]. + ^ aLink]. + + previousLink := self linkAt: index - 1. + nextLink := previousLink nextLink nextLink. + + nextLink + ifNil: [aLink nextLink: self lastLink] + ifNotNil: [:link |aLink nextLink: link]. + + previousLink nextLink: aLink. + + nextLink ifNil: [ + lastLink := aLink. + aLink nextLink: nil]. + + ^ aLink! Item was added: + ----- Method: LinkedList>>collect: (in category 'enumerating') ----- + collect: aBlock + "Evaluate aBlock with each of the receiver's elements as the argument. + Collect the resulting values into a collection like the receiver. Answer + the new collection." + + | aLink newCollection | + newCollection := self class new. + aLink := firstLink. + [aLink == nil] whileFalse: + [newCollection add: (aBlock value: aLink value). + aLink := aLink nextLink]. + ^ newCollection! Item was added: + ----- Method: LinkedList>>collect:thenSelect: (in category 'enumerating') ----- + collect: collectBlock thenSelect: selectBlock + "Optimized version of SequenceableCollection>>#collect:#thenSelect:" + + | newCollection newElement | + newCollection := self class new. + self + do: [ :each | + newElement := collectBlock value: each. + (selectBlock value: newElement) + ifTrue: [ newCollection add: newElement ] ]. + ^ newCollection! Item was added: + ----- Method: LinkedList>>copyWith: (in category 'copying') ----- + copyWith: newElement + ^self copy add: newElement; yourself! Item was added: + ----- Method: LinkedList>>copyWithout: (in category 'copying') ----- + copyWithout: oldElement + |newInst| + newInst := self class new. + self do: [:each | each = oldElement ifFalse: [newInst add: each]]. + ^newInst! Item was changed: ----- Method: LinkedList>>do: (in category 'enumerating') ----- do: aBlock | aLink | aLink := firstLink. [aLink == nil] whileFalse: + [aBlock value: aLink value. - [aBlock value: aLink. aLink := aLink nextLink]! Item was changed: ----- Method: LinkedList>>first (in category 'accessing') ----- first "Answer the first link. Create an error notification if the receiver is empty." + ^ self firstLink value! - self emptyCheck. - ^firstLink! Item was added: + ----- Method: LinkedList>>firstLink (in category 'accessing') ----- + firstLink + "Answer the first link. Create an error notification if the receiver is + empty." + + self emptyCheck. + ^firstLink! Item was added: + ----- Method: LinkedList>>indexOf:startingAt: (in category 'private') ----- + 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 the result of evaluating the argument, exceptionBlock." + + |currentLink index| + currentLink := self linkAt: start ifAbsent: [nil]. + index := start. + [ currentLink == nil ] + whileFalse: [currentLink value = anElement value ifTrue: [^index]. + currentLink := currentLink nextLink. + index := index +1]. + ^0! Item was changed: ----- Method: LinkedList>>isEmpty (in category 'testing') ----- isEmpty + ^ firstLink isNil! - ^firstLink == nil! Item was changed: ----- Method: LinkedList>>last (in category 'accessing') ----- last "Answer the last link. Create an error notification if the receiver is empty." + + ^self lastLink value! - self emptyCheck. - ^lastLink! Item was added: + ----- Method: LinkedList>>lastLink (in category 'accessing') ----- + lastLink + "Answer the last link. Create an error notification if the receiver is + empty." + + self emptyCheck. + ^lastLink! Item was added: + ----- Method: LinkedList>>linkAt: (in category 'private') ----- + linkAt: index + + ^self linkAt: index ifAbsent: [ self errorSubscriptBounds: index]! Item was added: + ----- Method: LinkedList>>linkAt:ifAbsent: (in category 'private') ----- + linkAt: index ifAbsent: errorBlock + + | i | + i := 0. + self linksDo: [:link | (i := i + 1) = index ifTrue: [^ link]]. + ^ errorBlock value! Item was added: + ----- Method: LinkedList>>linkOf: (in category 'private') ----- + linkOf: anObject + + ^ self + linkOf: anObject + ifAbsent: [self error: 'No such element']! Item was added: + ----- Method: LinkedList>>linkOf:ifAbsent: (in category 'private') ----- + linkOf: anObject ifAbsent: errorBlock + + self linksDo: [:link | link value = anObject value ifTrue: [^ link]]. + ^ errorBlock value! Item was added: + ----- Method: LinkedList>>linksDo: (in category 'enumerating') ----- + linksDo: aBlock + + | aLink | + aLink := firstLink. + [aLink == nil] whileFalse: + [aBlock value: aLink. + aLink := aLink nextLink]! Item was changed: ----- Method: LinkedList>>postCopy (in category 'copying') ----- postCopy | aLink | super postCopy. + firstLink ifNotNil: [ - firstLink isNil ifFalse: [ aLink := firstLink := firstLink copy. [aLink nextLink isNil] whileFalse: [aLink nextLink: (aLink := aLink nextLink copy)]. lastLink := aLink].! Item was changed: ----- Method: LinkedList>>remove:ifAbsent: (in category 'removing') ----- + remove: aLinkOrObject ifAbsent: aBlock + "Remove aLink from the receiver. If it is not there, answer the result of evaluating aBlock." + + | link | + link := self linkOf: aLinkOrObject ifAbsent: [^aBlock value]. + self removeLink: link ifAbsent: [^aBlock value]. + ^aLinkOrObject! - remove: aLink ifAbsent: aBlock - "Remove aLink from the receiver. If it is not there, answer the result of - evaluating aBlock." - - | tempLink | - aLink == firstLink - ifTrue: [firstLink := aLink nextLink. - aLink == lastLink - ifTrue: [lastLink := nil]] - ifFalse: [tempLink := firstLink. - [tempLink == nil ifTrue: [^aBlock value]. - tempLink nextLink == aLink] - whileFalse: [tempLink := tempLink nextLink]. - tempLink nextLink: aLink nextLink. - aLink == lastLink - ifTrue: [lastLink := tempLink]]. - aLink nextLink: nil. - ^aLink! Item was added: + ----- Method: LinkedList>>removeAllSuchThat: (in category 'removing') ----- + removeAllSuchThat: aBlock + "Evaluate aBlock for each element and remove all that elements from + the receiver for that aBlock evaluates to true. For LinkedLists, it's safe to use do:." + + self do: [:each | (aBlock value: each) ifTrue: [self remove: each]]! Item was changed: ----- Method: LinkedList>>removeFirst (in category 'removing') ----- removeFirst "Remove the first element and answer it. If the receiver is empty, create an error notification." | oldLink | self emptyCheck. oldLink := firstLink. firstLink == lastLink ifTrue: [firstLink := nil. lastLink := nil] ifFalse: [firstLink := oldLink nextLink]. oldLink nextLink: nil. + ^oldLink value! - ^oldLink! Item was changed: ----- Method: LinkedList>>removeLast (in category 'removing') ----- removeLast "Remove the receiver's last element and answer it. If the receiver is empty, create an error notification." | oldLink aLink | self emptyCheck. oldLink := lastLink. firstLink == lastLink ifTrue: [firstLink := nil. lastLink := nil] ifFalse: [aLink := firstLink. [aLink nextLink == oldLink] whileFalse: [aLink := aLink nextLink]. aLink nextLink: nil. lastLink := aLink]. oldLink nextLink: nil. + ^oldLink value! - ^oldLink! Item was added: + ----- Method: LinkedList>>removeLink: (in category 'removing') ----- + removeLink: aLink + ^self removeLink: aLink ifAbsent: [self error: 'no such method!!']! Item was added: + ----- Method: LinkedList>>removeLink:ifAbsent: (in category 'removing') ----- + removeLink: aLink ifAbsent: aBlock + "Remove aLink from the receiver. If it is not there, answer the result of + evaluating aBlock." + + | tempLink | + aLink == firstLink + ifTrue: [firstLink := aLink nextLink. + aLink == lastLink + ifTrue: [lastLink := nil]] + ifFalse: [tempLink := firstLink. + [tempLink ifNil: [ ^ aBlock value ]. + tempLink nextLink == aLink] + whileFalse: [tempLink := tempLink nextLink]. + tempLink nextLink: aLink nextLink. + aLink == lastLink + ifTrue: [lastLink := tempLink]]. + "Not nilling the link enables us to delete while iterating" + "aLink nextLink: nil." + ^aLink! Item was added: + ----- Method: LinkedList>>select: (in category 'enumerating') ----- + select: aBlock + "Reimplemennt #select: for speedup on linked lists. + The super implemention accesses the linkes by index, thus causing an O(n^2)" + + | newCollection | + newCollection := self class new. + self do: [:each | (aBlock value: each) ifTrue: [newCollection add: each]]. + ^newCollection! Item was added: + ----- Method: LinkedList>>select:thenCollect: (in category 'enumerating') ----- + select: selectBlock thenCollect: collectBlock + "Optimized version of SequenceableCollection>>#select:thenCollect:" + + | newCollection | + newCollection := self class new. + self do: [ :each | (selectBlock value: each) ifTrue: [newCollection add: (collectBlock value: each)]]. + ^ newCollection! Item was added: + ----- Method: LinkedList>>swap:with: (in category 'accessing') ----- + swap: ix1 with: ix2 + "Reimplemented, super would create an infinite loop" + | minIx maxIx link1Prev link2Prev link1 link2 link1Next link2Next newLink2Next | + ((self validIndex: ix1) and: [self validIndex: ix2]) ifFalse: [^ self errorOutOfBounds]. + + "Get edge case out of the way" + ix1 = ix2 ifTrue: [^ self ]. + + "Sort indexes to make boundary-checks easier" + minIx := ix1 min: ix2. + maxIx := ix2 max: ix1. + + link1Prev := (minIx = 1) ifFalse: [self linkAt: minIx -1]. + link1 := link1Prev ifNotNil: [ link1Prev nextLink] + ifNil: [self linkAt: minIx]. + link1Next := link1 nextLink. + link2Prev := self linkAt: maxIx -1. + link2 := link2Prev nextLink. + link2Next := link2 nextLink. + + "Link at start being swapped" + link1 = firstLink ifTrue: [firstLink := link2.] ifFalse: [link1Prev nextLink: link2]. + "Link at end being swapped" + link2 = lastLink ifTrue: [lastLink := link1] ifFalse: []. + "Links being swapped adjacent" + newLink2Next := (link1 nextLink = link2) ifTrue: [link1] ifFalse: [link2Prev nextLink: link1. + link1Next]. + link1 nextLink: link2Next. + link2 nextLink: newLink2Next. + ! Item was added: + ----- Method: LinkedList>>validIndex: (in category 'private') ----- + validIndex: index + + ^ index > 0 and: [index <= self size]! Item was added: + ----- Method: LookupKey>>allLiteralsDo: (in category 'literals') ----- + allLiteralsDo: aBlock + "Treat myself or my key as literal. Do not treat any value (i.e., in Association or Binding) as literal to avoid decending too thoroughly. As a consequence, for example, classes have to be resolved to their class bindings or class names before using them as input in this interface." + + aBlock value: self. + self key allLiteralsDo: aBlock.! Item was added: + ----- Method: LookupKey>>literalEqual: (in category 'literals') ----- + literalEqual: otherLiteral + "Answer true if the receiver and otherLiteral represent the same literal. + + By default, all lookup keys (such as variable bindings) are literally equal only if identical. This is how variable sharing works, by preserving identity and changing only the value. + + Override if you want to be more flexible such as in class bindings." + + ^ self == otherLiteral! Item was changed: ----- Method: LookupKey>>recompileBindingsAnnouncing: (in category 'bindings') ----- recompileBindingsAnnouncing: aBool + "Recompile all references to the receiver. If the argument is true then put up a progress bar while doing so." - "Make the receiver (a global read-write binding) be a read-only binding" aBool ifTrue: + [Project uiManager informUserDuring: + [:bar | + (self systemNavigation allCallsOn: self) do: + [:mref | + bar value: ('Recompiling {1}' translated format: {mref asStringOrText}). + mref actualClass recompile: mref methodSymbol]]] - [UIManager default informUserDuring: - [:bar | - (self systemNavigation allCallsOn: self) do: - [:mref | - bar value: 'Recompiling ' , mref asStringOrText. - mref actualClass recompile: mref methodSymbol]]] ifFalse: + [(self systemNavigation allCallsOn: self) do: + [:mref | mref actualClass recompile: mref methodSymbol]]! - [(self systemNavigation allCallsOn: self) - do: [:mref | mref actualClass recompile: mref methodSymbol]]! Item was added: + ----- Method: Matrix class>>new (in category 'instance creation') ----- + new + ^self rows: 0 columns: 0! Item was changed: ----- Method: Matrix class>>rows:columns:contents: (in category 'private') ----- rows: rows columns: columns contents: contents + ^super new rows: rows columns: columns contents: contents! - ^self new rows: rows columns: columns contents: contents! Item was added: + ----- Method: Matrix>>asFloat32Array (in category 'converting') ----- + asFloat32Array + ^contents asFloat32Array! Item was added: + ----- Method: Matrix>>asFloat64Array (in category 'converting') ----- + asFloat64Array + ^contents asFloat64Array! Item was removed: - ----- Method: Matrix>>asFloatArray (in category 'converting') ----- - asFloatArray - ^contents asFloatArray! Item was changed: ----- Method: Matrix>>atColumn: (in category 'accessing rows/columns') ----- atColumn: column |p| + nrows = 0 ifTrue: [ + (column between: 1 and: ncols) + ifFalse: [self error: '2nd subscript out of range']. + ^ #()]. - p := (self indexForRow: 1 andColumn: column)-ncols. ^(1 to: nrows) collect: [:row | contents at: (p := p+ncols)] ! Item was changed: + ----- Method: Matrix>>occurrencesOf: (in category 'enumerating') ----- - ----- Method: Matrix>>occurrencesOf: (in category 'testing') ----- occurrencesOf: anObject ^contents occurrencesOf: anObject! Item was added: + ----- Method: Matrix>>stringForReadout (in category 'printing') ----- + stringForReadout + "Answer a String whose characters are a description of the receiver layed out in rows and columns" + + ^ String streamContents: [:aStream | + 1 + to: self rowCount + do: [:iRow | + 1 + to: self columnCount + do: [:iCols | + aStream + print: (self at: iRow at: iCols). + aStream tab: 2]. + aStream cr]]! Item was changed: ----- Method: Matrix>>transposed (in category 'accessing rows/columns') ----- transposed + ^ self species rows: ncols columns: nrows tabulate: [:i :j | self at: j at: i]! - self assert: [nrows = ncols]. - ^self indicesCollect: [:row :column | self at: column at: row]! Item was changed: ----- Method: MimeConverter class>>forEncoding: (in category 'convenience') ----- forEncoding: encodingString + "Answer a converter class for the given encoding" + encodingString ifNil: [^ NullMimeConverter]. - "Answer a converter class for the given encoding or nil if unknown" - encodingString ifNil: [^nil]. ^ encodingString asLowercase caseOf: { ['base64'] -> [Base64MimeConverter]. + ['quoted-printable'] -> [QuotedPrintableMimeConverter]. + ['7bit'] -> [Bit7MimeConverter]. + ['8bit'] -> [NullMimeConverter]. + ['binary'] -> [NullMimeConverter] } + otherwise: [NullMimeConverter]. - ['quoted-printable'] -> [QuotedPrintableMimeConverter]} - otherwise: []. ! Item was added: + OrderedCollection subclass: #NonPointersOrderedCollection + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Collections-Sequenceable'! + + !NonPointersOrderedCollection commentStamp: 'ul 3/26/2017 21:38' prior: 0! + I am an OrderedCollection with an internal array holding non-pointers objects. This has the advantage that the array is never subject of garbage collection. But I can only hold objects of a given type defined by my class-side #arrayType method, which is the only method they have to implement.! Item was added: + ----- Method: NonPointersOrderedCollection class>>isAbstract (in category 'testing') ----- + isAbstract + ^self = NonPointersOrderedCollection! Item was added: + ----- Method: NonPointersOrderedCollection>>arrayType (in category 'private') ----- + arrayType + "This method must return a non-pointers array class." + + self subclassResponsibility! Item was added: + ----- Method: NonPointersOrderedCollection>>makeRoomAtFirst (in category 'private') ----- + makeRoomAtFirst + "Same as super without trying to store nil in the emptied slots of array." + + | tally newFirstIndex newLastIndex capacity | + tally := self size. + capacity := array size. + tally * 2 >= capacity ifTrue: [ ^self growAtFirst ]. + tally = 0 ifTrue: [ ^self resetTo: capacity + 1 ]. + newFirstIndex := capacity // 2 + 1. + newLastIndex := newFirstIndex - firstIndex + lastIndex. + 0 to: tally - 1 do: [ :offset | + array at: newLastIndex - offset put: (array at: lastIndex - offset) ]. + firstIndex := newFirstIndex. + lastIndex := newLastIndex! Item was added: + ----- Method: NonPointersOrderedCollection>>makeRoomAtLast (in category 'private') ----- + makeRoomAtLast + "Same as super without trying to store nil in the emptied slots of array." + + | tally newFirstIndex newLastIndex | + tally := self size. + tally * 2 >= lastIndex ifTrue: [ ^self growAtLast ]. + tally = 0 ifTrue: [ ^self resetTo: 1 ]. + newLastIndex := lastIndex // 2. + newFirstIndex := newLastIndex - lastIndex + firstIndex. + array + replaceFrom: newFirstIndex + to: newLastIndex + with: array + startingAt: firstIndex. + firstIndex := newFirstIndex. + lastIndex := newLastIndex! Item was added: + ----- Method: NonPointersOrderedCollection>>removeAllSuchThat: (in category 'removing') ----- + removeAllSuchThat: aBlock + "Same as super without trying to store nil in the emptied slots of array." + + | n | + n := firstIndex. + firstIndex to: lastIndex do: [ :index | + | element | + (aBlock value: (element := array at: index)) ifFalse: [ + array at: n put: element. + n := n + 1 ] ]. + lastIndex := n - 1! Item was added: + ----- Method: NonPointersOrderedCollection>>removeFirst (in category 'removing') ----- + removeFirst + "Same as super without trying to store nil in the emptied slot of array." + + | firstObject | + firstIndex > lastIndex ifTrue: [ self errorEmptyCollection ]. + firstObject := array at: firstIndex. + firstIndex := firstIndex + 1. + ^firstObject! Item was added: + ----- Method: NonPointersOrderedCollection>>removeFirst: (in category 'removing') ----- + removeFirst: n + "Same as super without trying to store nil in the emptied slots of array." + + | lastIndexToRemove result | + n < 1 ifTrue: [ self errorNoSuchElement ]. + lastIndex < (lastIndexToRemove := firstIndex + n - 1) ifTrue: [ self errorNotEnoughElements ]. + result := array copyFrom: firstIndex to: lastIndexToRemove. + firstIndex := lastIndexToRemove + 1. + ^result! Item was added: + ----- Method: NonPointersOrderedCollection>>removeIndex: (in category 'private') ----- + removeIndex: removedIndex + "Same as super without trying to store nil in the emptied slot of array." + + array + replaceFrom: removedIndex + to: lastIndex - 1 + with: array + startingAt: removedIndex + 1. + lastIndex := lastIndex - 1.! Item was added: + ----- Method: NonPointersOrderedCollection>>removeLast (in category 'removing') ----- + removeLast + "Same as super without trying to store nil in the emptied slot of array." + + | lastObject | + firstIndex > lastIndex ifTrue: [ self errorEmptyCollection ]. + lastObject := array at: lastIndex. + lastIndex := lastIndex - 1. + ^ lastObject! Item was added: + ----- Method: NonPointersOrderedCollection>>removeLast: (in category 'removing') ----- + removeLast: n + "Same as super without trying to store nil in the emptied slots of array." + + | firstIndexToRemove result | + n < 1 ifTrue: [ self errorNoSuchElement ]. + (firstIndexToRemove := lastIndex - n + 1) < firstIndex ifTrue: [ self errorNotEnoughElements ]. + result := array copyFrom: firstIndexToRemove to: lastIndex. + lastIndex := firstIndexToRemove - 1. + ^result! Item was changed: ----- Method: NotFound>>messageText (in category 'accessing') ----- messageText + + ^ messageText ifNil: ['Object is not in the collection.' translated]! - "Return a textual description of the exception." - ^messageText ifNil:['Object is not in the collection.']! Item was added: + MimeConverter subclass: #NullMimeConverter + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Collections-Streams'! Item was added: + ----- Method: NullMimeConverter>>mimeDecode (in category 'conversion') ----- + mimeDecode + + dataStream nextPutAll: mimeStream upToEnd. + ^ dataStream! Item was added: + ----- Method: NullMimeConverter>>mimeEncode (in category 'conversion') ----- + mimeEncode + + mimeStream nextPutAll: dataStream upToEnd. + ^ mimeStream + ! Item was changed: ----- Method: NullStream>>next:putAll:startingAt: (in category 'writing') ----- next: anInteger putAll: aCollection startingAt: startIndex "Store the next anInteger elements from the given collection." + anInteger > 0 ifFalse: [ ^aCollection ]. position := position + anInteger. ^aCollection! Item was added: + ----- Method: Object>>asLink (in category '*collections') ----- + asLink + + ^ ValueLink value: self! Item was removed: - ----- Method: OrderedCollection class>>arrayType (in category 'private') ----- - arrayType - ^ Array! Item was changed: ----- Method: OrderedCollection class>>new: (in category 'instance creation') ----- new: anInteger + | instance | + ^(instance := self basicNew) setCollection: (instance arrayType new: anInteger)! - ^ self basicNew setCollection: (self arrayType new: anInteger)! Item was changed: ----- Method: OrderedCollection class>>new:withAll: (in category 'instance creation') ----- new: anInteger withAll: anObject + | instance | + ^(instance := self basicNew) setContents: (instance arrayType new: anInteger withAll: anObject)! - ^ self basicNew setContents: (self arrayType new: anInteger withAll: anObject)! Item was added: + ----- Method: OrderedCollection>>allButFirstDo: (in category 'enumerating') ----- + allButFirstDo: aBlock + "Override the superclass for performance reasons." + + firstIndex + 1 to: lastIndex do: [ :index | + aBlock value: (array at: index) ]! Item was added: + ----- Method: OrderedCollection>>allButLastDo: (in category 'enumerating') ----- + allButLastDo: aBlock + "Override the superclass for performance reasons." + + firstIndex to: lastIndex - 1 do: [ :index | + aBlock value: (array at: index) ]! Item was added: + ----- Method: OrderedCollection>>arrayType (in category 'private') ----- + arrayType + ^ Array! Item was changed: ----- Method: OrderedCollection>>asArray (in category 'converting') ----- asArray "Overriden for speed" + | result size | + result := Array new: (size := self size). - | result | - result := Array new: self size. result replaceFrom: 1 + to: size - to: result size with: array startingAt: firstIndex. ^result! Item was changed: ----- Method: OrderedCollection>>collect: (in category 'enumerating') ----- collect: aBlock + "Evaluate aBlock with each of my elements as the argument. + Collect the resulting values into an OrderedCollection." - "Evaluate aBlock with each of my elements as the argument. Collect the - resulting values into a collection that is like me. Answer the new - collection. Override superclass in order to use addLast:, not at:put:." | newCollection | + newCollection := OrderedCollection new: self size. - newCollection := self species new: self size. firstIndex to: lastIndex do: [:index | newCollection addLast: (aBlock value: (array at: index))]. ^ newCollection! Item was changed: ----- Method: OrderedCollection>>collect:from:to: (in category 'enumerating') ----- collect: aBlock from: fromIndex to: toIndex + "Evaluate aBlock with each of my elements as the argument between fromIndex and toIndex. + Collect the resulting values into an OrderedCollection." + + | result offset | + offset := firstIndex - 1. + (fromIndex < 1 or:[toIndex + offset > lastIndex]) - "Override superclass in order to use addLast:, not at:put:." - | result | - (fromIndex < 1 or:[toIndex + firstIndex - 1 > lastIndex]) ifTrue: [^self errorNoSuchElement]. + result := OrderedCollection new: toIndex - fromIndex + 1. + fromIndex + offset to: toIndex + offset do: - result := self species new: toIndex - fromIndex + 1. - firstIndex + fromIndex - 1 to: firstIndex + toIndex - 1 do: [:index | result addLast: (aBlock value: (array at: index))]. ^ result ! Item was changed: ----- Method: OrderedCollection>>do: (in category 'enumerating') ----- do: aBlock "Override the superclass for performance reasons." + + firstIndex to: lastIndex do: [ :index | + aBlock value: (array at: index) ]! - | index | - index := firstIndex. - [index <= lastIndex] - whileTrue: - [aBlock value: (array at: index). - index := index + 1]! Item was changed: ----- Method: OrderedCollection>>errorNoSuchElement (in category 'private') ----- errorNoSuchElement + ^ self error: ('Attempt to index a non-existent element in {1}' translated format: {self name})! - self error: (String streamContents: [ :stream | - stream nextPutAll: 'attempt to index a non-existent element in '. - self printNameOn: stream ])! Item was changed: ----- Method: OrderedCollection>>errorNotEnoughElements (in category 'private') ----- errorNotEnoughElements + ^ self error: ('Attempt to remove more elements than possible from {1}' translated format: {self name})! - self error: (String streamContents: [ :stream | - stream nextPutAll: 'attempt to remove more elements than possible from '. - self printNameOn: stream ])! Item was changed: ----- Method: OrderedCollection>>find: (in category 'private') ----- find: oldObject " This method answers an index in the range firstIndex .. lastIndex, which is meant for internal use only. Never use this method in your code, the methods for public use are: #indexOf: #indexOf:ifAbsent: " + firstIndex to: lastIndex do: [ :index | + (array at: index) = oldObject ifTrue: [ ^index ] ]. - | index | - index := firstIndex. - [index <= lastIndex] - whileTrue: - [(array at: index) = oldObject ifTrue: [^ index]. - index := index + 1]. self errorNotFound: oldObject! Item was added: + ----- Method: OrderedCollection>>first (in category 'accessing') ----- + first + + firstIndex > lastIndex ifTrue: [ self errorNoSuchElement ]. + ^array at: firstIndex! Item was changed: ----- Method: OrderedCollection>>growAtFirst (in category 'private') ----- growAtFirst "Add new empty slots to the front of array, while keeping the empty slots at the end." | newArray newFirstIndex newLastIndex | + newArray := self arrayType new: (array size * 2 max: 1). - newArray := self class arrayType new: (array size * 2 max: 1). newFirstIndex := newArray size - array size + firstIndex. newLastIndex := newFirstIndex + lastIndex - firstIndex. newArray replaceFrom: newFirstIndex to: newLastIndex with: array startingAt: firstIndex. array := newArray. firstIndex := newFirstIndex. lastIndex := newLastIndex! Item was changed: ----- Method: OrderedCollection>>growAtLast (in category 'private') ----- growAtLast "Add new empty slots to the end of array, while keeping the empty slots at the front." | newArray | + newArray := self arrayType new: (array size * 2 max: 1). - newArray := self class arrayType new: (array size * 2 max: 1). newArray replaceFrom: firstIndex to: lastIndex with: array startingAt: firstIndex. array := newArray! Item was added: + ----- Method: OrderedCollection>>indexOf:startingAt: (in category 'accessing') ----- + indexOf: anElement startingAt: start + "Optimized version." + + firstIndex + start - 1 to: lastIndex do: [ :index | + (array at: index) = anElement ifTrue: [ ^index - firstIndex + 1 ] ]. + ^0! Item was removed: - ----- Method: OrderedCollection>>indexOf:startingAt:ifAbsent: (in category 'accessing') ----- - indexOf: anElement startingAt: start ifAbsent: exceptionBlock - "Optimized version." - - firstIndex + start - 1 to: lastIndex do: [ :index | - (array at: index) = anElement ifTrue: [ ^index - firstIndex + 1 ] ]. - ^exceptionBlock value! Item was added: + ----- Method: OrderedCollection>>isEmpty (in category 'testing') ----- + isEmpty + ^firstIndex > lastIndex! Item was added: + ----- Method: OrderedCollection>>last (in category 'accessing') ----- + last + + firstIndex > lastIndex ifTrue: [ self errorNoSuchElement ]. + ^array at: lastIndex! Item was changed: ----- Method: OrderedCollection>>makeRoomAtFirst (in category 'private') ----- makeRoomAtFirst "Make some empty slots at the front of the array. If we have more than 50% free space, then just move the elements, so that the first 50% of the slots are free, otherwise add new free slots to the front by growing. Precondition: firstIndex = 1" + | tally newFirstIndex newLastIndex capacity | - | tally newFirstIndex newLastIndex | tally := self size. + capacity := array size. + tally * 2 >= capacity ifTrue: [ ^self growAtFirst ]. + tally = 0 ifTrue: [ ^self resetTo: capacity + 1 ]. + newFirstIndex := capacity // 2 + 1. - tally * 2 >= array size ifTrue: [ ^self growAtFirst ]. - tally = 0 ifTrue: [ ^self resetTo: array size + 1 ]. - newFirstIndex := array size // 2 + 1. newLastIndex := newFirstIndex - firstIndex + lastIndex. 0 to: tally - 1 do: [ :offset | array at: newLastIndex - offset put: (array at: lastIndex - offset) ]. array from: firstIndex to: newFirstIndex - 1 put: nil. firstIndex := newFirstIndex. lastIndex := newLastIndex! Item was added: + ----- Method: OrderedCollection>>occurrencesOf: (in category 'enumerating') ----- + occurrencesOf: anObject + "Answer how many of the receiver's elements are equal to anObject. Optimized version." + + | tally | + tally := 0. + firstIndex to: lastIndex do: [ :index | + (array at: index) = anObject ifTrue: [ tally := tally + 1 ] ]. + ^tally! Item was changed: ----- Method: OrderedCollection>>remove:ifAbsent: (in category 'removing') ----- remove: oldObject ifAbsent: absentBlock + firstIndex to: lastIndex do: [ :index | + (array at: index) = oldObject ifTrue: [ + self removeIndex: index. + ^oldObject ] ]. + ^absentBlock value! - | index | - index := firstIndex. - [index <= lastIndex] - whileTrue: - [oldObject = (array at: index) - ifTrue: - [self removeIndex: index. - ^ oldObject] - ifFalse: [index := index + 1]]. - ^ absentBlock value! Item was changed: ----- Method: OrderedCollection>>removeAll (in category 'removing') ----- removeAll "remove all the elements from this collection. Keep same amount of storage" + self setCollection: (self arrayType new: array size)! - self setCollection: (self class arrayType new: array size)! Item was changed: ----- Method: OrderedCollection>>removeFirst (in category 'removing') ----- removeFirst "Remove the first element of the receiver and answer it. If the receiver is empty, create an error notification." + | firstObject | + firstIndex > lastIndex ifTrue: [ self errorEmptyCollection ]. - self emptyCheck. firstObject := array at: firstIndex. array at: firstIndex put: nil. firstIndex := firstIndex + 1. + ^firstObject! - ^ firstObject! Item was changed: ----- Method: OrderedCollection>>removeFirst: (in category 'removing') ----- removeFirst: n "Remove the first n objects into an array." | lastIndexToRemove result | + n < 0 ifTrue: [ self errorNoSuchElement ]. - n < 1 ifTrue: [ self errorNoSuchElement ]. lastIndex < (lastIndexToRemove := firstIndex + n - 1) ifTrue: [ self errorNotEnoughElements ]. result := array copyFrom: firstIndex to: lastIndexToRemove. array from: firstIndex to: lastIndexToRemove put: nil. firstIndex := lastIndexToRemove + 1. ^result! Item was changed: ----- Method: OrderedCollection>>removeLast (in category 'removing') ----- removeLast "Remove the last element of the receiver and answer it. If the receiver is empty, create an error notification." + | lastObject | + firstIndex > lastIndex ifTrue: [ self errorEmptyCollection ]. - self emptyCheck. lastObject := array at: lastIndex. array at: lastIndex put: nil. lastIndex := lastIndex - 1. ^ lastObject! Item was changed: ----- Method: OrderedCollection>>removeLast: (in category 'removing') ----- removeLast: n "Remove the last n objects into an array with last in last position." | firstIndexToRemove result | + n < 0 ifTrue: [ self errorNoSuchElement ]. - n < 1 ifTrue: [ self errorNoSuchElement ]. (firstIndexToRemove := lastIndex - n + 1) < firstIndex ifTrue: [ self errorNotEnoughElements ]. result := array copyFrom: firstIndexToRemove to: lastIndex. array from: firstIndexToRemove to: lastIndex put: nil. lastIndex := firstIndexToRemove - 1. ^result! Item was added: + ----- Method: OrderedCollection>>replace: (in category 'enumerating') ----- + replace: aBlock + "Evaluate aBlock with each of my elements as the argument. Collect the resulting values into myself. + Override superclass in order to work on the internal array directly." + + firstIndex to: lastIndex do: [ :index | + array at: index put: (aBlock value: (array at: index)) ]! Item was changed: ----- Method: OrderedCollection>>reverseDo: (in category 'enumerating') ----- reverseDo: aBlock "Override the superclass for performance reasons." + + lastIndex to: firstIndex by: -1 do: [ :index | + aBlock value: (array at: index) ]! - | index | - index := lastIndex. - [index >= firstIndex] - whileTrue: - [aBlock value: (array at: index). - index := index - 1]! Item was changed: ----- Method: OrderedCollection>>with:collect: (in category 'enumerating') ----- with: otherCollection collect: twoArgBlock "Collect and return the result of evaluating twoArgBlock with corresponding elements from this collection and otherCollection." + + | result offset size | + (size := self size) = otherCollection size ifFalse: [ self error: 'otherCollection must be the same size' ]. + result := OrderedCollection new: size. + offset := 1 - firstIndex. + firstIndex to: lastIndex do: [ :index | + result addLast: ( + twoArgBlock + value: (array at: index) + value: (otherCollection at: index + offset)) ]. + ^result! - | result | - otherCollection size = self size ifFalse: [self error: 'otherCollection must be the same size']. - result := self species new: self size. - 1 to: self size do: - [:index | result addLast: (twoArgBlock value: (self at: index) - value: (otherCollection at: index))]. - ^ result! Item was changed: ----- Method: OrderedCollection>>withIndexCollect: (in category 'enumerating') ----- withIndexCollect: elementAndIndexBlock "Just like with:collect: except that the iteration index supplies the second argument to the block. Override superclass in order to use addLast:, not at:put:." + | newCollection offset | + newCollection := OrderedCollection new: self size. + offset := 1 - firstIndex. - | newCollection | - newCollection := self species new: self size. firstIndex to: lastIndex do: [:index | newCollection addLast: (elementAndIndexBlock value: (array at: index) + value: index + offset) ]. - value: index - firstIndex + 1)]. ^ newCollection! Item was changed: + PluggableDictionary subclass: #OrderedDictionary - Dictionary subclass: #OrderedDictionary instanceVariableNames: 'order' classVariableNames: '' poolDictionaries: '' category: 'Collections-Sequenceable'! !OrderedDictionary commentStamp: 'mt 1/16/2015 10:42' prior: 0! I am an ordered dictionary. I have an additional index (called 'order') to keep track of the insertion order of my associations. The read access is not affected by the additional index. The index is updated in O(1) [time] when inserting new keys. For present keys, that insertion involves actions in O(n) to move the respective element to the end of the order. The growth operation compacts the index and takes O(n) additional time. NOTE: This is still no instance of SequenceableCollection. Having this, some protocols are missing and may require working on #associations, which is an Array and thus sequenceable.! Item was changed: ----- Method: OrderedDictionary>>growTo: (in category 'private') ----- growTo: anInteger + | newCapacity capacityDifference | - | oldOrder | super growTo: anInteger. + newCapacity := self capacity. + capacityDifference := newCapacity - order size. + capacityDifference = 0 ifTrue: [ ^self ]. + order := capacityDifference > 0 + ifTrue: [ order grownBy: capacityDifference ] + ifFalse: [ order first: newCapacity ]! - oldOrder := order. - "Grow only to 75%. See #atNewIndex:put: in HashedCollection." - order := self class arrayType new: anInteger + 1 * 3 // 4. - order - replaceFrom: 1 - to: tally - with: oldOrder - startingAt: 1! Item was added: + ----- Method: OrderedDictionary>>hasEqualElements: (in category 'comparing') ----- + hasEqualElements: anOrderedDictionary + "Answer whether my elements are the same as anOrderedDictionary, and in the same order." + | index | + self size = anOrderedDictionary size ifFalse: [ ^ false ]. + index := 0. + self associationsDo: + [ : eachMyAssociation | + (anOrderedDictionary + atIndex: (index:=index+1) + ifAbsent: [ ^ false ]) = eachMyAssociation ifFalse: [ ^ false ] ]. + ^ true! Item was changed: ----- Method: OrderedDictionary>>initialize: (in category 'private') ----- initialize: n super initialize: n. + order := self arrayType new: self capacity! - order := self class arrayType new: n + 1 * 3 // 4! Item was added: + ----- Method: OrderedDictionary>>keysInOrder (in category 'accessing') ----- + keysInOrder + "Overridden. Preserve the order of the receiver." + ^ self keys! Item was added: + ----- Method: OrderedDictionary>>last (in category 'accessing') ----- + last + "Answer the last element of the receiver" + + ^ self atIndex: self size! Item was added: + ----- Method: OrderedDictionary>>middle (in category 'accessing') ----- + middle + "Answer the middle element of the receiver." + + ^ self atIndex: self size // 2 + 1! Item was changed: ----- Method: OrderedDictionary>>postCopyFrom:to: (in category 'copying') ----- postCopyFrom: startIndex to: endIndex "Adapted from SequenceableCollection and OrderedCollection." | oldOrder | oldOrder := order. + array := self arrayType - array := self class arrayType new: (self class goodPrimeAtLeast: endIndex - startIndex + 1 * 4 // 3). "fill 75% to 100%" + order := self arrayType + new: array size + 1 * 3 // 4. "remove 25%" - order := self class arrayType - new: array size * 3 // 4. "remove 25%" startIndex to: endIndex do: [:index | | element | element := (oldOrder at: index) copy. order at: index - startIndex + 1 put: element. array at: (self scanFor: element key) put: element]. + tally := endIndex - startIndex + 1! - tally := endIndex - startIndex + 1.! Item was added: + ----- Method: OrderedDictionary>>replace: (in category 'enumerating') ----- + replace: aBlock + "Like super, but iterate in order." + + order from: 1 to: tally do: [:each | each value: (aBlock value: each value)]! Item was changed: Dictionary subclass: #PluggableDictionary instanceVariableNames: 'hashBlock equalBlock' classVariableNames: '' poolDictionaries: '' category: 'Collections-Unordered'! + !PluggableDictionary commentStamp: 'eem 3/30/2017 17:44' prior: 0! - !PluggableDictionary commentStamp: '<historical>' prior: 0! Class PluggableDictionary allows the redefinition of hashing and equality by clients. This is in particular useful if the clients know about specific properties of the objects stored in the dictionary. See the class comment of PluggableSet for an example. Instance variables: + hashBlock <BlockClosure> A one argument block used for hashing the elements. + equalBlock <BlockClosure> A two argument block used for comparing the elements. - hashBlock <BlockContext> A one argument block used for hashing the elements. - equalBlock <BlockContext> A two argument block used for comparing the elements. ! Item was added: + ----- Method: PluggableDictionary class>>hashBlock: (in category 'instance creation') ----- + hashBlock: aHashBlock + + ^ self new + hashBlock: aHashBlock; + yourself! Item was added: + ----- Method: PluggableDictionary class>>hashBlock:equalBlock: (in category 'instance creation') ----- + hashBlock: aHashBlock equalBlock: anEqualBlock + + ^ self new + hashBlock: aHashBlock; + equalBlock: anEqualBlock; + yourself! Item was changed: ----- Method: PluggableDictionary class>>integerDictionary (in category 'instance creation') ----- integerDictionary ^ self new hashBlock: [:integer | integer hash \\ 1064164 * 1009]! Item was added: + ----- Method: PluggableDictionary>>= (in category 'comparing') ----- + = anObject + "Two dictionaries are equal if + (a) they are the same 'kind' of thing. + (b) they have the same set of keys. + (c) for each (common) key, they have the same value" + + self == anObject ifTrue: [ ^true ]. + self species = anObject species ifFalse: [ ^false ]. + hashBlock = anObject hashBlock ifFalse: [ ^false ]. + equalBlock = anObject equalBlock ifFalse: [ ^false ]. + ^ self hasEqualElements: anObject! Item was added: + ----- Method: PluggableDictionary>>hasEqualElements: (in category 'comparing') ----- + hasEqualElements: aDictionary + "Answer whether my elements are the same as those of aDictionary." + self size = aDictionary size ifFalse: [ ^ false ]. + self associationsDo: + [ : association | + (aDictionary + at: association key + ifAbsent: [ ^ false ]) = association value ifFalse: [ ^ false ] ]. + ^ true! Item was changed: ----- Method: PluggableDictionary>>scanFor: (in category 'private') ----- scanFor: anObject "Scan the key array for the first slot containing either a nil (indicating an empty slot) or an element that matches anObject. Answer the index of that slot or raise an error if no slot is found. This method will be overridden in various subclasses that have different interpretations for matching elements." + | index start size | - | index start | index := start := (hashBlock ifNil: [ anObject hash ] + ifNotNil: [ hashBlock value: anObject ]) \\ (size := array size) + 1. - ifNotNil: [ hashBlock value: anObject ]) \\ array size + 1. [ | element | ((element := array at: index) == nil or: [ equalBlock ifNil: [ element key = anObject ] ifNotNil: [ equalBlock value: element key value: anObject ] ]) ifTrue: [ ^index ]. + (index := index \\ size + 1) = start ] whileFalse. - (index := index \\ array size + 1) = start ] whileFalse. self errorNoFreeSpace! Item was changed: ----- Method: PluggableDictionary>>scanForEmptySlotFor: (in category 'private') ----- scanForEmptySlotFor: anObject "Scan the key array for the first slot containing an empty slot (indicated by a nil). Answer the index of that slot. This method will be overridden in various subclasses that have different interpretations for matching elements." + | index start size | - | index start | index := start := (hashBlock ifNil: [ anObject hash ] + ifNotNil: [ hashBlock value: anObject ]) \\ (size := array size) + 1. - ifNotNil: [ hashBlock value: anObject ]) \\ array size + 1. [ (array at: index) ifNil: [ ^index ]. + (index := index \\ size + 1) = start ] whileFalse. - (index := index \\ array size + 1) = start ] whileFalse. self errorNoFreeSpace! Item was changed: Set subclass: #PluggableSet instanceVariableNames: 'hashBlock equalBlock' classVariableNames: '' poolDictionaries: '' category: 'Collections-Unordered'! + !PluggableSet commentStamp: 'eem 3/30/2017 17:59' prior: 0! - !PluggableSet commentStamp: 'nice 3/25/2010 23:02' prior: 0! PluggableSets allow the redefinition of hashing and equality by clients. This is in particular useful if the clients know about specific properties of the objects stored in the set which in turn can heavily improve the performance of sets and dictionaries. Instance variables: + hashBlock <BlockClosure> A one argument block used for hashing the elements. + equalBlock <BlockClosure> A two argument block used for comparing the elements. - hashBlock <BlockContext> A one argument block used for hashing the elements. - equalBlock <BlockContext> A two argument block used for comparing the elements. + Example: Adding 1000000 integer points in the range (0 at 0) to: (100 at 100) to a set. - Example: Adding 1000 integer points in the range (0 at 0) to: (100 at 100) to a set. + ( | n rnd set max points | + set := Set new: (n := 1000000). - | rnd set max pt | - set := Set new: 1000. rnd := Random new. max := 100. + points := (1 to: n) collect: [:ign| (rnd next @ rnd next * max) truncated]. + Smalltalk garbageCollectMost. "to reduce variability in the run-to-run times" + [1 to: 1000000 do: [:i| set add: (points at: i)]] + timeToRun + ) - Time millisecondsToRun:[ - 1 to: 1000 do:[:i| - pt := (rnd next * max) truncated @ (rnd next * max) truncated. - set add: pt. - ]. - ]. The above is way slow since the default hashing function of points leads to an awful lot of collisions in the set. And now the same, with a somewhat different hash function: + ( | n rnd set max points | + set := PluggableSet new: (n := 1000000). + set hashBlock: [:item| (item x bitShift: 10) + item y]. - | rnd set max pt | - set := PluggableSet new: 1000. - set hashBlock:[:item| (item x bitShift: 16) + item y]. rnd := Random new. max := 100. + points := (1 to: n) collect: [:ign| (rnd next @ rnd next * max) truncated]. + Smalltalk garbageCollectMost. "to reduce variability in the run-to-run times" + [1 to: 1000000 do: [:i| set add: (points at: i)]] + timeToRun + )! - Time millisecondsToRun:[ - 1 to: 1000 do:[:i| - pt := (rnd next * max) truncated @ (rnd next * max) truncated. - set add: pt. - ]. - ]. - ! Item was added: + ----- Method: PluggableSet class>>hashBlock: (in category 'instance creation') ----- + hashBlock: aHashBlock + + ^ self new + hashBlock: aHashBlock; + yourself! Item was added: + ----- Method: PluggableSet class>>hashBlock:equalBlock: (in category 'instance creation') ----- + hashBlock: aHashBlock equalBlock: anEqualBlock + + ^ self new + hashBlock: aHashBlock; + equalBlock: anEqualBlock; + yourself! Item was changed: ----- Method: PluggableSet class>>integerSet (in category 'instance creation') ----- integerSet ^self new hashBlock: [:integer | integer hash \\ 1064164 * 1009]! Item was added: + ----- Method: PluggableSet>>= (in category 'comparing') ----- + = anObject + "Two sets are equal if + (a) they are the same 'kind' of thing. + (b) they have the same set of keys. + (c) for each (common) key, they have the same value" + + self == anObject ifTrue: [ ^true ]. + self species == anObject species ifFalse: [ ^false ]. + hashBlock = anObject hashBlock ifFalse: [ ^false ]. + equalBlock = anObject equalBlock ifFalse: [ ^false ]. + self size = anObject size ifFalse: [ ^false ]. + ^self allSatisfy: [ :each | anObject includes: each ]! Item was changed: ----- Method: PluggableSet>>scanFor: (in category 'private') ----- scanFor: anObject "Scan the key array for the first slot containing either a nil (indicating an empty slot) or an element that matches anObject. Answer the index of that slot or raise an error if no slot is found. This method will be overridden in various subclasses that have different interpretations for matching elements." + | index start size | - | index start | index := start := (hashBlock ifNil: [ anObject hash ] + ifNotNil: [ hashBlock value: anObject ]) \\ (size := array size) + 1. - ifNotNil: [ hashBlock value: anObject ]) \\ array size + 1. [ | element | ((element := array at: index) == nil or: [ equalBlock ifNil: [ element enclosedSetElement = anObject ] ifNotNil: [ equalBlock value: element enclosedSetElement value: anObject ] ]) ifTrue: [ ^index ]. + (index := index \\ size + 1) = start ] whileFalse. - (index := index \\ array size + 1) = start ] whileFalse. self errorNoFreeSpace! Item was changed: ----- Method: PluggableSet>>scanForEmptySlotFor: (in category 'private') ----- scanForEmptySlotFor: anObject "Scan the key array for the first slot containing an empty slot (indicated by a nil). Answer the index of that slot. This method will be overridden in various subclasses that have different interpretations for matching elements." + | index start size | - | index start | index := start := (hashBlock ifNil: [ anObject hash ] + ifNotNil: [ hashBlock value: anObject ]) \\ (size := array size) + 1. - ifNotNil: [ hashBlock value: anObject ]) \\ array size + 1. [ (array at: index) ifNil: [ ^index ]. + (index := index \\ size + 1) = start ] whileFalse. - (index := index \\ array size + 1) = start ] whileFalse. self errorNoFreeSpace! Item was changed: + ----- Method: PluggableTextAttribute>>writeScanOn: (in category 'fileIn/fileOut') ----- - ----- Method: PluggableTextAttribute>>writeScanOn: (in category 'as yet unclassified') ----- writeScanOn: aStream "Impossible for this kind of attribute" ^ self shouldNotImplement ! Item was added: + ----- Method: PositionableStream>>basicSkipTo: (in category 'accessing - multibyte support') ----- + basicSkipTo: anObject + + ^self skipTo: anObject! Item was changed: ----- Method: PositionableStream>>basicUpTo: (in category 'accessing - multibyte support') ----- + basicUpTo: anObject - basicUpTo: anObject + ^self upTo: anObject! - ^self next: anObject - ! Item was changed: ----- Method: PositionableStream>>isBinary (in category 'testing') ----- isBinary + "Answer if the receiver is a binary stream" + ^collection isCollection and: [collection isUnsignedIntegerArray]! - "Return true if the receiver is a binary byte stream" - ^collection class == ByteArray! Item was changed: ----- Method: PositionableStream>>next:putAll:startingAt: (in category 'accessing') ----- next: anInteger putAll: aCollection startingAt: startIndex "Store the next anInteger elements from the given collection." + + startIndex to: startIndex + anInteger - 1 do: [ :index | + self nextPut: (aCollection at: index) ]. + ^aCollection! - (startIndex = 1 and:[anInteger = aCollection size]) - ifTrue:[^self nextPutAll: aCollection]. - ^self nextPutAll: (aCollection copyFrom: startIndex to: startIndex+anInteger-1)! Item was changed: ----- Method: PositionableStream>>nextWord (in category 'nonhomogeneous accessing') ----- nextWord "Answer the next two bytes from the receiver as an Integer." | high low | + high := self next ifNil: [ ^false ]. + low := self next ifNil: [ ^false ]. - high := self next. - high==nil ifTrue: [^false]. - low := self next. - low==nil ifTrue: [^false]. ^(high asInteger bitShift: 8) + low asInteger! Item was added: + ----- Method: PositionableStream>>oldPeekBack (in category 'accessing') ----- + oldPeekBack + "Return the element at the previous position, without changing position. Use indirect messages in case self is a StandardFileStream." + + | element | + element := self oldBack. + self skip: 1. + ^ element! Item was added: + ----- Method: PositionableStream>>peek: (in category 'accessing') ----- + peek: anInteger + "Answer what would be returned if the message next: anInteger were sent to the receiver. If the receiver has less than anInteger more elements, only answer so many elements as available." + + | oldPosition result | + oldPosition := position. + result := self next: anInteger. + position := oldPosition. + ^ result! Item was changed: ----- Method: PositionableStream>>peekBack (in category 'accessing') ----- peekBack "Return the element at the previous position, without changing position. Use indirect messages in case self is a StandardFileStream." - | element | + self position = 0 ifTrue: [self errorCantGoBack]. + element := self back. - element := self oldBack. self skip: 1. ^ element! Item was changed: ----- Method: PositionableStream>>peekFor: (in category 'accessing') ----- peekFor: anObject "Answer false and do not move over the next element if it is not equal to the argument, anObject, or if the receiver is at the end. Answer true and increment the position for accessing elements, if the next element is equal to anObject." - | nextObject | self atEnd ifTrue: [^false]. - nextObject := self next. - "peek for matching element" - anObject = nextObject ifTrue: [^true]. "gobble it if found" + self next = anObject ifTrue: [ ^true ]. position := position - 1. ^false! Item was changed: ----- Method: PositionableStream>>upTo: (in category 'accessing') ----- upTo: anObject "Answer a subcollection from the current access position to the occurrence (if any, but not inclusive) of anObject in the receiver. If anObject is not in the collection, answer the entire rest of the receiver." + + ^self collectionSpecies streamContents: [ :stream | + | element | + [self atEnd or: [(element := self next) = anObject]] + whileFalse: [stream nextPut: element]]! - | newStream element | - newStream := WriteStream on: (self collectionSpecies new: 100). - [self atEnd or: [(element := self next) = anObject]] - whileFalse: [newStream nextPut: element]. - ^newStream contents! Item was changed: ----- Method: PositionableStream>>upToAll: (in category 'accessing') ----- upToAll: aCollection "Answer a subcollection from the current access position to the occurrence (if any, but not inclusive) of aCollection. If aCollection is not in the stream, answer the entire rest of the stream." | startPos endMatch result | startPos := self position. (self match: aCollection) ifTrue: [endMatch := self position. self position: startPos. + result := self upToPosition: endMatch - aCollection size. - result := self next: endMatch - startPos - aCollection size. self position: endMatch. ^ result] ifFalse: [self position: startPos. ^ self upToEnd]! Item was added: + ----- Method: PositionableStream>>upToPosition: (in category 'accessing') ----- + upToPosition: anInteger + "Answer a subcollection containing items starting from the current position and ending including the given position. Usefully different to #next: in that in the case of MultiByteFileStream, and perhaps others, positions measure in terms of encoded items, while #next: convention is to name a number of items, independent of their encoding in the underlying buffer." + ^ self next: anInteger - position + ! 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: + QuotedPrintableMimeConverter subclass: #QEncodingMimeConverter + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Collections-Streams'! + + !QEncodingMimeConverter commentStamp: 'pre 4/30/2018 12:13' prior: 0! + I do q format MIME decoding as specified in RFC 2047 ""MIME Part Three: Message Header Extensions for Non-ASCII Text". See String>>decodeMimeHeader! Item was added: + ----- Method: QEncodingMimeConverter>>encodeChar:to: (in category 'private-encoding') ----- + encodeChar: aChar to: aStream + + aChar = Character space + ifTrue: [^ aStream nextPut: $_]. + ^ super encodeChar: aChar to: aStream! Item was added: + ----- Method: QEncodingMimeConverter>>encodeWord: (in category 'private-encoding') ----- + encodeWord: aString + + | characterEncodedString | + (aString noneSatisfy: [:c | self conversionNeededFor: c]) + ifTrue: [^ aString]. + + characterEncodedString := aString squeakToUtf8. + + ^ String streamContents: [:stream | + stream nextPutAll: '=?UTF-8?Q?'. + characterEncodedString do: [:c | self encodeChar: c to: stream]. + stream nextPutAll: '?=']! Item was added: + ----- Method: QEncodingMimeConverter>>mimeDecode (in category 'conversion') ----- + mimeDecode + "Do conversion reading from mimeStream writing to dataStream. See String>>decodeMimeHeader for the character set handling." + + | c | + [mimeStream atEnd] whileFalse: [ + c := mimeStream next. + c = $= + ifTrue: [c := Character value: mimeStream next digitValue * 16 + + mimeStream next digitValue] + ifFalse: [c = $_ ifTrue: [c := $ ]]. + dataStream nextPut: c]. + ^ dataStream! Item was added: + ----- Method: QEncodingMimeConverter>>mimeEncode (in category 'conversion') ----- + mimeEncode + "Do conversion reading from dataStream writing to mimeStream. Break long lines and escape non-7bit chars." + + | currentWord encodedWord | + + [dataStream atEnd] whileFalse: [ + self readUpToWordInto: mimeStream. + currentWord := self readWord. + encodedWord := self encodeWord: currentWord. + mimeStream nextPutAll: encodedWord]. + + ^ mimeStream! Item was added: + ----- Method: QEncodingMimeConverter>>readUpToWordInto: (in category 'private-encoding') ----- + readUpToWordInto: aStream + + | currentCharacter | + [dataStream atEnd] whileFalse: + [currentCharacter := dataStream peek. + currentCharacter isSeparator + ifTrue: [aStream nextPut: currentCharacter. + dataStream next] + ifFalse: [^ true]]! Item was added: + ----- Method: QEncodingMimeConverter>>readWord (in category 'private-encoding') ----- + readWord + + | strm | + strm := WriteStream on: (String new: 20). + [dataStream atEnd] whileFalse: [ + dataStream peek isSeparator + ifTrue: [^ strm contents] + ifFalse: [strm nextPut: dataStream next]]. + ^ strm contents! Item was added: + ----- Method: QEncodingMimeConverter>>reservedCharacters (in category 'private-encoding') ----- + reservedCharacters + + ^ '?=_ ' ! Item was changed: MimeConverter subclass: #QuotedPrintableMimeConverter instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Collections-Streams'! + !QuotedPrintableMimeConverter commentStamp: 'pre 4/30/2018 12:13' prior: 0! + I do "quoted printable" MIME decoding as specified in RFC 2045 "MIME Part One: Format of Internet Message Bodies". - !QuotedPrintableMimeConverter commentStamp: '<historical>' prior: 0! - I do quoted printable MIME decoding as specified in RFC 2045 "MIME Part One: Format of Internet Message Bodies". Short version of RFC2045, Sect. 6.7: (1) Any octet, except a CR or LF that is part of a CRLF line break of the canonical (standard) form of the data being encoded, may be represented by an "=" followed by a two digit hexadecimal representation of the octet's value. [...] (2) Octets with decimal values of 33 through 60 inclusive, and 62 through 126, inclusive, MAY be represented as the US-ASCII characters which correspond to those octets [...]. (3) Octets with values of 9 and 32 MAY be represented as US-ASCII TAB (HT) and SPACE characters, respectively, but MUST NOT be so represented at the end of an encoded line. [...] (4) A line break in a text body, represented as a CRLF sequence in the text canonical form, must be represented by a (RFC 822) line break, which is also a CRLF sequence, in the Quoted-Printable encoding. [...] (5) The Quoted-Printable encoding REQUIRES that encoded lines be no more than 76 characters long. If longer lines are to be encoded with the Quoted-Printable encoding, "soft" line breaks must be used. An equal sign as the last character on a encoded line indicates such a non-significant ("soft") line break in the encoded text. + --bf 11/27/1998 16:50 + (2) simply states that 33 to 126 can be represented by US-ASCII except of the equal-sign itself + + --pre! - --bf 11/27/1998 16:50! Item was added: + ----- Method: QuotedPrintableMimeConverter>>conversionNeededFor: (in category 'conversion') ----- + conversionNeededFor: aCharacter + + ^ ((aCharacter asciiValue between: 32 and: 127) not and: [aCharacter asciiValue ~= 9]) + or: [self reservedCharacters includes: aCharacter]! Item was added: + ----- Method: QuotedPrintableMimeConverter>>encodeChar:to: (in category 'private - encoding') ----- + encodeChar: aChar to: aStream + + (self conversionNeededFor: aChar) + ifFalse: [aStream nextPut: aChar] + ifTrue: [aStream nextPut: $=; + nextPut: (Character digitValue: aChar asciiValue // 16); + nextPut: (Character digitValue: aChar asciiValue \\ 16)]. + + + ! Item was changed: ----- Method: QuotedPrintableMimeConverter>>mimeDecode (in category 'conversion') ----- mimeDecode "Do conversion reading from mimeStream writing to dataStream" + | line lineStream c1 v1 c2 v2 | - | line s c1 v1 c2 v2 | [(line := mimeStream nextLine) isNil] whileFalse: [ line := line withoutTrailingBlanks. + line + ifEmpty: [dataStream cr] + ifNotEmpty: [ + lineStream := ReadStream on: line. + [dataStream nextPutAll: (lineStream upTo: $=). + lineStream atEnd] whileFalse: [ + c1 := lineStream next. v1 := c1 digitValue. + ((v1 between: 0 and: 15) and: [lineStream atEnd not]) - line size = 0 - ifTrue: [dataStream cr] - ifFalse: [ - s := ReadStream on: line. - [dataStream nextPutAll: (s upTo: $=). - s atEnd] whileFalse: [ - c1 := s next. v1 := c1 digitValue. - ((v1 between: 0 and: 15) and: [s atEnd not]) ifFalse: [dataStream nextPut: $=; nextPut: c1] + ifTrue: [c2 := lineStream next. v2 := c2 digitValue. - ifTrue: [c2 := s next. v2 := c2 digitValue. (v2 between: 0 and: 15) ifFalse: [dataStream nextPut: $=; nextPut: c1; nextPut: c2] ifTrue: [dataStream nextPut: (Character value: v1 * 16 + v2)]]]. + (line last ~= $= and: [mimeStream atEnd not]) ifTrue: [dataStream cr]]]. - line last = $= ifFalse: [dataStream cr]]]. ^ dataStream! Item was added: + ----- Method: QuotedPrintableMimeConverter>>mimeEncode (in category 'conversion') ----- + mimeEncode + "Do conversion reading from dataStream writing to mimeStream. Break long lines and escape non-7bit chars." + + | currentCharacter line lineStream linePosition | + currentCharacter := nil. + [(line := dataStream nextLine) isNil] whileFalse: [ + lineStream := ReadStream on: line. + linePosition := 0. + + [lineStream atEnd] whileFalse: [ + currentCharacter := lineStream next. + self encodeChar: currentCharacter to: mimeStream. + linePosition := linePosition + 1. + linePosition = 73 ifTrue: [mimeStream nextPut: $=; crlf. linePosition := 0]]. + dataStream atEnd ifFalse: [mimeStream crlf]]. + ^ mimeStream! Item was added: + ----- Method: QuotedPrintableMimeConverter>>reservedCharacters (in category 'private - encoding') ----- + reservedCharacters + + ^ '=' ! Item was removed: - QuotedPrintableMimeConverter subclass: #RFC2047MimeConverter - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'Collections-Streams'! - - !RFC2047MimeConverter commentStamp: '<historical>' prior: 0! - I do quoted printable MIME decoding as specified in RFC 2047 ""MIME Part Three: Message Header Extensions for Non-ASCII Text". See String>>decodeMimeHeader! Item was removed: - ----- Method: RFC2047MimeConverter>>encodeChar:to: (in category 'private-encoding') ----- - encodeChar: aChar to: aStream - - aChar = Character space - ifTrue: [^ aStream nextPut: $_]. - ((aChar asciiValue between: 32 and: 127) and: [('?=_' includes: aChar) not]) - ifTrue: [^ aStream nextPut: aChar]. - aStream nextPut: $=; - nextPut: (Character digitValue: aChar asciiValue // 16); - nextPut: (Character digitValue: aChar asciiValue \\ 16) - ! Item was removed: - ----- Method: RFC2047MimeConverter>>encodeWord: (in category 'private-encoding') ----- - encodeWord: aString - - (aString allSatisfy: [:c | c asciiValue < 128]) - ifTrue: [^ aString]. - ^ String streamContents: [:stream | - stream nextPutAll: '=?iso-8859-1?Q?'. - aString do: [:c | self encodeChar: c to: stream]. - stream nextPutAll: '?=']! Item was removed: - ----- Method: RFC2047MimeConverter>>isStructuredField: (in category 'private-encoding') ----- - isStructuredField: aString - - | fName | - fName := aString copyUpTo: $:. - ('Resent' sameAs: (fName copyUpTo: $-)) - ifTrue: [fName := fName copyFrom: 8 to: fName size]. - ^#('Sender' 'From' 'Reply-To' 'To' 'cc' 'bcc') anySatisfy: [:each | fName sameAs: each]! Item was removed: - ----- Method: RFC2047MimeConverter>>mimeDecode (in category 'conversion') ----- - mimeDecode - "Do conversion reading from mimeStream writing to dataStream. See String>>decodeMimeHeader" - - | c | - [mimeStream atEnd] whileFalse: [ - c := mimeStream next. - c = $= - ifTrue: [c := Character value: mimeStream next digitValue * 16 - + mimeStream next digitValue] - ifFalse: [c = $_ ifTrue: [c := $ ]]. - dataStream nextPut: c]. - ^ dataStream! Item was removed: - ----- Method: RFC2047MimeConverter>>mimeEncode (in category 'conversion') ----- - mimeEncode - "Do conversion reading from dataStream writing to mimeStream. Break long lines and escape non-7bit chars." - - | word pos wasGood isGood max | - true ifTrue: [mimeStream nextPutAll: dataStream upToEnd]. - pos := 0. - max := 72. - wasGood := true. - [dataStream atEnd] whileFalse: [ - word := self readWord. - isGood := word allSatisfy: [:c | c asciiValue < 128]. - wasGood & isGood ifTrue: [ - pos + word size < max - ifTrue: [dataStream nextPutAll: word. - pos := pos + word size] - ifFalse: [] - ] - ]. - ^ mimeStream! Item was removed: - ----- Method: RFC2047MimeConverter>>readWord (in category 'private-encoding') ----- - readWord - - | strm | - strm := WriteStream on: (String new: 20) - dataStream skipSeparators. - [dataStream atEnd] whileFalse: - [ | c | - c := dataStream next. - strm nextPut: c. - c isSeparator ifTrue: [^ strm contents]]. - ^ strm contents! Item was changed: ----- Method: RWBinaryOrTextStream>>next (in category 'accessing') ----- next + isBinary ifFalse: [ ^super next ]. + ^super next ifNotNil: [ :character | character asInteger ]! - | byte | - ^ isBinary - ifTrue: [byte := super next. - byte ifNil: [nil] ifNotNil: [byte asciiValue]] - ifFalse: [super next]. - ! Item was changed: + ----- Method: RWBinaryOrTextStream>>setFileTypeToObject (in category 'properties-setting') ----- - ----- Method: RWBinaryOrTextStream>>setFileTypeToObject (in category 'as yet unclassified') ----- setFileTypeToObject "do nothing. We don't have a file type"! Item was changed: ----- Method: RWBinaryOrTextStream>>upTo: (in category 'accessing') ----- upTo: anObject "fast version using indexOf:" | start end | - start := position+1. isBinary ifTrue: [ anObject isInteger ifFalse: [ ^self upToEnd ] ] ifFalse: [ anObject isCharacter ifFalse: [ ^self upToEnd ] ]. + start := position + 1. + end := collection indexOf: anObject asCharacter startingAt: start. - end := collection indexOf: anObject asCharacter startingAt: start ifAbsent: [ 0 ]. "not present--return rest of the collection" (end = 0 or: [end > readLimit]) ifTrue: [ ^self upToEnd ]. "skip to the end and return the data passed over" position := end. ^((isBinary ifTrue: [ ByteArray ] ifFalse: [ String ]) new: end - start) replaceFrom: 1 to: end - start with: collection startingAt: start! Item was added: + ArrayedCollection subclass: #RawBitsArray + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Collections-Arrayed'! + + !RawBitsArray commentStamp: 'nice 5/10/2020 16:48' prior: 0! + RawBitsArray is an abstract superclass for all arrays whose elements are not stored as pointer but as raw bits of fixed-width. + See Behavior>>#isBits. + Currently, SpurVM supports arrays of elements with a bit-width of 8, 16, 32, or 64 bits. + When accessing a specific element with #basicAt: or #basicAt:put:, the bits are exchanged under the form of an unsigned Integer. + The range of such integer must be between 0 and 2**bitWidth-1. + + The subclasses are free to re-interpret those bits as more specialized Objects. + Unless they represent unisgned Integers, they shall define at least two methods: + - #at:put: should take an object as argument and encode it into raw bits (an unsigned Integer no longer than expected bit-width) + - #at: should convert the raw bits into an Object + Note that SpurVM supports conversion to/from signed integer via primitives 165 and 166. + + The name of subclasses is historical and constrained by backward compatibility.! Item was added: + ----- Method: RawBitsArray class>>isAbstract (in category 'testing') ----- + isAbstract + "RawBitsArray and abstract subclasses such as SignedIntegerArray and UnsignedIntegerArray + are not bits classes. So use isBits to distinguish between concrete subclasses that are bits." + ^self isBits not! Item was added: + ----- Method: RawBitsArray>>atAllPut: (in category 'accessing') ----- + atAllPut: anObject + self isEmpty ifTrue: [^self]. + "Note: #primFill: (primitiveConstantFill) does only handle unsigned integer. + Let at:put: take care of properly encoding anObject as bits" + self at: 1 put: anObject. + self primFill: (self basicAt: 1)! Item was added: + ----- Method: RawBitsArray>>primFill: (in category 'private') ----- + primFill: aPositiveInteger + "Fill the receiver, an indexable bytes or words object, with the given positive integer. + The range of possible fill values is : + - [0..255] for byte arrays; + - [0..65535] for double byte arrays; + - [0..(2^32 - 1)] for word arrays; + - [0..(2^64 - 1)] for double word arrays." + + <primitive: 145> + self errorImproperStore.! Item was added: + ----- Method: ReadStream>>contentsFrom:to: (in category 'accessing') ----- + contentsFrom: startIndex to: stopIndex + "Answer with a copy of my collection from startIndex to stopIndex." + + ^collection copyFrom: (initialPositionOrNil ifNil: [1]) + startIndex - 1 to: ((initialPositionOrNil ifNil: [1]) + stopIndex - 1 min: readLimit)! Item was added: + ----- Method: ReadStream>>match: (in category 'positioning') ----- + match: subCollection + "Faster version than the one implemented by super, but due to my subclasses breaking various invariants true for actual ReadStreams, only use it when the receiver's class is ReadStream." + + | matchPosition | + self class == ReadStream ifFalse: [ ^super match: subCollection ]. + subCollection isEmpty ifTrue: [ ^true ]. + matchPosition := collection indexOfSubCollection: subCollection startingAt: position + 1. + matchPosition = 0 ifTrue: [ + position := readLimit. + ^false ]. + matchPosition <= readLimit ifFalse: [ ^false ]. + position := matchPosition + subCollection size - 1. + ^true! Item was added: + ----- Method: ReadStream>>skipTo: (in category 'accessing') ----- + skipTo: anObject + "fast version using indexOf:" + + (position := collection indexOf: anObject startingAt: position + 1) = 0 ifTrue: [ + "not present. consume all characters" + position := readLimit. + ^false ]. + ^true! Item was added: + ----- Method: ReadStream>>take: (in category 'collections - accessing') ----- + take: maxNumberOfElements + "Overridden for efficiency." + + ^ self next: maxNumberOfElements! Item was changed: ----- Method: ReadStream>>upTo: (in category 'accessing') ----- upTo: anObject "fast version using indexOf:" | start end | start := position+1. + end := collection indexOf: anObject startingAt: start. - end := collection indexOf: anObject startingAt: start ifAbsent: [ 0 ]. "not present--return rest of the collection" (end = 0 or: [end > readLimit]) ifTrue: [ ^self upToEnd ]. "skip to the end and return the data passed over" position := end. ^collection copyFrom: start to: (end-1)! Item was changed: ----- Method: ReadStream>>upToAnyOf:do: (in category 'accessing') ----- upToAnyOf: aCollection do: aBlock "Overriden for speed" | end result | + end := collection indexOfAnyOf: aCollection startingAt: 1 + position. - end := collection indexOfAnyOf: aCollection startingAt: 1 + position ifAbsent: [0]. (end = 0 or: [end > readLimit]) ifTrue: [^self upToEnd]. result := collection copyFrom: 1 + position to: -1 + end. position := end. aBlock value: (collection at: end). ^result! Item was added: + ----- Method: ReadWriteStream>>take: (in category 'collections - accessing') ----- + take: maxNumberOfElements + "Overridden for efficiency." + + ^ self next: maxNumberOfElements! 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>>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: + 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 changed: ----- Method: RunArray class>>scanFrom: (in category 'instance creation') ----- scanFrom: strm "Read the style section of a fileOut or sources file. nextChunk has already been done. We need to return a RunArray of TextAttributes of various kinds. These are written by the implementors of writeScanOn:" | runs values attrList char | (strm peekFor: $( ) ifFalse: [^ nil]. runs := OrderedCollection new. [strm skipSeparators. strm peekFor: $)] whileFalse: [runs add: (Number readFrom: strm)]. values := OrderedCollection new. "Value array" attrList := OrderedCollection new. "Attributes list" [(char := strm peek) == nil] whileFalse: [ (char isSeparator or: [ char = $!! ]) ifTrue: [ "n.b. Skip $!! to meet expectations of RunArrayTest>>testScanFromTrailer. The example string used in that test does not seem to match the implemention of the fileOut serialization, but the test may be right and the implementation wrong. In any case, relax the parsing here to meet the test expectations, and to be more consistent with the original version of this method that assumed any unexpected charater to be a separator. -dtl Jan 2014" strm next "space, cr do nothing"] ifFalse: [char == $, ifTrue: [strm next. values add: attrList asArray. + attrList reset ] - attrList := OrderedCollection new] ifFalse: [attrList add: (TextAttribute newFrom: strm)] ] ]. values add: attrList asArray. ^ self runs: runs asArray values: (values copyFrom: 1 to: runs size) asArray " RunArray scanFrom: (ReadStream on: '(14 50 312)f1,f1b,f1LInteger +;i') "! Item was changed: + ----- Method: RunArray>>= (in category 'comparing') ----- + = anObject + self == anObject ifTrue: [^ true]. + ^anObject class == self class + and: + [(runs hasEqualElements: anObject runs) + and: [values hasEqualElements: anObject values]]! - ----- Method: RunArray>>= (in category 'accessing') ----- - = otherArray - "Test if all my elements are equal to those of otherArray" - - (otherArray isMemberOf: RunArray) ifFalse: [^ self hasEqualElements: otherArray]. - - "Faster test between two RunArrays" - ^ (runs hasEqualElements: otherArray runs) - and: [values hasEqualElements: otherArray values]! Item was added: + ----- Method: RunArray>>add:withOccurrences: (in category 'adding') ----- + add: value withOccurrences: times + "Add value as the last element of the receiver, the given number of times" + times = 0 ifTrue: [ ^self ]. + lastIndex := nil. "flush access cache" + (runs size=0 or: [values last ~= value]) + ifTrue: + [runs := runs copyWith: times. + values := values copyWith: value] + ifFalse: + [runs at: runs size put: runs last+times]! Item was removed: - ----- Method: RunArray>>addLast:times: (in category 'adding') ----- - addLast: value times: times - "Add value as the last element of the receiver, the given number of times" - times = 0 ifTrue: [ ^self ]. - lastIndex := nil. "flush access cache" - (runs size=0 or: [values last ~= value]) - ifTrue: - [runs := runs copyWith: times. - values := values copyWith: value] - ifFalse: - [runs at: runs size put: runs last+times]! 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>>at: (in category 'accessing') ----- at: index + self at: index setRunOffsetAndValue: [:run :offset :value | + offset < 0 ifTrue: [ self errorSubscriptBounds: index ]. + offset >= (runs at: run) ifTrue: [ self errorSubscriptBounds: index ]. + ^value]! - self at: index setRunOffsetAndValue: [:run :offset :value | ^value]! Item was added: + ----- Method: RunArray>>atPin: (in category 'accessing') ----- + atPin: index + + self at: index setRunOffsetAndValue: [:run :offset :value | ^value]! 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>>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>>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>>keysAndValuesDo: (in category 'enumerating') ----- + keysAndValuesDo: aBlock + "This is refined for speed" + + | index | + index := 0. + 1 to: runs size do: [:i | + | r v | + v := values at: i. + r := runs at: i. + [( r := r - 1) >= 0] + whileTrue: [aBlock value: (index := index + 1) value: v]].! 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 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 := runs copyEmpty. + values := values copyEmpty! 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>>withIndexDo: (in category 'enumerating') ----- + withIndexDo: aBlock + "This is refined for speed" + + | index | + index := 0. + 1 to: runs size do: [:i | + | r v | + v := values at: i. + r := runs at: i. + [( r := r - 1) >= 0] + whileTrue: [aBlock value: v value: (index := index + 1)]].! Item was added: + ----- Method: SequenceableCollection class>>isAbstract (in category 'testing') ----- + isAbstract + ^self = SequenceableCollection! Item was changed: ----- Method: SequenceableCollection>>= (in category 'comparing') ----- = otherCollection "Answer true if the receiver is equivalent to the otherCollection. + First test for identity, then rule out different class and sizes of - First test for identity, then rule out different species and sizes of collections. As a last resort, examine each element of the receiver and the otherCollection." self == otherCollection ifTrue: [^ true]. + self class = otherCollection class ifFalse: [^ false]. - self species == otherCollection species ifFalse: [^ false]. ^ self hasEqualElements: otherCollection! Item was added: + ----- Method: SequenceableCollection>>any: (in category 'accessing') ----- + any: numberOfElements + + ^ self first: numberOfElements! Item was added: + ----- Method: SequenceableCollection>>asFloat32Array (in category 'converting') ----- + asFloat32Array + "Answer a Float32Array whose elements are the elements of the receiver, in + the same order." + + | floatArray | + floatArray := Float32Array new: self size. + 1 to: self size do:[:i| floatArray at: i put: (self at: i) asFloat ]. + ^floatArray! Item was added: + ----- Method: SequenceableCollection>>asFloat64Array (in category 'converting') ----- + asFloat64Array + "Answer a Float64Array whose elements are the elements of the receiver, in + the same order." + + | floatArray | + floatArray := Float64Array new: self size. + 1 to: self size do:[:i| floatArray at: i put: (self at: i) asFloat ]. + ^floatArray! Item was changed: ----- Method: SequenceableCollection>>asFloatArray (in category 'converting') ----- asFloatArray + "For backward compatibility, answer a 32 bits FloatArray" - "Answer a FloatArray whose elements are the elements of the receiver, in - the same order." + ^self asFloat32Array! - | floatArray | - floatArray := FloatArray new: self size. - 1 to: self size do:[:i| floatArray at: i put: (self at: i) asFloat ]. - ^floatArray! Item was added: + ----- Method: SequenceableCollection>>at:ifPresent: (in category 'accessing') ----- + at: index ifPresent: aBlock + + ^ self at: index ifPresent: aBlock ifAbsent: []! Item was added: + ----- Method: SequenceableCollection>>at:ifPresent:ifAbsent: (in category 'accessing') ----- + at: index ifPresent: elementBlock ifAbsent: exceptionBlock + "Answer the value of elementBlock on the element at position index. If I do not contain an element at index, answer the result of evaluating exceptionBlock." + ^ elementBlock value: + (self + at: index + ifAbsent: [ ^ exceptionBlock value ])! Item was changed: ----- Method: SequenceableCollection>>atAllPut: (in category 'accessing') ----- atAllPut: anObject "Put anObject at every one of the receiver's indices." | size | + (size := self size) > 50 "first method faster for larger sizes; see below" - (size := self size) > 26 "first method faster from 27 accesses and on" ifTrue: [self from: 1 to: size put: anObject] + ifFalse: [1 to: size do: [:index | self at: index put: anObject]] + + "Here's code to test what's a good cross over." + "(1 to: 3) collect: + [:j| + { Array. ByteArray. FloatArray. WordArray } collect: + [:class| | a e | + a := class new: 250. + e := a at: 1. + (1 to: a size) detect: + [:n| | t1 t2 | + t1 := [1 to: 1000 do: [:i| a from: 1 to: n put: e]] timeToRun. + t2 := [1 to: 1000 do: [:i| 1 to: n do: [:index | a at: index put: e]]] timeToRun. + t1 < t2]]]" + "32-bit Spur x86 #(#(69 54 9 63) #(64 52 10 55) #(63 53 9 61))" + "64-bit Spur x86-64 #(#(63 50 10 55) #(60 48 10 54) #(63 44 9 50))"! - ifFalse: [1 to: size do: [:index | self at: index put: anObject]]! Item was added: + ----- Method: SequenceableCollection>>atLast:ifPresent: (in category 'accessing') ----- + atLast: indexFromEnd ifPresent: elementBlock + + ^ self + at: self size + 1 - indexFromEnd + ifPresent: elementBlock + ifAbsent: []! Item was added: + ----- Method: SequenceableCollection>>atLast:ifPresent:ifAbsent: (in category 'accessing') ----- + atLast: indexFromEnd ifPresent: elementBlock ifAbsent: exceptionBlock + "Answer the value of elementBlock on the element at indexFromEnd from the last position. If the receiver does not contain an element at this position, answer the result of evaluating exceptionBlock." + + ^ self + at: self size + 1 - indexFromEnd + ifPresent: elementBlock + ifAbsent: exceptionBlock! Item was changed: ----- Method: SequenceableCollection>>beginsWith: (in category 'testing') ----- beginsWith: sequence + "Answer if the receiver starts with the argument collection." - "Answer true if the receiver starts with the argument collection." | sequenceSize | + sequenceSize := sequence size. + self size < sequenceSize ifTrue: [ ^false ]. - ((sequenceSize := sequence size) = 0 or: [ self size < sequence size ]) ifTrue: [ ^false ]. 1 to: sequenceSize do: [ :index | (sequence at: index) = (self at: index) ifFalse: [ ^false ] ]. ^true! Item was removed: - ----- Method: SequenceableCollection>>collectWithIndex: (in category 'enumerating') ----- - collectWithIndex: elementAndIndexBlock - "Use the new version with consistent naming" - ^ self withIndexCollect: elementAndIndexBlock! Item was changed: ----- Method: SequenceableCollection>>combinationsAt:in:after:do: (in category 'private') ----- combinationsAt: jj in: aCollection after: nn do: aBlock "Choose k of N items and put in aCollection. jj-1 already chosen. Indexes of items are in numerical order, to avoid the same combo being used twice. In this slot, we are allowed to use items in self indexed by nn+1 to self size. nn is the index used for position jj-1." + "(1 to: 6) combinations: 3 atATimeDo: [:each | Transcript cr; show: each printString]" - "(1 to: 6) combinationsSize: 3 do: [:each | Transcript cr; show: each printString]" nn+1 to: self size do: [:index | aCollection at: jj put: (self at: index). jj = aCollection size ifTrue: [aBlock value: aCollection] ifFalse: [self combinationsAt: jj + 1 in: aCollection after: index do: aBlock]].! Item was changed: ----- Method: SequenceableCollection>>copyReplaceAll:with:asTokens: (in category 'private') ----- copyReplaceAll: oldSubstring with: newSubstring asTokens: ifTokens "Answer a copy of the receiver in which all occurrences of oldSubstring have been replaced by newSubstring. ifTokens (valid for Strings only) specifies that the characters surrounding the recplacement must not be alphanumeric. Bruce Simth, must be incremented by 1 and not newSubstring if ifTokens is true. See example below. " + | currentIndex | + (ifTokens and: [ self isString not and: [ self isText not ] ]) ifTrue: [ + self error: 'Token replacement only valid for Strings' ]. + (currentIndex := self indexOfSubCollection: oldSubstring startingAt: 1) = 0 ifTrue: [ ^self copy ]. + oldSubstring size = newSubstring size ifTrue: [ "Special case" + | string startSearch endIndex | + string := self species withAll: self. + startSearch := 1. + [ + endIndex := currentIndex + oldSubstring size - 1. + (ifTokens and: [ + (currentIndex > 1 and: [ (self at: currentIndex - 1) isAlphaNumeric ]) + or: [ endIndex < self size and: [ (self at: endIndex + 1) isAlphaNumeric ] ] ]) + ifFalse: [ "match" + string + replaceFrom: currentIndex + to: endIndex + with: newSubstring + startingAt: 1 ]. + startSearch := endIndex + 1. + (currentIndex := self indexOfSubCollection: oldSubstring startingAt: startSearch) = 0 ] whileFalse. + ^string ]. + ^self species new: self size streamContents: [ :stream | + | startSearch endIndex | + startSearch := 1. + [ + endIndex := currentIndex + oldSubstring size - 1. + (ifTokens and: [ + (currentIndex > 1 and: [ (self at: currentIndex - 1) isAlphaNumeric ]) + or: [ endIndex < self size and: [ (self at: endIndex + 1) isAlphaNumeric ] ] ]) + ifFalse: [ "match" + stream + next: currentIndex - startSearch + putAll: self + startingAt: startSearch; + nextPutAll: newSubstring ] + ifTrue: [ + stream + next: currentIndex - startSearch + oldSubstring size + putAll: self + startingAt: startSearch ]. + startSearch := endIndex + 1. + (currentIndex := self indexOfSubCollection: oldSubstring startingAt: startSearch) = 0 ] whileFalse. + stream + next: self size - startSearch + 1 + putAll: self + startingAt: startSearch ] - | aString startSearch currentIndex endIndex | - (ifTokens and: [(self isString) not]) - ifTrue: [(self isKindOf: Text) ifFalse: [ - self error: 'Token replacement only valid for Strings']]. - aString := self. - startSearch := 1. - [(currentIndex := aString indexOfSubCollection: oldSubstring startingAt: startSearch) - > 0] - whileTrue: - [endIndex := currentIndex + oldSubstring size - 1. - (ifTokens not - or: [(currentIndex = 1 - or: [(aString at: currentIndex-1) isAlphaNumeric not]) - and: [endIndex = aString size - or: [(aString at: endIndex+1) isAlphaNumeric not]]]) - ifTrue: [aString := aString - copyReplaceFrom: currentIndex - to: endIndex - with: newSubstring. - startSearch := currentIndex + newSubstring size] - ifFalse: [ - ifTokens - ifTrue: [startSearch := currentIndex + 1] - ifFalse: [startSearch := currentIndex + newSubstring size]]]. - ^ aString "Test case: + 'test te string' copyReplaceAll: 'te' with: 'longone' asTokens: true "! - 'test te string' copyReplaceAll: 'te' with: 'longone' asTokens: true " - ! Item was changed: ----- Method: SequenceableCollection>>copyReplaceFrom:to:with: (in category 'copying') ----- copyReplaceFrom: start to: stop with: replacementCollection "Answer a copy of the receiver satisfying the following conditions: If stop is less than start, then this is an insertion; stop should be exactly start-1, start = 1 means insert before the first character, start = size+1 means append after last character. Otherwise, this is a replacement; start and stop have to be within the receiver's bounds." | newSequenceableCollection newSize endReplacement | - newSize := self size - (stop - start + 1) + replacementCollection size. endReplacement := start - 1 + replacementCollection size. + newSize := self size + endReplacement - stop. newSequenceableCollection := self species new: newSize. start > 1 ifTrue:[ newSequenceableCollection replaceFrom: 1 to: start - 1 with: self startingAt: 1]. start <= endReplacement ifTrue:[ newSequenceableCollection replaceFrom: start to: endReplacement with: replacementCollection startingAt: 1]. endReplacement < newSize ifTrue:[ newSequenceableCollection replaceFrom: endReplacement + 1 to: newSize with: self startingAt: stop + 1]. ^newSequenceableCollection! Item was removed: - ----- Method: SequenceableCollection>>doWithIndex: (in category 'enumerating') ----- - doWithIndex: elementAndIndexBlock - "Use the new version with consistent naming" - ^ self withIndexDo: elementAndIndexBlock! Item was changed: ----- Method: SequenceableCollection>>endsWith: (in category 'testing') ----- endsWith: sequence + "Answer if the receiver ends with the argument collection." - "Answer true if the receiver ends with the argument collection." | sequenceSize offset | + sequenceSize := sequence size. + (offset := self size - sequenceSize) < 0 ifTrue: [ ^false ]. - ((sequenceSize := sequence size) = 0 or: [ (offset := self size - sequence size) < 0 ]) ifTrue: [ ^false ]. 1 to: sequenceSize do: [ :index | (sequence at: index) = (self at: index + offset) ifFalse: [ ^false ] ]. ^true! Item was changed: ----- Method: SequenceableCollection>>errorFirstObject: (in category 'private') ----- errorFirstObject: anObject + + ^ self error: 'Specified object is first object' translated! - self error: 'specified object is first object'! Item was changed: ----- Method: SequenceableCollection>>errorLastObject: (in category 'private') ----- errorLastObject: anObject + + ^ self error: 'Specified object is last object' translated! - self error: 'specified object is last object'! Item was changed: ----- Method: SequenceableCollection>>errorOutOfBounds (in category 'private') ----- errorOutOfBounds + ^ self error: 'Indices are out of bounds' translated! - self error: 'indices are out of bounds'! Item was changed: ----- Method: SequenceableCollection>>findBinaryIndex:do:ifNone: (in category 'enumerating') ----- findBinaryIndex: aBlock do: actionBlock ifNone: exceptionBlock "Search for an element in the receiver using binary search. The argument aBlock is a one-element block returning 0 - if the element is the one searched for <0 - if the search should continue in the first half >0 - if the search should continue in the second half If found, evaluate actionBlock with the index as argument If no matching element is found, evaluate exceptionBlock, with the indexes of the 'bounding' elements as optional arguments. Warning: Might give invalid indexes, see examples below. Examples: #(1 3 5 7 11 15 23) findBinaryIndex: [ :arg | 11 - arg ] do: [ :found | found ] ifNone: [ :a :b | ('between: ', {a. b} printString)] #(1 3 5 7 11 15 23) findBinaryIndex: [ :arg | 12 - arg ] do: [ :found | found ] ifNone: [ :a :b | ('between: ', {a. b} printString) ] #(1 3 5 7 11 15 23) d findBinaryIndex: [ :arg | 0.5 - arg ] do: [ :found | found ] ifNone: [ :a :b | ('between: ', {a. b} printString) ] #(1 3 5 7 11 15 23) findBinaryIndex: [ :arg | 25 - arg ] do: [ :found | found ] ifNone: [ :a :b | ('between: ',{a. b} printString) ] " + | index low high test | - | index low high | low := 1. high := self size. + [ high < low ] whileFalse: [ + index := high + low // 2. + (test := aBlock value: (self at: index)) < 0 + ifTrue: [ high := index - 1 ] + ifFalse: [ + 0 < test - [ - index := high + low // 2. - low > high ] whileFalse: [ - | test | - test := aBlock value: (self at: index). - test = 0 - ifTrue: [ ^actionBlock value: index ] - ifFalse: [ test > 0 ifTrue: [ low := index + 1 ] + ifFalse: [ "test = 0" + ^actionBlock value: index ] ] ]. - ifFalse: [ high := index - 1 ] ] ]. ^exceptionBlock cull: high cull: low! Item was changed: ----- Method: SequenceableCollection>>flatten (in category 'converting') ----- flatten "Similar to #concatenation but removes all nesting except for strings. Example: {3 .4 .{2 .4 .{'hi'} .'ho'}} flatten = {3 .4 .2 .4 .'hi' .'ho'}" ^ Array streamContents: [:stream | self do: [:each | + ((each isCollection and: [each isString not]) or: [each isStream]) - (each isCollection and: [each isString not]) ifFalse: [stream nextPut: each] ifTrue: [stream nextPutAll: each flatten]]]! Item was changed: ----- Method: SequenceableCollection>>grownBy: (in category 'copying') ----- + grownBy: length - grownBy: length "Answer a copy of receiver collection with size grown by length" + ^ (self class ofSize: self size + length) + replaceFrom: 1 to: self size with: self startingAt: 1 ; + yourself! - - | newCollection | - newCollection := self species ofSize: self size + length. - newCollection replaceFrom: 1 to: self size with: self startingAt: 1. - ^ newCollection! Item was changed: ----- Method: SequenceableCollection>>identityIndexOf: (in category 'accessing') ----- identityIndexOf: anElement "Answer the index of anElement within the receiver. If the receiver does not contain anElement, answer 0." + ^self identityIndexOf: anElement startingAt: 1! - ^self identityIndexOf: anElement ifAbsent: [0]! Item was changed: ----- Method: SequenceableCollection>>identityIndexOf:ifAbsent: (in category 'accessing') ----- identityIndexOf: anElement ifAbsent: exceptionBlock "Answer the index of anElement within the receiver. If the receiver does not contain anElement, answer the result of evaluating the argument, exceptionBlock." + + | index | + (index := self identityIndexOf: anElement startingAt: 1) = 0 ifFalse: [ ^index ]. + ^exceptionBlock value! - 1 to: self size do: - [:i | (self at: i) == anElement ifTrue: [^ i]]. - ^ exceptionBlock value! Item was added: + ----- Method: SequenceableCollection>>identityIndexOf:startingAt: (in category 'accessing') ----- + identityIndexOf: anElement startingAt: startIndex + "Answer the index of anElement within the receiver starting at startIndex. + If the receiver does not contain anElement, answer 0." + + startIndex to: self size do: [ :index | + (self at: index) == anElement ifTrue: [ ^index ] ]. + ^0! Item was added: + ----- Method: SequenceableCollection>>identityIndexOf:startingAt:ifAbsent: (in category 'accessing') ----- + identityIndexOf: anElement startingAt: startIndex ifAbsent: exceptionBlock + "Answer the index of anElement within the receiver starting at startIndex. + If the receiver does not contain anElement, answer the result of evaluating + the argument, exceptionBlock." + + | index | + (index := self identityIndexOf: anElement startingAt: startIndex) = 0 ifFalse: [ ^index ]. + ^exceptionBlock value! Item was changed: ----- Method: SequenceableCollection>>indexOf: (in category 'accessing') ----- indexOf: anElement "Answer the index of the first occurence of anElement within the receiver. If the receiver does not contain anElement, answer 0." + ^self indexOf: anElement startingAt: 1! - ^ self indexOf: anElement ifAbsent: [0]! Item was changed: ----- Method: SequenceableCollection>>indexOf:ifAbsent: (in category 'accessing') ----- indexOf: anElement ifAbsent: exceptionBlock "Answer the index of the first occurence of anElement within the receiver. If the receiver does not contain anElement, answer the result of evaluating the argument, exceptionBlock." + | index | + (index := self indexOf: anElement startingAt: 1) = 0 ifFalse: [ ^index ]. + ^exceptionBlock value! - ^ self indexOf: anElement startingAt: 1 ifAbsent: exceptionBlock! Item was changed: ----- Method: SequenceableCollection>>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." + start to: self size do: [ :index | + (self at: index) = anElement ifTrue: [ ^index ] ]. + ^0! - ^self indexOf: anElement startingAt: start ifAbsent: 0! Item was changed: ----- Method: SequenceableCollection>>indexOf:startingAt:ifAbsent: (in category 'accessing') ----- indexOf: anElement startingAt: start ifAbsent: exceptionBlock "Answer the index of the first occurence of anElement after start within the receiver. If the receiver does not contain anElement, answer the result of evaluating the argument, exceptionBlock." + | index | + (index := self indexOf: anElement startingAt: start) = 0 ifFalse: [ ^index ]. + ^exceptionBlock value! - start to: self size do: - [:index | - (self at: index) = anElement ifTrue: [^ index]]. - ^ exceptionBlock value! Item was changed: ----- Method: SequenceableCollection>>indexOfAnyOf: (in category 'accessing') ----- indexOfAnyOf: aCollection "Answer the index of the first occurence of any element included in aCollection within the receiver. If the receiver does not contain anElement, answer zero, which is an invalid index." + ^self indexOfAnyOf: aCollection startingAt: 1! - ^self indexOfAnyOf: aCollection startingAt: 1 ifAbsent: [0]! Item was changed: ----- Method: SequenceableCollection>>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." + start to: self size do: [ :index | + (aCollection includes: (self at: index)) ifTrue: [ ^index ] ]. + ^0! - ^self indexOfAnyOf: aCollection startingAt: start ifAbsent: [0]! Item was changed: ----- Method: SequenceableCollection>>indexOfAnyOf:startingAt:ifAbsent: (in category 'accessing') ----- indexOfAnyOf: aCollection startingAt: start ifAbsent: exceptionBlock "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 the result of evaluating the argument, exceptionBlock. Note: it is user responsibility to provide aCollection that behaves relatevily fast when asked for includes: (like a Set)" + | index | + (index := self indexOfAnyOf: aCollection startingAt: start) = 0 ifFalse: [ ^index ]. + ^exceptionBlock value! - start to: self size do: - [:index | - (aCollection includes: (self at: index)) ifTrue: [^ index]]. - ^ exceptionBlock value! Item was added: + ----- Method: SequenceableCollection>>indexOfSubCollection: (in category 'accessing') ----- + indexOfSubCollection: aSubCollection + "Answer the index of the receiver's first element, such that that element + equals the first element of aSubCollection, and the next elements equal + the rest of the elements of aSubCollection. Begin the search at the first + element of the receiver. If no such match is found, answer 0." + + ^self + indexOfSubCollection: aSubCollection + startingAt: 1! Item was changed: ----- Method: SequenceableCollection>>indexOfSubCollection:startingAt: (in category 'accessing') ----- + indexOfSubCollection: subCollection startingAt: start - indexOfSubCollection: aSubCollection startingAt: anIndex "Answer the index of the receiver's first element, such that that element + equals the first element of sub, and the next elements equal + the rest of the elements of sub. Begin the search at element + start of the receiver. If no such match is found, answer 0." - equals the first element of aSubCollection, and the next elements equal - the rest of the elements of aSubCollection. Begin the search at element - anIndex of the receiver. If no such match is found, answer 0." + | first index subCollectionSize | + (subCollectionSize := subCollection size) = 0 ifTrue: [ ^0 ]. + first := subCollection at: 1. + (start max: 1) to: self size - subCollectionSize + 1 do: [ :startIndex | + (self at: startIndex) = first ifTrue: [ + index := 2. + [ index <= subCollectionSize + and: [ (self at: startIndex + index - 1) = (subCollection at: index) ] ] + whileTrue: [ index := index + 1 ]. + index <= subCollectionSize ifFalse: [ ^startIndex ] ] ]. + ^0! - ^self - indexOfSubCollection: aSubCollection - startingAt: anIndex - ifAbsent: [0]! Item was changed: ----- Method: SequenceableCollection>>indexOfSubCollection:startingAt:ifAbsent: (in category 'accessing') ----- indexOfSubCollection: sub startingAt: start ifAbsent: exceptionBlock "Answer the index of the receiver's first element, such that that element equals the first element of sub, and the next elements equal the rest of the elements of sub. Begin the search at element start of the receiver. If no such match is found, answer the result of evaluating argument, exceptionBlock." + + | index | + (index := self indexOfSubCollection: sub startingAt: start) = 0 ifFalse: [ ^index ]. - | first index | - sub isEmpty ifTrue: [^ exceptionBlock value]. - first := sub first. - start to: self size - sub size + 1 do: - [:startIndex | - (self at: startIndex) = first ifTrue: - [index := 1. - [(self at: startIndex+index-1) = (sub at: index)] - whileTrue: - [index = sub size ifTrue: [^startIndex]. - index := index+1]]]. ^ exceptionBlock value! Item was added: + ----- Method: SequenceableCollection>>indicesOfSubCollection: (in category 'accessing') ----- + indicesOfSubCollection: subCollection + "Answer an Array (possibly empty) of all the indices of subCollection in the receiver." + + ^self indicesOfSubCollection: subCollection startingAt: 1! Item was added: + ----- Method: SequenceableCollection>>indicesOfSubCollection:startingAt: (in category 'accessing') ----- + indicesOfSubCollection: subCollection startingAt: initialIndex + "Answer an Array (possibly empty) of all the indices of subCollection in the receiver starting at + initialIndex. N.B. This does not (yet) use Boyer-Moore to skip over unnecessary alignments." + + ^Array streamContents: + [:s| | index | + index := initialIndex - 1. + [(index := self indexOfSubCollection: subCollection startingAt: index + 1) = 0] whileFalse: + [s nextPut: index]]! Item was added: + ----- Method: SequenceableCollection>>joinOn: (in category 'printing') ----- + joinOn: stream + + ^ self joinOn: stream separatedBy: ''! Item was added: + ----- Method: SequenceableCollection>>joinOn:separatedBy: (in category 'printing') ----- + joinOn: stream separatedBy: aSeparator + + self + do: [:ea | stream nextPutAll: ea asString] + separatedBy: [stream nextPutAll: aSeparator asString].! Item was changed: ----- Method: SequenceableCollection>>joinSeparatedBy: (in category 'converting') ----- joinSeparatedBy: aSeparator + "Returns a string, which is a concatenation of each element's string representation separated by another string. + + August 2019 -- http://forum.world.st/The-Inbox-Collections-ct-827-mcz-td5099876.html + There was a discussion about whether to move this method up to Collection. We identified a trade-off between (iinterface) convenience and (result) predictability. In Collection, this method would be available for Set, too. However, random result order makes such a feature questionable. What would be the result of #(1 2 3) asSet joinSeparatedBy: '-'? For such scenarios, some people argued, it would be better to explicitely call #asArray and maybe explain why a non-sequenceable collection was used in the first place." - "Returns a string, which is a concatenation of each element's string representation separated by another string." ^ String streamContents: [:stream | + self joinOn: stream separatedBy: aSeparator]! - self - do: [:ea | stream nextPutAll: ea asString] - separatedBy: [stream nextPutAll: aSeparator asString]]! Item was changed: ----- Method: SequenceableCollection>>lastIndexOf: (in category 'accessing') ----- lastIndexOf: anElement "Answer the index of the last occurence of anElement within the receiver. If the receiver does not contain anElement, answer 0." + ^self lastIndexOf: anElement startingAt: self size! - ^ self lastIndexOf: anElement startingAt: self size ifAbsent: [0]! Item was changed: ----- Method: SequenceableCollection>>lastIndexOf:ifAbsent: (in category 'accessing') ----- lastIndexOf: anElement ifAbsent: exceptionBlock "Answer the index of the last occurence of anElement within the receiver. If the receiver does not contain anElement, answer the result of evaluating the argument, exceptionBlock." + + | index | + (index := self lastIndexOf: anElement startingAt: self size) = 0 ifFalse: [ ^index ]. + ^exceptionBlock value! - ^self lastIndexOf: anElement startingAt: self size ifAbsent: exceptionBlock! Item was added: + ----- 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." + + lastIndex to: 1 by: -1 do: [ :index | + (self at: index) = anElement ifTrue: [ ^index ] ]. + ^0! Item was changed: ----- Method: SequenceableCollection>>lastIndexOf:startingAt:ifAbsent: (in category 'accessing') ----- lastIndexOf: anElement startingAt: lastIndex ifAbsent: exceptionBlock "Answer the index of the last occurence of anElement within the receiver. If the receiver does not contain anElement, answer the result of evaluating the argument, exceptionBlock." + | index | + (index := self lastIndexOf: anElement startingAt: lastIndex) = 0 ifFalse: [ ^index ]. + ^exceptionBlock value! - lastIndex to: 1 by: -1 do: - [:index | - (self at: index) = anElement ifTrue: [^ index]]. - ^ exceptionBlock value! Item was added: + ----- Method: SequenceableCollection>>lastIndexOfAnyOf: (in category 'accessing') ----- + lastIndexOfAnyOf: aCollection + "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" + + ^self lastIndexOfAnyOf: aCollection startingAt: self size! Item was added: + ----- Method: SequenceableCollection>>lastIndexOfAnyOf:ifAbsent: (in category 'accessing') ----- + lastIndexOfAnyOf: aCollection ifAbsent: exceptionBlock + "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 the result of evaluating the argument, exceptionBlock." + + | index | + (index := self lastIndexOfAnyOf: aCollection startingAt: self size) = 0 ifFalse: [ ^index ]. + ^exceptionBlock value! Item was added: + ----- Method: SequenceableCollection>>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" + + lastIndex to: 1 by: -1 do: [ :index | + (aCollection includes: (self at: index)) ifTrue: [ ^index ] ]. + ^0! Item was changed: ----- Method: SequenceableCollection>>lastIndexOfAnyOf:startingAt:ifAbsent: (in category 'accessing') ----- lastIndexOfAnyOf: aCollection startingAt: lastIndex ifAbsent: exceptionBlock + "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 the result of evaluating the argument, exceptionBlock." - "Answer the index of the last occurence of anElement within the - receiver. If the receiver does not contain anElement, answer the - result of evaluating the argument, exceptionBlock." + | index | + (index := self lastIndexOfAnyOf: aCollection startingAt: lastIndex) = 0 ifFalse: [ ^index ]. + ^exceptionBlock value! - lastIndex to: 1 by: -1 do: - [:index | - (aCollection includes: (self at: index)) ifTrue: [^ index]]. - ^ exceptionBlock value! Item was changed: ----- Method: SequenceableCollection>>replaceAll:with: (in category 'accessing') ----- replaceAll: oldObject with: newObject "Replace all occurences of oldObject with newObject" + | index | + index := 0. + [ (index := self indexOf: oldObject startingAt: index + 1) = 0 ] + whileFalse: [ self at: index put: newObject ]! - index := self - indexOf: oldObject - startingAt: 1 - ifAbsent: [0]. - [index = 0] - whileFalse: - [self at: index put: newObject. - index := self - indexOf: oldObject - startingAt: index + 1 - ifAbsent: [0]]! Item was removed: - ----- Method: SequenceableCollection>>sortBy: (in category 'copying') ----- - sortBy: aBlock - "Create a copy that is sorted. Sort criteria is the block that accepts two arguments. - When the block is true, the first arg goes first ([:a :b | a > b] sorts in descending - order)." - - ^ self asOrderedCollection - sort: aBlock; - yourself! Item was added: + ----- Method: SequenceableCollection>>subsequences: (in category 'converting') ----- + subsequences: separatorsOrElement + "Answer an array containing the subsequences in the receiver separated + by the elements of separatorsOrElement, if it is a Collection, or a + single separator object, if it is not." + + | result size thing subsequenceStart | + result := OrderedCollection new. + size := self size. + separatorsOrElement isCollection + ifTrue: + [1 to: size do: + [:i| + thing := self at: i. + (separatorsOrElement includes: thing) + ifTrue: + [subsequenceStart ifNotNil: + [result addLast: (self copyFrom: subsequenceStart to: i - 1)]. + subsequenceStart := nil] + ifFalse: + [subsequenceStart ifNil: [subsequenceStart := i]]]] + ifFalse: + [1 to: size do: + [:i| + thing := self at: i. + separatorsOrElement = thing + ifTrue: + [subsequenceStart ifNotNil: + [result addLast: (self copyFrom: subsequenceStart to: i - 1)]. + subsequenceStart := nil] + ifFalse: + [subsequenceStart ifNil: [subsequenceStart := i]]]]. + subsequenceStart ifNotNil: + [result addLast: (self copyFrom: subsequenceStart to: size)]. + ^result asArray + + "'Now is the time for all good people to come to the aid of the cause of world peace. It is just fine, even desirable, to love your country, if that means wanting it to play a beneficial role in the course of world events and be the best possible example of a good society. But if it means wanting dominion over the rest of the world, it is not love but defensiveness or self-glorification, and will lead only to oblivion.' subStrings: Character space" + + "'Now is the time for all good people to come to the aid of the cause of world peace. It is just fine, even desirable, to love your country, if that means wanting it to play a beneficial role in the course of world events and be the best possible example of a good society. But if it means wanting dominion over the rest of the world, it is not love but defensiveness or self-glorification, and will lead only to oblivion.' subStrings: ' ,.-'"! Item was changed: ----- Method: SequenceableCollection>>with:collect: (in category 'enumerating') ----- with: otherCollection collect: twoArgBlock "Collect and return the result of evaluating twoArgBlock with corresponding elements from this collection and otherCollection." | result | + self isOfSameSizeCheck: otherCollection. - otherCollection size = self size ifFalse: [self error: 'otherCollection must be the same size']. result := self species new: self size. 1 to: self size do: [:index | result at: index put: (twoArgBlock value: (self at: index) value: (otherCollection at: index))]. ^ result! Item was changed: ----- Method: SequenceableCollection>>with:do: (in category 'enumerating') ----- with: otherCollection do: twoArgBlock "Evaluate twoArgBlock with corresponding elements from this collection and otherCollection." + self isOfSameSizeCheck: otherCollection. - otherCollection size = self size ifFalse: [self error: 'otherCollection must be the same size']. 1 to: self size do: [:index | twoArgBlock value: (self at: index) value: (otherCollection at: index)]! Item was added: + ----- Method: SequenceableCollection>>withoutDuplicates (in category 'copying') ----- + withoutDuplicates + "Answer a copy of the receiver that preserves order but eliminates any duplicates." + | seen | + seen := Set new: self size. + ^self select: [:each| seen ifAbsentAdd: each]! Item was changed: ----- Method: Set>>= (in category 'comparing') ----- + = anObject + "Two sets are equal if + (a) they are the same 'kind' of thing. + (b) they have the same set of keys. + (c) for each (common) key, they have the same value" + + self == anObject ifTrue: [ ^true ]. + self species == anObject species ifFalse: [ ^false ]. + self size = anObject size ifFalse: [ ^false ]. + ^self allSatisfy: [ :each | anObject includes: each ]! - = aSet - self == aSet ifTrue: [^ true]. "stop recursion" - (aSet isKindOf: Set) ifFalse: [^ false]. - self size = aSet size ifFalse: [^ false]. - self do: [:each | (aSet includes: each) ifFalse: [^ false]]. - ^ true! Item was added: + ----- Method: Set>>addIfNotPresent: (in category 'adding') ----- + addIfNotPresent: anObject + "Include anObject as one of the receiver's elements, but only if there + is no such element already. Anwser anObject." + + ^self add: anObject! Item was removed: - ----- Method: Set>>addNewElement: (in category 'adding') ----- - addNewElement: anObject - "Ensure anObject is part of the receiver. Answer whether its membership was newly acquired." - | index | - index := self scanFor: anObject. - ^ (array at: index) - ifNil: - [ self - atNewIndex: index - put: anObject asSetElement. - true ] - ifNotNil: [ false ]! Item was added: + ----- Method: Set>>ifAbsentAdd: (in category 'adding') ----- + ifAbsentAdd: anObject + "Ensure anObject is part of the receiver. Answer whether its membership was newly acquired." + | index | + index := self scanFor: anObject. + (array at: index) ifNil: + [self + atNewIndex: index + put: anObject asSetElement. + ^true]. + ^false! Item was changed: + ----- Method: Set>>occurrencesOf: (in category 'enumerating') ----- + occurrencesOf: anObject + "Answer how many of the receiver's elements are equal to anObject. Optimized version." + + (self includes: anObject) ifTrue: [ ^1 ]. + ^0! - ----- Method: Set>>occurrencesOf: (in category 'testing') ----- - occurrencesOf: anObject - ^ (self includes: anObject) ifTrue: [1] ifFalse: [0]! Item was changed: ----- Method: Set>>remove:ifAbsent: (in category 'removing') ----- remove: oldObject ifAbsent: aBlock | index | index := self scanFor: oldObject. (array at: index) ifNil: [ ^ aBlock value ]. + tally := tally - 1. "Update tally first, so that read-only hashed collections raise an error before modifying array." array at: index put: nil. - tally := tally - 1. self fixCollisionsFrom: index. ^ oldObject! Item was changed: ----- Method: Set>>scanFor: (in category 'private') ----- scanFor: anObject "Scan the key array for the first slot containing either a nil (indicating an empty slot) or an element that matches anObject. Answer the index of that slot or raise an error if no slot is found. This method will be overridden in various subclasses that have different interpretations for matching elements." + | index start size | + index := start := anObject hash \\ (size := array size) + 1. - | index start | - index := start := anObject hash \\ array size + 1. [ | element | ((element := array at: index) == nil or: [ anObject = element enclosedSetElement ]) ifTrue: [ ^index ]. + (index := index \\ size + 1) = start ] whileFalse. - (index := index \\ array size + 1) = start ] whileFalse. self errorNoFreeSpace! Item was changed: ----- Method: SharedQueue>>nextOrNilSuchThat: (in category 'accessing') ----- nextOrNilSuchThat: aBlock "Answer the next object that satisfies aBlock, skipping any intermediate objects. If no object has been sent, answer <nil> and leave me intact. NOTA BENE: aBlock MUST NOT contain a non-local return (^)." ^accessProtect critical: [ | value readPos | value := nil. readPos := readPosition. [ readPos < writePosition and: [ value isNil ] ] whileTrue: [ value := contentsArray at: readPos. readPos := readPos + 1. (aBlock value: value) ifFalse: [ value := nil ] ifTrue: [ readSynch waitIfLocked: [ ^nil ]. "We found the value, but someone else booked it." + readPos-1 to: readPosition+1 by: -1 do: [ :j | contentsArray at: j put: (contentsArray at: j-1) ]. + contentsArray at: readPosition put: nil. + readPosition := readPosition+1 ] ]. - readPosition to: readPos - 1 do: [ :j | contentsArray at: j put: nil ]. - readPosition := readPos ] ]. value ]. "=== q := SharedQueue new. 1 to: 10 do: [ :i | q nextPut: i]. c := OrderedCollection new. [ v := q nextOrNilSuchThat: [ :e | e odd]. v notNil ] whileTrue: [ c add: {v. q size} ]. {c. q} explore ==="! Item was added: + ----- Method: SharedQueue>>peekLast (in category 'accessing') ----- + peekLast + "Answer the object that was sent through the receiver last and has not + yet been received by anyone. If no object has been sent, answer nil" + + "SharedQueue new nextPut: 1; nextPut: 2; peekLast" + + ^readSynch + critical: + [accessProtect critical: + [writePosition > 1 ifTrue: + [contentsArray at: writePosition - 1]]] + ifLocked: [nil]! Item was added: + ----- Method: SharedQueue2>>flush (in category 'accessing') ----- + flush + self deprecated: 'use removeAll'. + ^self removeAll! Item was added: + ----- Method: SharedQueue2>>flushAllSuchThat: (in category 'accessing') ----- + flushAllSuchThat: aBlock + self deprecated: 'use removeAllSuchThat:'. + + ^self removeAllSuchThat: aBlock! Item was added: + ----- Method: SharedQueue2>>peekLast (in category 'accessing') ----- + peekLast + "Answer the object that was sent through the receiver last and has not + yet been received by anyone. If no object has been sent, answer nil" + + "SharedQueue2 new nextPut: 1; nextPut: 2; peekLast" + ^monitor critical: + [items isEmpty ifFalse: + [items last]]! Item was added: + SignedIntegerArray variableByteSubclass: #SignedByteArray + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Collections-Arrayed'! + + !SignedByteArray commentStamp: 'nice 5/10/2020 17:21' prior: 0! + A SignedByteArray store 8bit signed Integer values in the range -128 to 127. + Negative values are stored as 2's complement.! Item was added: + ----- Method: SignedByteArray>>at: (in category 'accessing') ----- + at: index + | word | + <primitive: 165> + word := self basicAt: index. + ^word >= 16r80 "Negative?!!" + ifTrue:[16r100 - word] + ifFalse:[word]! Item was added: + ----- Method: SignedByteArray>>at:put: (in category 'accessing') ----- + at: index put: anInteger + | byte | + <primitive: 166> + anInteger < 0 + ifTrue: + [anInteger < -16r80 ifTrue: [self error: anInteger asString , ' out of range']. + byte := 16r100 + anInteger] + ifFalse: + [anInteger > 16r7F ifTrue: [self error: anInteger asString , ' out of range']. + byte := anInteger]. + self basicAt: index put: byte. + ^anInteger! Item was added: + ----- Method: SignedByteArray>>bytesPerElement (in category 'accessing') ----- + bytesPerElement + "Number of bytes in each item. This multiplied by (self size)*8 gives the number of bits stored." + ^ 1! Item was added: + SignedIntegerArray variableDoubleWordSubclass: #SignedDoubleWordArray + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Collections-Arrayed'! + + !SignedDoubleWordArray commentStamp: 'nice 5/10/2020 17:30' prior: 0! + A SignedDoubleWordArray store 64bit signed Integer values in the range (1<<63)negated (-9,223,372,036,854,775,808) to (1<<63-1) (9,223,372,036,854,775,807) - that is about 9 US-quintillon (10**3**(5+1)*9), or 9 british-trillion (10**6**3*9). + Negative values are stored as 2's complement.! Item was added: + ----- Method: SignedDoubleWordArray>>at: (in category 'accessing') ----- + at: index + | word64 | + <primitive: 165> + word64 := self basicAt: index. + word64 < SmallInteger maxVal ifTrue:[^word64]. "Avoid LargeInteger computations" + ^word64 >= 16r8000000000000000 "Negative?!!" + ifTrue: ["word64 - 16r10000000000000000" + (word64 bitInvert64 + 1) negated] + ifFalse: [word64]! Item was added: + ----- Method: SignedDoubleWordArray>>at:put: (in category 'accessing') ----- + at: index put: anInteger + | word64 | + <primitive: 166> + anInteger < 0 + ifTrue: + [anInteger < -16r8000000000000000 ifTrue: [self error: anInteger asString , ' out of range']. + "word64 := 16r10000000000000000 + anInteger" + word64 := (anInteger + 1) negated bitInvert64] + ifFalse: + [anInteger > 16r7FFFFFFFFFFFFFFF ifTrue: [self error: anInteger asString , ' out of range']. + word64 := anInteger]. + self basicAt: index put: word64. + ^anInteger! Item was added: + ----- Method: SignedDoubleWordArray>>bytesPerElement (in category 'accessing') ----- + bytesPerElement + "Number of bytes in each item. This multiplied by (self size)*8 gives the number of bits stored." + ^ 8! Item was added: + RawBitsArray subclass: #SignedIntegerArray + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Collections-Arrayed'! + + !SignedIntegerArray commentStamp: 'nice 5/10/2020 16:00' prior: 0! + SignedIntegerArray is an abstract class for all arrays of signed integer of fixed bit-width.! Item was added: + ----- Method: SignedIntegerArray>>defaultElement (in category 'accessing') ----- + defaultElement + "Return the default element of the receiver" + ^0! Item was added: + ----- Method: SignedIntegerArray>>isSignedIntegerArray (in category 'testing') ----- + isSignedIntegerArray + ^true! Item was added: + SignedIntegerArray variableWordSubclass: #SignedWordArray + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Collections-Arrayed'! + + !SignedWordArray commentStamp: 'nice 5/10/2020 17:22' prior: 0! + A SignedWordArray store 64bit signed Integer values in the range -16r80000000 (-2,147,483,648) to 16r7FFFFFFF (2,147,483,647) + Negative values are stored as 2's complement.! Item was added: + ----- Method: SignedWordArray>>at: (in category 'accessing') ----- + at: index + | word | + <primitive: 165> + word := self basicAt: index. + word < 16r3FFFFFFF ifTrue:[^word]. "Avoid LargeInteger computations" + ^word >= 16r80000000 "Negative?!!" + ifTrue:["word - 16r100000000" + (word bitInvert32 + 1) negated] + ifFalse:[word]! Item was added: + ----- Method: SignedWordArray>>at:put: (in category 'accessing') ----- + at: index put: anInteger + | word | + <primitive: 166> + anInteger < 0 + ifTrue:[anInteger < -16r80000000 ifTrue: [self error: anInteger asString , ' out of range']. + "word := 16r100000000 + anInteger" + word := (anInteger + 1) negated bitInvert32] + ifFalse:[anInteger > 16r7FFFFFFF ifTrue: [self error: anInteger asString , ' out of range']. + word := anInteger]. + self basicAt: index put: word. + ^anInteger! Item was added: + ----- Method: SignedWordArray>>bytesPerElement (in category 'accessing') ----- + bytesPerElement + "Number of bytes in each item. This multiplied by (self size)*8 gives the number of bits stored." + ^ 4! 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: OrderedCollection subclass: #SortedCollection instanceVariableNames: 'sortBlock' classVariableNames: '' poolDictionaries: '' category: 'Collections-Sequenceable'! + !SortedCollection commentStamp: 'eem 3/30/2017 17:33' prior: 0! + I represent a collection of objects ordered by some property of the objects themselves. The ordering is specified in a two argument BlockClosure. The default sorting function is a <= comparison on elements.! - !SortedCollection commentStamp: 'dtl 9/6/2009 16:02' prior: 0! - I represent a collection of objects ordered by some property of the objects themselves. The ordering is specified in a BlockContext. The default sorting function is a <= comparison on elements.! Item was removed: - ----- Method: SortedCollection>>collect: (in category 'enumerating') ----- - collect: aBlock - "Evaluate aBlock with each of my elements as the argument. Collect the - resulting values into an OrderedCollection. Answer the new collection. - Override the superclass in order to produce an OrderedCollection instead - of a SortedCollection." - - | newCollection | - newCollection := OrderedCollection new: self size. - self do: [:each | newCollection addLast: (aBlock value: each)]. - ^ newCollection! Item was changed: ----- Method: SortedCollection>>indexForInserting: (in category 'private') ----- indexForInserting: newObject | index low high | low := firstIndex. high := lastIndex. + sortBlock + ifNil: [ + [ low > high ] whileFalse: [ + index := (high + low) // 2. + (array at: index) <= newObject + ifTrue: [ low := index + 1 ] + ifFalse: [ high := index - 1 ] ] ] + ifNotNil: [ + [ low > high ] whileFalse: [ + index := (high + low) // 2. + (sortBlock value: (array at: index) value: newObject) + ifTrue: [ low := index + 1 ] + ifFalse: [ high := index - 1 ] ] ]. - sortBlock isNil - ifTrue: [[index := high + low // 2. low > high] - whileFalse: - [((array at: index) <= newObject) - ifTrue: [low := index + 1] - ifFalse: [high := index - 1]]] - ifFalse: [[index := high + low // 2. low > high] - whileFalse: - [(sortBlock value: (array at: index) value: newObject) - ifTrue: [low := index + 1] - ifFalse: [high := index - 1]]]. ^low! Item was changed: ----- Method: SortedCollection>>sortBlock: (in category 'accessing') ----- sortBlock: aBlock "Make the argument, aBlock, be the criterion for ordering elements of the receiver." sortBlock := aBlock. "sortBlocks with side effects may not work right" + self size > 1 ifTrue: [self reSort]! - self size > 0 ifTrue: [self reSort]! Item was added: + ----- Method: SparseLargeTable>>sparseElementsAndIndicesDo: (in category 'enumerating') ----- + sparseElementsAndIndicesDo: binaryBlock + "Evaluate binaryBlock for each element and index in the receiver that has a non-default value." + + 1 to: self basicSize do: [:chunkIndex | + (self basicAt: chunkIndex) ifNotNil: [:chunk | + chunk withIndexDo: [:element :innerIndex | + element ~= defaultValue ifTrue: [ + binaryBlock value: element value: innerIndex + base - 1 + (chunkIndex - 1 * chunkSize)]]]].! Item was added: + ----- Method: SparseLargeTable>>withIndexDo: (in category 'enumerating') ----- + withIndexDo: binaryBlock + + self base to: self size do: [:index | + binaryBlock + value: (self at: index) + value: index].! Item was added: + ----- Method: Stream>>any: (in category 'collections - accessing') ----- + any: numberOfElements + "See Collection protocol." + + ^ self next: numberOfElements! Item was added: + ----- Method: Stream>>collect: (in category 'collections - enumerating') ----- + collect: block + + ^ Generator on: [:g | + [self atEnd] whileFalse: [ + g yield: (self next ifNotNil: [:object | block value: object])]]! Item was changed: + ----- Method: Stream>>do: (in category 'collections - enumerating') ----- - ----- Method: Stream>>do: (in category 'enumerating') ----- do: aBlock "Evaluate aBlock for each of the objects accessible by receiver." [self atEnd] whileFalse: [aBlock value: self next]! Item was added: + ----- Method: Stream>>ensureOpen (in category 'file open/close') ----- + ensureOpen + "API compatibility with FileBased streams."! Item was added: + ----- Method: Stream>>flatten (in category 'converting') ----- + flatten + + ^ Generator on: [:g | + [self atEnd] whileFalse: [ + self next in: [:object | + ((object isCollection and: [object isString not]) or: [object isStream]) + ifFalse: [g yield: object] + ifTrue: [object flatten do: [:each | g yield: each]]]]]! Item was added: + ----- Method: Stream>>flattened (in category 'converting') ----- + flattened + "An alias for #flatten + This message's name is in line with messages like #sorted or #reversed + while #flatten's is in line with #reverse (as per ANSI, see comment there)" + + ^ self flatten! Item was added: + ----- Method: Stream>>gather: (in category 'collections - enumerating') ----- + gather: block + + ^ Generator on: [:g | + [self atEnd] whileFalse: [ + self next + ifNil: [g yield: nil] + ifNotNil: [:object | + (block value: object) do: [:ea | + g yield: ea]]]]! Item was added: + ----- Method: Stream>>nextSatisfy: (in category 'accessing') ----- + nextSatisfy: aBlock + + self do: [:each | (aBlock value: each) ifTrue: [^ each]]. + Error signal: 'No object could satisfy the block'.! Item was added: + ----- Method: Stream>>open (in category 'file open/close') ----- + open + "API compatibility with FileBased streaams." + ^ self! Item was changed: + ----- Method: Stream>>openReadOnly (in category 'file open/close') ----- - ----- Method: Stream>>openReadOnly (in category 'accessing') ----- openReadOnly ^self! Item was changed: ----- Method: Stream>>readInto:startingAt:count: (in category 'accessing') ----- readInto: aCollection startingAt: startIndex count: n "Read n objects into the given collection. Return number of elements that have been read." | obj | 0 to: n - 1 do: [:i | + obj := self next ifNil: [ ^i ]. - (obj := self next) == nil ifTrue: [^i]. aCollection at: startIndex + i put: obj]. ^n! Item was added: + ----- Method: Stream>>reject: (in category 'collections - enumerating') ----- + reject: aBlock + + ^ self select: [:element | (aBlock value: element) == false]! Item was added: + ----- Method: Stream>>select: (in category 'collections - enumerating') ----- + select: block + + ^ Generator on: [:g | + [self atEnd] whileFalse: [ + self next + ifNil: [g yield: nil] + ifNotNil: [:object | + (block value: object) + ifTrue: [g yield: object]]]]! Item was added: + ----- Method: Stream>>select:thenCollect: (in category 'collections - enumerating') ----- + select: block thenCollect: anotherBlock + + ^ (self select: block) collect: anotherBlock! Item was changed: + ----- Method: Stream>>sleep (in category 'file directory') ----- - ----- Method: Stream>>sleep (in category 'as yet unclassified') ----- sleep "an FTP-based stream might close the connection here"! Item was added: + ----- Method: Stream>>take: (in category 'collections - accessing') ----- + take: maxNumberOfElements + "See Collection protocol." + + | aCollection | + aCollection := OrderedCollection new. + maxNumberOfElements timesRepeat: [ + self atEnd ifTrue: [^ aCollection]. + aCollection addLast: self next]. + ^ aCollection! Item was changed: ----- Method: Stream>>upToEnd (in category 'accessing') ----- upToEnd + "Answer the remaining elements in the stream." + - "answer the remaining elements in the string" | elements | elements := OrderedCollection new. + [self atEnd] whileFalse: [ + elements add: self next]. + ^ elements! - [ self atEnd ] whileFalse: [ - elements add: self next ]. - ^elements! Item was changed: ArrayedCollection subclass: #String instanceVariableNames: '' + classVariableNames: 'AsciiOrder CSMacroCharacters CaseInsensitiveOrder CaseSensitiveOrder CrLfExchangeTable FormatCharacterSet FormatTokenCharacters HtmlEntities LowercasingTable Tokenish UppercasingTable' - classVariableNames: 'AsciiOrder CSMacroCharacters CaseInsensitiveOrder CaseSensitiveOrder CrLfExchangeTable FormatCharacterSet HtmlEntities LowercasingTable Tokenish UppercasingTable' poolDictionaries: '' category: 'Collections-Strings'! !String commentStamp: '<historical>' prior: 0! A String is an indexed collection of Characters. Class String provides the abstract super class for ByteString (that represents an array of 8-bit Characters) and WideString (that represents an array of 32-bit characters). In the similar manner of LargeInteger and SmallInteger, those subclasses are chosen accordingly for a string; namely as long as the system can figure out so, the String is used to represent the given string. Strings support a vast array of useful methods, which can best be learned by browsing and trying out examples as you find them in the code. Here are a few useful methods to look at... String match: String contractTo: String also inherits many useful methods from its hierarchy, such as SequenceableCollection , SequenceableCollection copyReplaceAll:with: ! Item was changed: ----- Method: String class>>compare:with:collated: (in category 'primitives') ----- compare: string1 with: string2 collated: order "Return 1, 2 or 3, if string1 is <, =, or > string2, with the collating order of characters given by the order array." + | c1 c2 length1 length2 | + length1 := string1 size. + length2 := string2 size. + (order == nil or: [ order == AsciiOrder ]) ifTrue: [ "AsciiOrder is the identity function" + 1 to: (length1 min: length2) do: [ :i | + (c1 := string1 basicAt: i) = (c2 := string2 basicAt: i) ifFalse: [ + c1 < c2 + ifTrue: [ ^1 ] + ifFalse: [ ^3 ] ] ]. + length1 = length2 ifTrue: [ ^2 ]. + length1 < length2 + ifTrue: [ ^1 ] + ifFalse: [ ^3 ] ]. + 1 to: (length1 min: length2) do: [ :i | + (c1 := string1 basicAt: i) < 256 ifTrue: [ c1 := order at: c1 + 1 ]. + (c2 := string2 basicAt: i) < 256 ifTrue: [ c2 := order at: c2 + 1 ]. + c1 = c2 ifFalse:[ + c1 < c2 + ifTrue: [ ^1 ] + ifFalse: [ ^3 ] ] ]. + length1 = length2 ifTrue: [ ^2 ]. + length1 < length2 + ifTrue: [ ^1 ] + ifFalse: [ ^3 ].! - | len1 len2 c1 c2 | - order == nil ifTrue: [ - len1 := string1 size. - len2 := string2 size. - 1 to: (len1 min: len2) do:[:i | - c1 := string1 basicAt: i. - c2 := string2 basicAt: i. - c1 = c2 ifFalse: [c1 < c2 ifTrue: [^ 1] ifFalse: [^ 3]]. - ]. - len1 = len2 ifTrue: [^ 2]. - len1 < len2 ifTrue: [^ 1] ifFalse: [^ 3]. - ]. - len1 := string1 size. - len2 := string2 size. - 1 to: (len1 min: len2) do:[:i | - c1 := string1 basicAt: i. - c2 := string2 basicAt: i. - c1 < 256 ifTrue: [c1 := order at: c1 + 1]. - c2 < 256 ifTrue: [c2 := order at: c2 + 1]. - c1 = c2 ifFalse:[c1 < c2 ifTrue: [^ 1] ifFalse: [^ 3]]. - ]. - len1 = len2 ifTrue: [^ 2]. - len1 < len2 ifTrue: [^ 1] ifFalse: [^ 3]. - ! Item was changed: ----- Method: String class>>findFirstInString:inSet:startingAt: (in category 'primitives') ----- findFirstInString: aString inSet: inclusionMap startingAt: start "Trivial, non-primitive version" + | i stringSize ascii | + inclusionMap size ~= 256 ifTrue: [ ^0 ]. - | i stringSize ascii more | - inclusionMap size ~= 256 ifTrue: [^ 0]. stringSize := aString size. - more := true. i := start - 1. + [ (i := i + 1) <= stringSize ] whileTrue: [ + (ascii := aString basicAt: i) < 256 ifTrue: [ + (inclusionMap at: ascii + 1) = 0 ifFalse: [ ^i ] ] ]. + ^0! - [more and: [(i := i + 1) <= stringSize]] whileTrue: [ - ascii := aString basicAt: i. - more := ascii < 256 ifTrue: [(inclusionMap at: ascii + 1) = 0] ifFalse: [true]. - ]. - - i > stringSize ifTrue: [^ 0]. - ^ i! Item was changed: ----- Method: String class>>initialize (in category 'initialization') ----- initialize "self initialize" | order | AsciiOrder := (0 to: 255) as: ByteArray. CaseInsensitiveOrder := AsciiOrder copy. ($a to: $z) do: [:c | CaseInsensitiveOrder at: c asciiValue + 1 put: (CaseInsensitiveOrder at: c asUppercase asciiValue +1)]. "Case-sensitive compare sorts space, digits, letters, all the rest..." CaseSensitiveOrder := ByteArray new: 256 withAll: 255. order := -1. ' 0123456789' do: "0..10" [:c | CaseSensitiveOrder at: c asciiValue + 1 put: (order := order+1)]. ($a to: $z) do: "11-64" [:c | CaseSensitiveOrder at: c asUppercase asciiValue + 1 put: (order := order+1). CaseSensitiveOrder at: c asciiValue + 1 put: (order := order+1)]. 1 to: CaseSensitiveOrder size do: [:i | (CaseSensitiveOrder at: i) = 255 ifTrue: [CaseSensitiveOrder at: i put: (order := order+1)]]. order = 255 ifFalse: [self error: 'order problem']. "a table for translating to lower case" LowercasingTable := String withAll: (Character allByteCharacters collect: [:c | c asLowercase]). "a table for translating to upper case" UppercasingTable := String withAll: (Character allByteCharacters collect: [:c | c asUppercase]). "a table for testing tokenish (for fast numArgs)" Tokenish := String withAll: (Character allByteCharacters collect: [:c | c tokenish ifTrue: [c] ifFalse: [$~]]). "% and < for #expandMacros*" CSMacroCharacters := CharacterSet newFrom: '%<'. "{\ used by #format:" FormatCharacterSet := CharacterSet newFrom: '{\'. + FormatTokenCharacters := CharacterSet newFrom: ($A to: $Z), ($a to: $z), ($0 to: $9), '_/-.,!!@#$%^&*()[]=;:'. "a table for exchanging cr with lf and vica versa" CrLfExchangeTable := Character allByteCharacters collect: [ :each | each caseOf: { [ Character cr ] -> [ Character lf ]. [ Character lf ] -> [ Character cr ] } otherwise: [ each ] ]! Item was changed: ----- Method: String class>>stringHash:initialHash: (in category 'primitives') ----- stringHash: aString initialHash: speciesHash + "Answer the hash of a byte-indexed string, using speciesHash as the initial value. + See SmallInteger>>hashMultiply." + | hash | - - | stringSize hash low | - stringSize := aString size. hash := speciesHash bitAnd: 16r0FFFFFFF. + 1 to: aString size do: + [:pos | + hash := (hash + (aString basicAt: pos)) hashMultiply]. + ^hash! - 1 to: stringSize do: [ :pos | - hash := hash + (aString basicAt: pos). - "Begin hashMultiply" - low := hash bitAnd: 16383. - hash := (16r260D * low + ((16r260D * (hash // 16384) + (16r0065 * low) bitAnd: 16383) * 16384)) bitAnd: 16r0FFFFFFF ]. - ^hash. - - - ! Item was changed: ----- Method: String>>< (in category 'comparing') ----- < aString "Answer whether the receiver sorts before aString. The collation order is simple ascii (with case differences)." + ^(self compareWith: aString) < 0! - ^ (self compare: self with: aString collated: AsciiOrder) = 1! Item was changed: ----- Method: String>><= (in category 'comparing') ----- <= aString "Answer whether the receiver sorts before or equal to aString. The collation order is simple ascii (with case differences)." + ^(self compareWith: aString) <= 0! - ^ (self compare: self with: aString collated: AsciiOrder) <= 2! Item was changed: ----- Method: String>><=> (in category 'sorting') ----- <=> aCharacterArray "Return a collation order of -1, 0, or 1, indicating whether I should be collated before the receiver, am equal, or after. See also: http://en.wikipedia.org/wiki/Spaceship_operator" + aCharacterArray isString ifTrue: [ ^(self compare: aCharacterArray) - 2 ]. + self = aCharacterArray ifTrue: [ ^0 ]. + self < aCharacterArray ifTrue: [ ^-1 ]. + ^1! - ^self = aCharacterArray - ifTrue: [ 0 ] - ifFalse: [self < aCharacterArray - ifTrue: [ -1 ] - ifFalse: [ 1 ]]! Item was changed: ----- Method: String>>= (in category 'comparing') ----- = aString "Answer whether the receiver sorts equally as aString. The collation order is simple ascii (with case differences)." + self == aString ifTrue: [ ^true ]. + aString isString ifFalse: [ ^false ]. + self size = aString size ifFalse: [ ^false ]. + ^ (self compareWith: aString) = 0! - (aString isString - and: [self size = aString size]) ifFalse: [^ false]. - ^ (self compare: self with: aString collated: AsciiOrder) = 2! Item was changed: ----- Method: String>>> (in category 'comparing') ----- > aString "Answer whether the receiver sorts after aString. The collation order is simple ascii (with case differences)." + ^(self compareWith: aString) > 0! - ^ (self compare: self with: aString collated: AsciiOrder) = 3! Item was changed: ----- Method: String>>>= (in category 'comparing') ----- >= aString "Answer whether the receiver sorts after or equal to aString. The collation order is simple ascii (with case differences)." + ^(self compareWith: aString) >= 0! - ^ (self compare: self with: aString collated: AsciiOrder) >= 2! Item was changed: ----- Method: String>>alike: (in category 'comparing') ----- alike: aString "Answer some indication of how alike the receiver is to the argument, 0 is no match, twice aString size is best score. Case is ignored." | i j k minSize bonus | minSize := (j := self size) min: (k := aString size). bonus := (j - k) abs < 2 ifTrue: [ 1 ] ifFalse: [ 0 ]. i := 1. + [(i <= minSize) and: [((self basicAt: i) bitAnd: 16rDF) = ((aString basicAt: i) bitAnd: 16rDF)]] - [(i <= minSize) and: [((super at: i) bitAnd: 16rDF) = ((aString at: i) asciiValue bitAnd: 16rDF)]] whileTrue: [ i := i + 1 ]. [(j > 0) and: [(k > 0) and: + [((self basicAt: j) bitAnd: 16rDF) = ((aString basicAt: k) bitAnd: 16rDF)]]] - [((super at: j) bitAnd: 16rDF) = ((aString at: k) asciiValue bitAnd: 16rDF)]]] whileTrue: [ j := j - 1. k := k - 1. ]. ^ i - 1 + self size - j + bonus. ! Item was added: + ----- Method: String>>applyLanguageInformation: (in category 'accessing') ----- + applyLanguageInformation: aLanguage + "Apply language-specific information to the receiver. Note that aLanguage can be anything that answers #leadingChar at the moment, which includes instances of Locale, LanguageEnvironment, and (prototypical) Character. Also note that we even have to apply a leading char 0 to replace any prior language information." + + | leadingChar | + leadingChar := aLanguage leadingChar. + self withIndexDo: [:each :idx | each asInteger > 16rFF "ascii or latin-1" + ifTrue: [self at: idx put: (Character leadingChar: leadingChar code: each charCode)]].! Item was removed: - ----- Method: String>>asDate (in category 'converting') ----- - asDate - "Many allowed forms, see Date>>#readFrom:" - - ^ Date fromString: self! Item was removed: - ----- Method: String>>asDateAndTime (in category 'converting') ----- - asDateAndTime - - "Convert from UTC format" ^ DateAndTime fromString: self! Item was removed: - ----- Method: String>>asDuration (in category 'converting') ----- - asDuration - "convert from [nnnd]hh:mm:ss[.nanos] format. [] implies optional elements" - - ^ Duration fromString: self - ! Item was removed: - ----- Method: String>>asExplorerString (in category 'user interface') ----- - asExplorerString - - ^ self printString! Item was changed: ----- Method: String>>asFileName (in category 'converting') ----- asFileName + "Answer a String made up from the receiver that is an acceptable file base + name. Does not produce corrected fulll paths if the directory separator etc are included" - "Answer a String made up from the receiver that is an acceptable file - name." | string checkedString | string := FileDirectory checkName: self fixErrors: true. checkedString := (FilePath pathName: string) asVmPathName. ^ (FilePath pathName: checkedString isEncoded: true) asSqueakPathName. ! Item was changed: ----- Method: String>>asInteger (in category 'converting') ----- asInteger + + ^self asIntegerSigned: true - ^self asSignedInteger ! Item was added: + ----- Method: String>>asIntegerSigned: (in category 'converting') ----- + asIntegerSigned: signed + "Return the first decimal integer I can find or nil." + + | index character size result negative | + index := 0. + size := self size. + "Find the first character between $0 and $9." + [ (index := index + 1) > size or: [ (self at: index) isDigit ] ] whileFalse. + index > size ifTrue: [ ^nil ]. + negative := signed and: [ index > 1 and: [ (self at: index - 1) == $- ] ]. + "Parse the number." + size - index > 15 ifTrue: [ + negative ifTrue: [ index := index - 1 ]. + ^Integer readFrom: ( + ReadStream + on: self + from: index + to: size) ]. + result := (self at: index) digitValue. + [ (index := index + 1) <= size + and: [ (character := self at: index) isDigit ] ] whileTrue: [ + result := result * 10 + character digitValue ]. + negative ifTrue: [ ^result negated ]. + ^result! Item was changed: ----- Method: String>>asOctetString (in category 'converting') ----- asOctetString + "Convert the receiver into an octet string if possible. The resulting string will contain + only bytes if all characters fit into bytes. If there is any character > 255 the resulting + string will be a WideString instead." - "Convert the receiver into an octet string" | string | string := String new: self size. 1 to: self size do: [:i | string at: i put: (self at: i)]. ^string! Item was changed: ----- Method: String>>asPluralBasedOn: (in category 'converting') ----- asPluralBasedOn: aNumberOrCollection "Append an 's' to this string based on whether aNumberOrCollection is 1 or of size 1." + aNumberOrCollection = 1 + ifTrue: [^ self]. + (aNumberOrCollection isCollection and: [aNumberOrCollection size = 1]) + ifTrue: [^ self]. + + ^ (self endsWith: 's') + ifTrue: [self , 'es'] + ifFalse: [self , 's'] - ^ (aNumberOrCollection = 1 or: - [aNumberOrCollection isCollection and: [aNumberOrCollection size = 1]]) - ifTrue: [self] - ifFalse: [self, 's'] ! Item was changed: ----- Method: String>>asSignedInteger (in category 'converting') ----- asSignedInteger + "Return the first signed integer I can find or nil." + + ^self asIntegerSigned: true! - "Returns the first signed integer it can find or nil." - - | start | - start := self findFirst: [:char | char isDigit]. - start isZero ifTrue: [^ nil]. - (start > 1 and: [self at: start - 1]) = $- ifTrue: [start := start - 1]. - ^ Integer readFrom: (ReadStream on: self from: start to: self size)! Item was removed: - ----- Method: String>>asTime (in category 'converting') ----- - asTime - "Many allowed forms, see Time>>readFrom:" - - ^ Time fromString: self.! Item was removed: - ----- Method: String>>asTimeStamp (in category 'converting') ----- - asTimeStamp - "Convert from obsolete TimeStamp format" - - ^ TimeStamp fromString: self! Item was changed: ----- Method: String>>asUnsignedInteger (in category 'converting') ----- asUnsignedInteger + "Returns the first unsigned integer I can find or nil." - "Returns the first integer it can find or nil." + ^self asIntegerSigned: false! - | start stream | - start := self findFirst: [:char | char isDigit]. - start isZero ifTrue: [^nil]. - stream := (ReadStream on: self) position: start - 1. - ^Integer readFrom: stream! Item was added: + ----- Method: String>>ascii85Decoded (in category 'converting') ----- + ascii85Decoded + "Decode the receiver from Ascii85" + "'<~87cURD]i,""Ebo7~>' ascii85Decoded" + + ^ self ascii85DecodedAs: self class + ! Item was added: + ----- Method: String>>ascii85DecodedAs: (in category 'converting') ----- + ascii85DecodedAs: aClass + "Decode the receiver from Ascii85" + "'<~87cURD]i,""Ebo7~>' ascii85DecodedAs: String" + + ^ Ascii85Converter decode: self as: aClass! Item was added: + ----- Method: String>>ascii85Encoded (in category 'converting') ----- + ascii85Encoded + "Encode the receiver as Ascii85" + "'Hello World' ascii85Encoded" + + ^ (Ascii85Converter encode: self readStream) contents + ! Item was changed: ----- Method: String>>beginsWith: (in category 'testing') ----- beginsWith: sequence + "Answer if the receiver starts with the argument collection. The comparison is case-sensitive. Overridden for better performance." - "Answer true if the receiver starts with the argument collection. The comparison is case-sensitive. Overridden for better performance." + | index sequenceSize | - | sequenceSize | sequence isString ifFalse: [ ^super beginsWith: sequence ]. + sequenceSize := sequence size. + self size < sequenceSize ifTrue: [ ^false ]. + index := 0. + [ (index := index + 1) <= sequenceSize ] whileTrue: [ + (sequence at: index) == (self at: index) ifFalse: [ ^false ] ]. - ((sequenceSize := sequence size) = 0 or: [ self size < sequence size ]) ifTrue: [ ^false ]. - 1 to: sequenceSize do: [ :index | - (sequence basicAt: index) = (self basicAt: index) ifFalse: [ ^false ] ]. ^true! Item was changed: ----- Method: String>>compare:caseSensitive: (in category 'comparing') ----- compare: aString caseSensitive: aBool "Answer a comparison code telling how the receiver sorts relative to aString: 1 - before 2 - equal 3 - after. " + | map result | - | map | map := aBool ifTrue:[CaseSensitiveOrder] ifFalse:[CaseInsensitiveOrder]. + result := self compareWith: aString collated: map. + result = 0 ifTrue: [ ^2 ]. + ^result > 0 + ifTrue: [ 3 ] + ifFalse: [ 1 ]! - ^self compare: self with: aString collated: map! Item was added: + ----- Method: String>>compareWith: (in category 'comparing') ----- + compareWith: aString + + "<primitive: 158>" + ^self compareWith: aString collated: AsciiOrder! Item was added: + ----- Method: String>>compareWith:collated: (in category 'comparing') ----- + compareWith: aString collated: collation + + <primitive: 158> + ^(self compare: self with: aString collated: collation) - 2! Item was changed: ----- Method: String>>compressWithTable: (in category 'converting') ----- compressWithTable: tokens "Return a string with all substrings that occur in tokens replaced by a character with ascii code = 127 + token index. This will work best if tokens are sorted by size. Assumes this string contains no characters > 127, or that they are intentionally there and will not interfere with this process." | str null finalSize result ri c | null := Character null. str := self copyFrom: 1 to: self size. "Working string will get altered" finalSize := str size. + tokens withIndexDo: - tokens doWithIndex: [:token :tIndex | | start ts | start := 1. [(start := str findString: token startingAt: start) > 0] whileTrue: [ts := token size. ((start + ts) <= str size and: [(str at: start + ts) = $ and: [tIndex*2 <= 128]]) ifTrue: [ts := token size + 1. "include training blank" str at: start put: (Character value: tIndex*2 + 127)] ifFalse: [str at: start put: (Character value: tIndex + 127)]. str at: start put: (Character value: tIndex + 127). 1 to: ts-1 do: [:i | str at: start+i put: null]. finalSize := finalSize - (ts - 1). start := start + ts]]. result := String new: finalSize. ri := 0. 1 to: str size do: [:i | (c := str at: i) = null ifFalse: [result at: (ri := ri+1) put: c]]. ^ result! Item was added: + ----- Method: String>>condensedIntoOneLine (in category 'converting') ----- + condensedIntoOneLine + "Return a copy of the receiver with all separators converted to spaces, and with no consecutive spaces. A formatting tool." + ^ String streamContents: + [ : stream | | prior | + prior := $X. "some non-separator" + self do: + [ : char | char isSeparator ifTrue: [ prior isSeparator ifFalse: [stream space]] ifFalse: [ stream nextPut: char ]. + prior := char ] ]! Item was changed: ----- Method: String>>convertToSystemString (in category 'converting') ----- convertToSystemString + ^self convertToWithConverter: Locale currentPlatform systemConverter! - ^self convertToWithConverter: LanguageEnvironment defaultSystemConverter! Item was changed: ----- Method: String>>correctAgainst:continuedFrom: (in category 'converting') ----- correctAgainst: wordList continuedFrom: oldCollection "Like correctAgainst:. Use when you want to correct against several lists, give nil as the first oldCollection, and nil as the last wordList." + ^self + correctAgainstEnumerator: ( + wordList ifNotNil: [ + [ :action | wordList do: action without: nil ] ]) + continuedFrom: oldCollection! - ^ wordList isNil - ifTrue: [ self correctAgainstEnumerator: nil - continuedFrom: oldCollection ] - ifFalse: [ self correctAgainstEnumerator: [ :action | wordList do: action without: nil] - continuedFrom: oldCollection ]! Item was changed: ----- Method: String>>correctAgainstDictionary:continuedFrom: (in category 'converting') ----- correctAgainstDictionary: wordDict continuedFrom: oldCollection "Like correctAgainst:continuedFrom:. Use when you want to correct against a dictionary." + ^self + correctAgainstEnumerator: ( + wordDict ifNotNil: [ + [ :action | wordDict keysDo: action ] ]) + continuedFrom: oldCollection! - ^ wordDict isNil - ifTrue: [ self correctAgainstEnumerator: nil - continuedFrom: oldCollection ] - ifFalse: [ self correctAgainstEnumerator: [ :action | wordDict keysDo: action ] - continuedFrom: oldCollection ]! Item was changed: ----- Method: String>>correctAgainstEnumerator:continuedFrom: (in category 'private') ----- correctAgainstEnumerator: wordBlock continuedFrom: oldCollection "The guts of correction, instead of a wordList, there is a block that should take another block and enumerate over some list with it." | choices results maxChoices scoreMin | scoreMin := self size // 2 min: 3. maxChoices := 10. + choices := oldCollection ifNil: [ + SortedCollection sortBlock: [ :x :y | x value > y value ] ]. + wordBlock + ifNil: [ + results := OrderedCollection new. - oldCollection isNil - ifTrue: [ choices := SortedCollection sortBlock: [ :x :y | x value > y value ] ] - ifFalse: [ choices := oldCollection ]. - wordBlock isNil - ifTrue: - [ results := OrderedCollection new. 1 to: (maxChoices min: choices size) do: [ :i | results add: (choices at: i) key ] ] + ifNotNil: [ + wordBlock + value: [ :word | + | score | + (score := self alike: word) >= scoreMin + ifTrue: [ + choices add: (Association key: word value: score). + choices size >= maxChoices + ifTrue: [ scoreMin := (choices at: maxChoices) value ] ] ]. - ifFalse: - [ wordBlock value: [ :word | | score | - (score := self alike: word) >= scoreMin ifTrue: - [ choices add: (Association key: word value: score). - (choices size >= maxChoices) ifTrue: [ scoreMin := (choices at: maxChoices) value] ] ]. results := choices ]. ^ results! Item was changed: ----- Method: String>>decodeMimeHeader (in category 'internet') ----- decodeMimeHeader "See RFC 2047, MIME Part Three: Message Header Extension for Non-ASCII + Text and RFC 1342. Text containing non-ASCII characters is encoded by the sequence - Text. Text containing non-ASCII characters is encoded by the sequence =?character-set?encoding?encoded-text?= Encoding is Q (quoted printable) or B (Base64), handled by + Base64MimeConverter / QEncodingMimeConverter. - Base64MimeConverter / RFC2047MimeConverter. Thanks to Yokokawa-san, it works in m17n package. Try the following: '=?ISO-2022-JP?B?U1dJS0lQT1AvGyRCPUJDKyVpJXMlQRsoQi8=?= =?ISO-2022-JP?B?GyRCJVElRiUjJSobKEIoUGF0aW8p?=' decodeMimeHeader. " | input output temp charset decoder encodedStream encoding pos | input := ReadStream on: self. output := WriteStream on: String new. [output nextPutAll: (input upTo: $=). "ASCII Text" input atEnd] whileFalse: [(temp := input next) = $? ifTrue: [charset := input upTo: $?. encoding := (input upTo: $?) asUppercase. temp := input upTo: $?. input next. "Skip final =" (charset isNil or: [charset size = 0]) ifTrue: [charset := 'LATIN-1']. + encodedStream := WriteStream on: String new. - encodedStream := MultiByteBinaryOrTextStream on: String new encoding: charset. decoder := encoding = 'B' ifTrue: [Base64MimeConverter new] + ifFalse: [QEncodingMimeConverter new]. - ifFalse: [RFC2047MimeConverter new]. decoder mimeStream: (ReadStream on: temp); dataStream: encodedStream; mimeDecode. + + output nextPutAll: (MultiByteBinaryOrTextStream with: encodedStream contents encoding: charset) contents. - output nextPutAll: encodedStream reset contents. pos := input position. input skipSeparators. "Delete spaces if followed by =" input peek = $= ifFalse: [input position: pos]] ifFalse: [output nextPut: $=; nextPut: temp]]. ^ output contents! Item was changed: ----- Method: String>>endsWith: (in category 'testing') ----- endsWith: sequence + "Answer if the receiver ends with the argument collection. The comparison is case-sensitive." - "Answer true if the receiver ends with the argument collection. The comparison is case-sensitive." + | index sequenceSize offset | + sequence isString ifFalse: [ ^super endsWith: sequence ]. + sequenceSize := sequence size. + (offset := self size - sequenceSize) < 0 ifTrue: [ ^false ]. + index := 0. + [ (index := index + 1) <= sequenceSize ] whileTrue: [ + (sequence at: index) == (self at: index + offset) ifFalse: [ ^false ] ]. - | sequenceSize offset | - sequence isString ifFalse: [ ^ super endsWith: sequence ]. - ((sequenceSize := sequence size) = 0 or: [ (offset := self size - sequence size) < 0 ]) ifTrue: [ ^false ]. - 1 to: sequenceSize do: [ :index | - (sequence basicAt: index) = (self basicAt: index + offset) ifFalse: [ ^false ] ]. ^true! Item was changed: ----- Method: String>>findDelimiters:startingAt: (in category 'accessing') ----- findDelimiters: delimiters startingAt: start "Answer the index of the character within the receiver, starting at start, that matches one of the delimiters. If the receiver does not contain any of the delimiters, answer size + 1." + delimiters size = 1 ifTrue: [ ^self indexOf: delimiters anyOne startingAt: start ifAbsent: self size + 1 ]. + ^self indexOfAnyOf: delimiters startingAt: start ifAbsent: self size + 1! - start to: self size do: [:i | - delimiters do: [:delim | delim = (self at: i) ifTrue: [^ i]]]. - ^ self size + 1! Item was added: + ----- Method: String>>findFeatureIndicesDo: (in category 'accessing - features') ----- + findFeatureIndicesDo: aBlock + "Support for simple analysis of natural language in source code. + + In addition to whitespace separation like #findTokens:, also separate features using higher-level rules: + (1) 'camelCase' -> #('camel' 'Case'), + (2) 'UPPERCase' -> #('UPPER' 'Case'), + (3) integer numbers such as 'MyModel55' -> #('My' 'Model' '55'), and + (4) operators such as '5 <= 4' -> #('5' '<=' '4'). + Other kinds of characters are tokenized as operators: '[state := 2]' -> #('[' 'state' ':=' '2' ']'). + + This method works like #lineIndicesDo: and provides start/stop indices of tokens to the given aBlock to, for example, extract and normalize features (or tokens)." + + | last state char | + state := 0. "0 = start, 1 = a, 2 = A, 3 = AA, 4 = num, 5 = op" + last := 1. "last character index" + + 1 to: self size do: [ :index | + char := self at: index. + + char isLowercase + ifTrue: [ "a" + state < 3 ifTrue: [state := 1]. "*a -> a" + state = 3 ifTrue: [ + "AAa -> A + Aa (camel case follows uppercase)" + aBlock value: last value: index - 2. + last := index - 1. + state := 2]. + state > 3 ifTrue: [ + "+a -> + | a (letter follows non-letter)" + aBlock value: last value: index - 1. + last := index. + state := 1]] + ifFalse: [ + char isUppercase + ifTrue: [ "A" + state = 0 + ifTrue: [state := 2] "start -> A" + ifFalse: [ + (state < 2) | (state > 3) ifTrue: [ + "*A -> * | A (uppercase begins, flush before)" + aBlock value: last value: index - 1. + last := index. + state := 2] ifFalse: [ + "AA -> AA (uppercase continues)" + state := 3]]] + ifFalse: [ + char isSeparator + ifTrue: [ " " + "skip whitespace" + state > 0 ifTrue: [ + aBlock value: last value: index - 1. + state := 0]. + last := index + 1] + ifFalse: [ + + char isDigit + ifTrue: [ "num" + state = 0 + ifTrue: [state := 4] + ifFalse: [ + state ~= 4 ifTrue: [ + aBlock value: last value: index - 1. + last := index. + state := 4]]] + ifFalse: [ "op" + state = 0 + ifTrue: [state := 5] + ifFalse: [ + state < 5 ifTrue: [ + aBlock value: last value: index - 1. + last := index. + state := 5]] ] ] ] ] ]. + last <= self size ifTrue: [ + aBlock value: last value: self size]! Item was added: + ----- Method: String>>findFeatures (in category 'accessing - features') ----- + findFeatures + + ^ Array streamContents: [:features | + self findFeaturesDo: [:feature | features nextPut: feature]]! Item was added: + ----- Method: String>>findFeaturesDo: (in category 'accessing - features') ----- + findFeaturesDo: aBlock + "Simple analysis of natural language in source code. Select all features that are letters only, normalize them as lowercase. No support for word stemming. + + Example: + 'Transcript show: 123 asString; cr; show: #HelloWorld.' + -> #('transcript' 'show' 'as' 'string' 'cr' 'show' 'hello' 'world') + " + + self findFeatureIndicesDo: [:start :end | + (self at: start) isLetter ifTrue: [ + aBlock value: (self copyFrom: start to: end) asLowercase]].! Item was removed: - ----- Method: String>>findLastOccuranceOfString:startingAt: (in category 'deprecated-3.10') ----- - findLastOccuranceOfString: subString startingAt: start - self deprecated: 'Use instead #findLastOccurrenceOfString:startingAt:'. - ^ self findLastOccurrenceOfString: subString startingAt: start ! Item was added: + ----- Method: String>>findLiteral (in category 'converting') ----- + findLiteral + "Scan the receiver for tokens that represent Smalltalk code literals. Return the first token or nil if non were found." + + | tokens | + tokens := Scanner new typedScanTokens: self. + ^tokens isEmpty ifFalse: [tokens first]! Item was changed: ----- Method: String>>findSelector (in category 'converting') ----- findSelector "Dan's code for hunting down selectors with keyword parts; while this doesn't give a true parse, in most cases it does what we want, in where it doesn't, we're none the worse for it." | sel possibleParens | sel := self withBlanksTrimmed. + (sel includes: $:) + ifTrue: + [sel := sel copyWithRegex: '''[^'']*''' matchesReplacedWith: '''a string'''. + sel := sel copyWithRegex: '#[^\[\(\s\.$]*' matchesReplacedWith: '#aSymbol'. + sel := sel copyWithRegex: '\$.' matchesReplacedWith: '$x'. "handle $( $[ and $:" + sel := sel copyWithRegex: '\:(?!!=)' matchesReplacedWith: ': '. "for the style (aa max:bb) with no space" + sel := sel copyReplaceAll: '[:' with: '[ :'. "for the style ([:a) with no space" + possibleParens := sel substrings. + sel := self class streamContents: + [:s | | level | + level := 0. + possibleParens do: + [:token | + (level = 0 and: [token endsWith: ':']) + ifTrue: [s nextPutAll: token] + ifFalse: [level := level + + (token occurrencesOf: $() - (token occurrencesOf: $)) + + (token occurrencesOf: $[) - (token occurrencesOf: $]) + + (token occurrencesOf: ${) - (token occurrencesOf: $})]]]] + ifFalse: + [sel := self substrings ifNotEmpty: [:tokens | tokens last]]. + sel ifEmpty: [^ nil]. + sel first = $# ifTrue: + [sel := sel allButFirst. + sel ifEmpty: [^ nil]]. - (sel includes: $:) ifTrue: - [sel := sel copyReplaceAll: ':' with: ': '. "for the style (aa max:bb) with no space" - sel := sel copyReplaceAll: '[:' with: '[ :'. "for the style ([:a) with no space" - possibleParens := sel findTokens: Character separators. - sel := self class streamContents: - [:s | | level | - level := 0. - possibleParens do: - [:token | - (level = 0 and: [token endsWith: ':']) - ifTrue: [s nextPutAll: token] - ifFalse: [level := level - + (token occurrencesOf: $() - (token occurrencesOf: $)) - + (token occurrencesOf: $[) - (token occurrencesOf: $]) - + (token occurrencesOf: ${) - (token occurrencesOf: $})]]]]. - sel isEmpty ifTrue: [^ nil]. sel isOctetString ifTrue: [sel := sel asOctetString]. + ^ Symbol lookup: sel! - Symbol hasInterned: sel ifTrue: - [:aSymbol | ^ aSymbol]. - ^ nil! Item was changed: ----- Method: String>>findSubstring:in:startingAt:matchTable: (in category 'accessing') ----- findSubstring: key in: body startingAt: start matchTable: matchTable "Answer the index in the string body at which the substring key first occurs, at or beyond start. The match is determined using matchTable, which can be used to effect, eg, case-insensitive matches. If no match is found, zero will be returned." - | index c1 c2 | - matchTable == nil ifTrue: [ - key size = 0 ifTrue: [^ 0]. - start to: body size - key size + 1 do: - [:startIndex | - index := 1. - [(body at: startIndex+index-1) - = (key at: index)] - whileTrue: - [index = key size ifTrue: [^ startIndex]. - index := index+1]]. - ^ 0 - ]. + | index c1 c2 keySize matchTableSize | + (keySize := key size) = 0 ifTrue: [ ^0 ]. + matchTable ifNil: [ + start to: body size - keySize + 1 do: [ :startIndex | + index := 0. + [ (body at: startIndex + index) == (key at: (index := index + 1)) ] whileTrue: [ + index = keySize ifTrue: [ ^startIndex ] ] ]. + ^0 ]. + matchTableSize := matchTable size. + start to: body size - keySize + 1 do: [ :startIndex | + index := 0. + [ + (c1 := (body basicAt: startIndex + index) + 1) <= matchTableSize ifTrue: [ + c1 := matchTable at: c1 ]. + (c2 := (key basicAt: (index := index + 1)) + 1) <= matchTableSize ifTrue: [ + c2 := matchTable at: c2 ]. + c1 = c2 ] + whileTrue: [ + index = keySize ifTrue: [ ^startIndex ] ] ]. + ^0! - key size = 0 ifTrue: [^ 0]. - start to: body size - key size + 1 do: - [:startIndex | - index := 1. - [c1 := body at: startIndex+index-1. - c2 := key at: index. - ((c1 leadingChar = 0 and: [ c1 asciiValue < matchTable size ]) - ifTrue: [ matchTable at: c1 asciiValue + 1 ] - ifFalse: [ c1 asciiValue + 1 ]) = - ((c2 leadingChar = 0 and: [ c2 asciiValue < matchTable size ]) - ifTrue: [ matchTable at: c2 asciiValue + 1 ] - ifFalse: [c2 asciiValue + 1 ]) ] - whileTrue: - [index = key size ifTrue: [^ startIndex]. - index := index+1]]. - ^ 0! Item was added: + ----- Method: String>>findSymbol (in category 'converting') ----- + findSymbol + "Return the currently selected symbol, or nil if none. Spaces, tabs and returns are ignored. Note that we do never return the empty symbol." + + | aString | + aString := self copyWithoutAll: CharacterSet separators. + aString size = 0 ifTrue: [^ nil]. + ^ Symbol lookup: aString! Item was added: + ----- Method: String>>findTokens (in category 'accessing - tokens') ----- + findTokens + + ^ self findTokens: Character separators! Item was changed: ----- Method: String>>findTokens: (in category 'accessing') ----- findTokens: delimiters + "Answer the collection of tokens between delimiters, which results from parsing self." + + | tokens | - "Answer the collection of tokens that result from parsing self. Return strings between the delimiters. Any character in the Collection delimiters marks a border. Several delimiters in a row are considered as just one separation. Also, allow delimiters to be a single character." - - | tokens keyStart keyStop separators | - tokens := OrderedCollection new. + self + findTokens: delimiters + do: [:token | tokens addLast: token]. + ^ tokens! - separators := delimiters isCharacter - ifTrue: [Array with: delimiters] - ifFalse: [delimiters]. - keyStop := 1. - [keyStop <= self size] whileTrue: - [keyStart := self skipDelimiters: separators startingAt: keyStop. - keyStop := self findDelimiters: separators startingAt: keyStart. - keyStart < keyStop - ifTrue: [tokens add: (self copyFrom: keyStart to: (keyStop - 1))]]. - ^tokens! Item was added: + ----- Method: String>>findTokens:do: (in category 'accessing - tokens') ----- + findTokens: delimiters do: aBlock + + self + findTokens: delimiters + indicesDo: [:start :end | aBlock value: (self copyFrom: start to: end)].! Item was changed: ----- Method: String>>findTokens:escapedBy: (in category 'accessing') ----- + findTokens: delimiters escapedBy: quoteDelimiters - findTokens: delimiters escapedBy: quoteDelimiters "Answer a collection of Strings separated by the delimiters, where delimiters is a Character or collection of characters. Two delimiters in a row produce an empty string (compare this to #findTokens, which treats sequential delimiters as one). The characters in quoteDelimiters are treated as quote characters, such that any delimiter within a pair of matching quoteDelimiter characters is treated literally, rather than as a delimiter. The quoteDelimiter characters may be escaped within a quoted string. Two sequential quote characters within a quoted string are treated as a single character. This method is useful for parsing comma separated variable strings for spreadsheet import and export." | tokens rs activeEscapeCharacter ts char token delimiterChars quoteChars | + delimiterChars := (delimiters ifNil: [ '' ]) asString. + quoteChars := (quoteDelimiters ifNil: [ '' ]) asString. - delimiterChars := (delimiters isNil - ifTrue: [''] - ifFalse: [delimiters]) asString. - quoteChars := (quoteDelimiters isNil - ifTrue: [''] - ifFalse: [quoteDelimiters]) asString. tokens := OrderedCollection new. rs := ReadStream on: self. activeEscapeCharacter := nil. ts := WriteStream on: ''. + [ rs atEnd ] + whileFalse: [ + char := rs next. + activeEscapeCharacter + ifNil: [ + (quoteChars includes: char) + ifTrue: [ activeEscapeCharacter := char ] + ifFalse: [ + (delimiterChars includes: char) + ifTrue: [ + token := ts contents. - [rs atEnd] - whileFalse: [char := rs next. - activeEscapeCharacter isNil - ifTrue: [(quoteChars includes: char) - ifTrue: [activeEscapeCharacter := char] - ifFalse: [(delimiterChars includes: char) - ifTrue: [token := ts contents. tokens add: token. + ts := WriteStream on: '' ] + ifFalse: [ ts nextPut: char ] ] ] + ifNotNil: [ + char == activeEscapeCharacter + ifTrue: [ + rs peek == activeEscapeCharacter + ifTrue: [ ts nextPut: rs next ] + ifFalse: [ activeEscapeCharacter := nil ] ] + ifFalse: [ ts nextPut: char ] ] ]. - ts := WriteStream on: ''] - ifFalse: [ts nextPut: char]]] - ifFalse: [char == activeEscapeCharacter - ifTrue: [rs peek == activeEscapeCharacter - ifTrue: [ts nextPut: rs next] - ifFalse: [activeEscapeCharacter := nil]] - ifFalse: [ts nextPut: char]]]. token := ts contents. + (tokens isEmpty and: [ token isEmpty ]) + ifFalse: [ tokens add: token ]. - (tokens isEmpty and: [token isEmpty]) - ifFalse: [tokens add: token]. ^ tokens! Item was changed: ----- Method: String>>findTokens:includes: (in category 'accessing') ----- findTokens: delimiters includes: subString "Divide self into pieces using delimiters. Return the piece that includes subString anywhere in it. Is case sensitive (say asLowercase to everything beforehand to make insensitive)." ^ (self findTokens: delimiters) + detect: [:str | (str includesSubstring: subString)] - detect: [:str | (str includesSubString: subString)] ifNone: [nil]! Item was added: + ----- Method: String>>findTokens:indicesDo: (in category 'accessing - tokens') ----- + findTokens: oneOrMoreCharacters indicesDo: aBlock + "Parse self to find tokens between delimiters. Any character in the Collection delimiters marks a border. Several delimiters in a row are considered as just one separation. The interface is similar to #lineIndicesDo:." + + | keyStart keyStop separators size | + size := self size. + separators := oneOrMoreCharacters isCharacter + ifTrue: [{oneOrMoreCharacters}] + ifFalse: [oneOrMoreCharacters]. + keyStop := 1. + [keyStop <= size] whileTrue: [ + keyStart := self skipDelimiters: separators startingAt: keyStop. + keyStop := self findDelimiters: separators startingAt: keyStart. + keyStart < keyStop + ifTrue: [aBlock value: keyStart value: keyStop - 1]].! Item was changed: ----- Method: String>>format: (in category 'formatting') ----- format: aCollection + "Substitute tokens in the receiver with element values of aCollection. The tokens are indicated in curly-braces and may be either numeric, e.g., {1}, {2}, etc. and map to a SequenceableCollection, OR, alphanumeric, e.g., {name}, {date}, etc., in which case aCollection should be a Dictionary. + The values can be static or, with the specification of a Block element, dynamic. - "format the receiver with aCollection + Simplest examples: + 'foo {date} bar' format: ({'date'->Date today} as: Dictionary). + + Dynamic calculation is allowed via Blocks. + 'foo {NOW} bar' format: ({'NOW'-> [DateAndTime now]} as: Dictionary). + + Backward-compatible with numeric-only #format: + 'foo {1} bar' format: {Date today}. + + Now with block support: + 'foo {1} bar' format: {[Date today]}. - simplest example: - 'foo {1} bar' format: {Date today}. + Complete example with escaped characters: + '\{ \} \\ foo {1} bar {2}' format: {12. 'string'}. + '\{ \} \\ foo {FOO} bar {BAR}' format: ({'FOO'->12. 'BAR'->'string'} as: Dictionary)." + ^ self class + new: self size * 11 // 10 "ready for +10% growth" + streamContents: + [ : output | | lastIndex nextIndex key | + lastIndex := 1. + key := 0. + [ "stream to output until first { or \" + (nextIndex := self indexOfAnyOf: FormatCharacterSet startingAt: lastIndex) = 0 ] whileFalse: + [ nextIndex = lastIndex ifFalse: + [ output next: nextIndex - lastIndex putAll: self startingAt: lastIndex ]. + "special char hit, escape char?" + (self at: nextIndex) == $\ + ifTrue: + [ "transfer the escaped character. " + output nextPut: (self at: (nextIndex := nextIndex + 1)) ] + ifFalse: + [ | nextKeyChar | + "${ char, parse the key" + [ nextKeyChar := self at: (nextIndex := nextIndex + 1). + FormatTokenCharacters includes: nextKeyChar ] whileTrue: + [ (key isInteger and: [ nextKeyChar between: $0 and: $9 ]) + ifTrue: [ key := key * 10 + nextKeyChar digitValue ] + ifFalse: + [ key isInteger ifTrue: + [ key := WriteStream with: + (key isZero + ifTrue: [ String empty ] + ifFalse: [ key asString ]) ]. + key nextPut: nextKeyChar ] ]. + nextKeyChar == $} ifFalse: [ self error: '$} expected' translated ]. + key isInteger + ifTrue: + [ output nextPutAll: (aCollection at: key) value asString. + key := 0 ] + ifFalse: + [ output nextPutAll: (aCollection at: key contents) value asString. + key reset ] ]. + lastIndex := nextIndex + 1 ]. + lastIndex <= self size ifTrue: + [ output next: self size - lastIndex + 1 putAll: self startingAt: lastIndex ] ]! - complete example: - '\{ \} \\ foo {1} bar {2}' format: {12. 'string'}. - " - ^self class new: self size * 11 // 10 "+10%" streamContents: [ :output | - | lastIndex nextIndex | - lastIndex := 1. - [ (nextIndex := self indexOfAnyOf: FormatCharacterSet startingAt: lastIndex) = 0 ] whileFalse: [ - nextIndex = lastIndex ifFalse: [ - output next: nextIndex - lastIndex putAll: self startingAt: lastIndex ]. - (self at: nextIndex) == $\ - ifTrue: [ output nextPut: (self at: (nextIndex := nextIndex + 1)) ] - ifFalse: [ "${" - "Parse the index - a positive integer in base 10." - | digitValue collectionIndex | - collectionIndex := 0. - [ (digitValue := self basicAt: (nextIndex := nextIndex + 1)) between: 48 "$0 asciiValue" and: 57 "$9 asciiValue" ] whileTrue: [ - collectionIndex := collectionIndex * 10 + digitValue - 48. "$0 asciiValue" ]. - digitValue = 125 "$} asciiValue" ifFalse: [ self error: '$} expected' ]. - output nextPutAll: (aCollection at: collectionIndex) asString ]. - lastIndex := nextIndex + 1 ]. - lastIndex <= self size ifTrue: [ - output next: self size - lastIndex + 1 putAll: self startingAt: lastIndex ] ]! Item was changed: ----- Method: String>>hash (in category 'comparing') ----- hash "#hash is implemented, because #= is implemented" "ar 4/10/2005: I had to change this to use ByteString hash as initial hash in order to avoid having to rehash everything and yet compute the same hash for ByteString and WideString. md 16/10/2006: use identityHash as initialHash, as behavior hash will + use String hash (name) to have a better hash soon. + eem 4/17/2017 it's not possible to use String hash (name) for the + initial hash because that would be recursive." + ^self hashWithInitialHash: ByteString identityHash! - use String hash (name) to have a better hash soon" - ^ self class stringHash: self initialHash: ByteString identityHash! Item was changed: + ----- Method: String>>hashWithInitialHash: (in category 'private') ----- + hashWithInitialHash: speciesHash + "Answer the hash of a byte-indexed string, using speciesHash as the initial value. + See SmallInteger>>hashMultiply." + | hash | + hash := speciesHash bitAnd: 16r0FFFFFFF. + 1 to: self size do: + [:pos | + hash := (hash + (self basicAt: pos)) hashMultiply]. + ^hash! - ----- Method: String>>hashWithInitialHash: (in category 'comparing') ----- - hashWithInitialHash: initialHash - - ^ self class stringHash: self initialHash: initialHash! Item was removed: - ----- Method: String>>includesSubString: (in category 'testing') ----- - includesSubString: subString - ^ (self findString: subString startingAt: 1) > 0! Item was added: + ----- Method: String>>includesSubstring: (in category 'testing') ----- + includesSubstring: aString + + ^(self findString: aString startingAt: 1) > 0! Item was removed: - ----- Method: String>>indexOf: (in category 'accessing') ----- - indexOf: aCharacter - - aCharacter isCharacter ifFalse: [^ 0]. - ^ self class - indexOfAscii: aCharacter asciiValue - inString: self - startingAt: 1. - ! Item was removed: - ----- Method: String>>indexOf:startingAt:ifAbsent: (in category 'accessing') ----- - indexOf: aCharacter startingAt: start ifAbsent: aBlock - | ans | - (aCharacter isCharacter) ifFalse: [ ^ aBlock value ]. - ans := self class indexOfAscii: aCharacter asciiValue inString: self startingAt: start. - ans = 0 - ifTrue: [ ^ aBlock value ] - ifFalse: [ ^ ans ]! Item was removed: - ----- Method: String>>indexOfSubCollection: (in category 'accessing') ----- - indexOfSubCollection: sub - #Collectn. - "Added 2000/04/08 For ANSI <sequenceReadableCollection> protocol." - ^ self - indexOfSubCollection: sub - startingAt: 1 - ifAbsent: [0]! Item was added: + ----- Method: String>>indexOfSubCollection:startingAt: (in category 'accessing') ----- + indexOfSubCollection: subCollection startingAt: start + + subCollection isString ifFalse: [ ^super indexOfSubCollection: subCollection startingAt: start ]. + ^self findString: subCollection startingAt: start caseSensitive: true! Item was removed: - ----- Method: String>>indexOfSubCollection:startingAt:ifAbsent: (in category 'accessing') ----- - indexOfSubCollection: sub startingAt: start ifAbsent: exceptionBlock - | index | - index := self findString: sub startingAt: start. - index = 0 ifTrue: [^ exceptionBlock value]. - ^ index! Item was changed: ----- Method: String>>isAllDigits (in category 'testing') ----- isAllDigits "whether the receiver is composed entirely of digits" + + ^self allSatisfy: [ :character | character isDigit ]! - self do: [:c | c isDigit ifFalse: [^ false]]. - ^ true! Item was changed: ----- Method: String>>isOctetString (in category 'testing') ----- isOctetString "Answer whether the receiver can be represented as a byte string. This is different from asking whether the receiver *is* a ByteString (i.e., #isByteString)" 1 to: self size do: [:pos | + (self basicAt: pos) >= 256 ifTrue: [^ false]. - (self at: pos) asInteger >= 256 ifTrue: [^ false]. ]. ^ true. ! Item was changed: ----- Method: String>>numArgs (in category 'accessing') ----- numArgs "Answer either the number of arguments that the receiver would take if considered a selector. Answer -1 if it couldn't be a selector. It is intended mostly for the assistance of spelling correction." + | numColons index size c | - | numColons index size | (size := self size) = 0 ifTrue: [ ^-1 ]. index := 1. (self at: index) isSpecial ifTrue: [ 2 to: size do: [ :i | (self at: i) isSpecial ifFalse: [ ^-1 ] ]. ^1 ]. self canBeToken ifFalse: [ ^-1 ]. "Fast colon count" numColons := 0. [ + ((c := self at: index) isLetter + or: [ c = $_ and: [ Scanner prefAllowUnderscoreSelectors ] ]) ifFalse: + [ ^-1 ]. + (index := (self indexOf: $: startingAt: index) + 1) > 1 ifFalse: + [ numColons = 0 ifTrue: [ ^0 ]. + ^-1 ]. - (self at: index) isLetter ifFalse: [ ^-1 ]. - (index := (self indexOf: $: startingAt: index) + 1) > 1 ifFalse: [ - numColons = 0 ifTrue: [ ^0 ]. - ^-1 ]. numColons := numColons + 1. index <= size ] whileTrue. ^numColons! Item was added: + ----- Method: String>>occurrencesOf: (in category 'enumerating') ----- + occurrencesOf: anObject + "Answer how many of the receiver's elements are equal to anObject. Optimized version." + + | tally | + anObject isCharacter ifFalse: [ ^0 ]. + tally := 0. + 1 to: self size do: [ :index | + (self at: index) == anObject ifTrue: [ tally := tally + 1 ] ]. + ^tally! Item was changed: ----- Method: String>>padded:to:with: (in category 'copying') ----- + padded: leftOrRight to: length with: aCharacter + + | result paddingLength | + (paddingLength := length - self size) <= 0 ifTrue: [ ^self ]. + result := self species new: length. + leftOrRight = #left ifTrue: [ + ^result + from: 1 + to: paddingLength + put: aCharacter; + replaceFrom: paddingLength + 1 + to: length + with: self + startingAt: 1; + yourself ]. + leftOrRight = #right ifTrue: [ + ^result + replaceFrom: 1 + to: self size + with: self + startingAt: 1; + from: self size + 1 + to: length + put: aCharacter; + yourself ]! - padded: leftOrRight to: length with: char - leftOrRight = #left ifTrue: - [^ (String new: (length - self size max: 0) withAll: char) , self]. - leftOrRight = #right ifTrue: - [^ self , (String new: (length - self size max: 0) withAll: char)].! Item was added: + ----- Method: String>>printAsLiteralOn: (in category 'printing') ----- + printAsLiteralOn: aStream + "Print inside string quotes, doubling embedded quotes." + self storeOn: aStream! Item was changed: ----- Method: String>>printOn: (in category 'printing') ----- + printOn: aStream + "Print inside string quotes, doubling embedded quotes." - printOn: aStream - "Print inside string quotes, doubling inbedded quotes." self storeOn: aStream! Item was changed: ----- Method: String>>replaceFrom:to:with:startingAt: (in category 'private') ----- replaceFrom: start to: stop with: replacement startingAt: repStart "Primitive. This destructively replaces elements from start to stop in the receiver starting at index, repStart, in the collection, replacement. Answer the receiver. Range checks are performed in the primitive only. Optional. See Object documentation whatIsAPrimitive." <primitive: 105> + | index repOff | + repOff := repStart - start. + index := start - 1. + [(index := index + 1) <= stop] + whileTrue: [self at: index put: (replacement at: repOff + index) asCharacter].! - super replaceFrom: start to: stop with: replacement startingAt: repStart! Item was changed: ----- Method: String>>sameAs: (in category 'comparing') ----- sameAs: aString "Answer whether the receiver sorts equal to aString. The collation sequence is ascii with case differences ignored." + self == aString ifTrue: [ ^true ]. ^(self compare: aString caseSensitive: false) = 2! Item was changed: ----- Method: String>>storeOn: (in category 'printing') ----- + storeOn: aStream + "Print inside string quotes, doubling embedded quotes." + + | start matchIndex | - storeOn: aStream - "Print inside string quotes, doubling inbedded quotes." - | x | aStream nextPut: $'. + start := 1. + [ (matchIndex := self indexOf: $' startingAt: start) = 0 ] whileFalse: [ + aStream + next: matchIndex - start + 1 putAll: self startingAt: start; + nextPut: $'. + start := matchIndex + 1 ]. + aStream + next: self size - start + 1 putAll: self startingAt: start; + nextPut: $'! - 1 to: self size do: - [:i | - aStream nextPut: (x := self at: i). - x = $' ifTrue: [aStream nextPut: x]]. - aStream nextPut: $'! Item was changed: ----- Method: String>>subStrings: (in category 'converting') ----- subStrings: separators "Answer an array containing the substrings in the receiver separated + by the elements of separators, which should be a collection of Characters, + or, for convenience, a single character.." + (separators isCharacter or: [separators isString or:[separators allSatisfy: [:element | element isCharacter]]]) ifTrue: + [^self subsequences: separators]. + ^self error: 'separators must be Characters.' + + "'Now is the time for all good people to come to the aid of the cause of world peace. It is just fine, even desirable, to love your country, if that means wanting it to play a beneficial role in the course of world events and be the best possible example of a good society. But if it means wanting dominion over the rest of the world, it is not love but defensiveness or self-glorification, and will lead only to oblivion.' subStrings: Character space" + + "'Now is the time for all good people to come to the aid of the cause of world peace. It is just fine, even desirable, to love your country, if that means wanting it to play a beneficial role in the course of world events and be the best possible example of a good society. But if it means wanting dominion over the rest of the world, it is not love but defensiveness or self-glorification, and will lead only to oblivion.' subStrings: ' ,.-'"! - by the elements of separators." - | char result sourceStream subString | - #Collectn. - "Changed 2000/04/08 For ANSI <readableString> protocol." - (separators isString or:[separators allSatisfy: [:element | element isCharacter]]) ifFalse: - [^ self error: 'separators must be Characters.']. - sourceStream := ReadStream on: self. - result := OrderedCollection new. - subString := String new. - [sourceStream atEnd] - whileFalse: - [char := sourceStream next. - (separators includes: char) - ifTrue: [subString notEmpty - ifTrue: - [result add: subString copy. - subString := String new]] - ifFalse: [subString := subString , (String with: char)]]. - subString notEmpty ifTrue: [result add: subString copy]. - ^ result asArray! Item was changed: ----- Method: String>>substrings (in category 'converting') ----- substrings "Answer an array of the substrings that compose the receiver." + | result size subsequenceStart | + result := OrderedCollection new. + size := self size. + 1 to: size do: + [:i| + (self at: i) isSeparator + ifTrue: + [subsequenceStart ifNotNil: + [result addLast: (self copyFrom: subsequenceStart to: i - 1)]. + subsequenceStart := nil] + ifFalse: + [subsequenceStart ifNil: [subsequenceStart := i]]]. + subsequenceStart ifNotNil: + [result addLast: (self copyFrom: subsequenceStart to: size)]. + ^result asArray + ! - | result end beginning | - result := WriteStream on: (Array new: 10). - end := 0. - "find one substring each time through this loop" - [ "find the beginning of the next substring" - beginning := end+1. - [beginning <= self size and:[(self at: beginning) isSeparator]] - whileTrue:[beginning := beginning + 1]. - beginning <= self size] whileTrue: [ - "find the end" - end := beginning. - [end <= self size and:[(self at: end) isSeparator not]] - whileTrue:[end := end + 1]. - end := end - 1. - result nextPut: (self copyFrom: beginning to: end). - ]. - ^result contents! Item was added: + ----- Method: String>>vmPathToSqueakPath (in category 'converting') ----- + vmPathToSqueakPath + "convert a file path string received from the vm to a Squeak String" + + ^ (FilePath pathName: self isEncoded: true) asSqueakPathName! Item was changed: ----- Method: String>>withBlanksTrimmed (in category 'converting') ----- withBlanksTrimmed "Return a copy of the receiver from which leading and trailing blanks have been trimmed." | first last | + first := self indexOfAnyOf: CharacterSet nonSeparators startingAt: 1. - first := self indexOfAnyOf: CharacterSet nonSeparators startingAt: 1 ifAbsent: [0]. first = 0 ifTrue: [ ^'' ]. "no non-separator character" last := self lastIndexOfAnyOf: CharacterSet nonSeparators startingAt: self size ifAbsent: [self size]. (first = 1 and: [ last = self size ]) ifTrue: [ ^self copy ]. ^self copyFrom: first to: last ! Item was changed: ----- Method: String>>withoutTrailingDigits (in category 'converting') ----- withoutTrailingDigits "Answer the portion of the receiver that precedes any trailing series of digits and blanks. If the receiver consists entirely of digits and blanks, return an empty string" + | i | + i := self size. + [i > 0] whileTrue: [ + ((self at: i) isDigit or: [ (self at: i) = $ ]) ifFalse: [ + ^ self copyFrom: 1 to: i + ]. + i := i - 1. + ]. + ^ '' + - | firstDigit | - firstDigit := (self findFirst: [:m | m isDigit or: [m = $ ]]). - ^ firstDigit > 0 - ifTrue: - [self copyFrom: 1 to: firstDigit-1] - ifFalse: - [self] " 'Whoopie234' withoutTrailingDigits + 'Lucida Grande 15' withoutTrailingDigits ' 4321 BlastOff!!' withoutLeadingDigits 'wimpy' withoutLeadingDigits ' 89Ten ' withoutLeadingDigits '78 92' withoutLeadingDigits " ! Item was changed: String subclass: #Symbol instanceVariableNames: '' + classVariableNames: 'NewSymbols SymbolTable' - classVariableNames: 'NewSymbols OneCharacterSymbols SymbolTable' poolDictionaries: '' category: 'Collections-Strings'! + !Symbol commentStamp: 'ul 3/28/2022 19:53' prior: 0! + I represent Strings that are created uniquely. Thus, someString asSymbol == someString asSymbol. + + On my class-side, there is an implementation of a symbol table which provides concurrent access (both read and write) without using locks (Semaphore, Mutex, Monitor). + The state of the symbol table is stored in two immutable (see #beReadOnlyObject) WeakSets stored by the class variables SymbolTable and NewSymbols. + SymbolTable holds most of the interned symbols, while new symbols are always added to NewSymbols. + Once the size of NewSymbols exceeds a limit (1000 currently, see #intern:), its content is merged into SymbolTable (see #condenseNewSymbols). + + To ensure a consistent view of the symbol table, all methods accessing it start with atomically creating a "snapshot" of the state, the two variables, by assigning them to two temporaries. Except for #intern:, which only accesses NewSymbols, hence it only creates a snapshot of that. + If the symbol table changes, NewSymbols will always be a different object, so it is enough to check whether NewSymbols is the same as before the operation to verify that the symbol table has not been modified. + + There are three methods that can update the symbol table: #condenseNewSymbols, #rehash and #intern:. They create a snapshot first as described above, then create copies of the updated parts, and finally check whether NewSymbols is the same as before, and if it is, they apply their changes. That all happens atomically because #==, #ifTrue: and assignments are executed by the VM without suspension points, hence atomically. If NewSymbols is different, the methods are repeated until they succeed. + ! - !Symbol commentStamp: '<historical>' prior: 0! - I represent Strings that are created uniquely. Thus, someString asSymbol == someString asSymbol.! Item was changed: ----- Method: Symbol class>>allSymbolTablesDo: (in category 'class initialization') ----- allSymbolTablesDo: aBlock + "See the class comment for details about the usage of the class variables before changing this method" + - | originalNewSymbols originalSymbolTable | originalNewSymbols := NewSymbols. originalSymbolTable := SymbolTable. originalNewSymbols do: aBlock. originalSymbolTable do: aBlock.! Item was changed: ----- Method: Symbol class>>allSymbolTablesDo:after: (in category 'class initialization') ----- allSymbolTablesDo: aBlock after: aSymbol + "See the class comment for details about the usage of the class variables before changing this method" | originalNewSymbols originalSymbolTable | originalNewSymbols := NewSymbols. originalSymbolTable := SymbolTable. (originalNewSymbols includes: aSymbol) ifTrue: [ originalNewSymbols do: aBlock after: aSymbol. originalSymbolTable do: aBlock after: aSymbol ] ifFalse: [ originalSymbolTable do: aBlock after: aSymbol. originalNewSymbols do: aBlock after: aSymbol ] ! Item was changed: + ----- Method: Symbol class>>allSymbols (in category 'accessing') ----- - ----- Method: Symbol class>>allSymbols (in category 'access') ----- allSymbols "Answer all interned symbols" + "See the class comment for details about the usage of the class variables before changing this method" + - | originalNewSymbols originalSymbolTable | originalNewSymbols := NewSymbols. originalSymbolTable := SymbolTable. ^Array new: originalNewSymbols slowSize + originalSymbolTable slowSize + streamContents: [ :stream | - streamContents:[ :stream | stream nextPutAll: originalNewSymbols; nextPutAll: originalSymbolTable ] ! Item was changed: ----- Method: Symbol class>>condenseNewSymbols (in category 'private') ----- condenseNewSymbols + "Move all symbols from NewSymbols to SymbolTable, and compact SymbolTable if needed." + "See the class comment for details about the usage of the class variables before changing this method." - "Move all symbols from NewSymbols to SymbolTable, and compact SymbolTable." | originalNewSymbols originalSymbolTable newNewSymbols newSymbolTable | + [ + originalNewSymbols := NewSymbols. + originalSymbolTable := SymbolTable. + (originalNewSymbols isEmpty and: [ originalSymbolTable isCompact ]) ifTrue: [ + "Only recreate the sets if necessary" + ^self ]. + (newNewSymbols := WeakSet new) + beReadOnlyObject. + (newSymbolTable := WeakSet new: originalNewSymbols slowSize + originalSymbolTable slowSize) + addAll: originalSymbolTable; + addAll: originalNewSymbols; + beReadOnlyObject. + originalNewSymbols == NewSymbols ifTrue: [ + NewSymbols := newNewSymbols. + SymbolTable := newSymbolTable. + ^self ]. + "Some other process has modified the symbol table. Try again." ] repeat! - originalNewSymbols := NewSymbols. - originalSymbolTable := SymbolTable. - newNewSymbols := WeakSet new. - newSymbolTable := originalSymbolTable copy - addAll: originalNewSymbols; - compact; - yourself. - originalNewSymbols == NewSymbols ifFalse: [ - "Some other process has modified the symbols. Try again." - ^self condenseNewSymbols ]. - NewSymbols := newNewSymbols. - SymbolTable := newSymbolTable! Item was added: + ----- Method: Symbol class>>empty (in category 'instance creation') ----- + empty + "A canonicalized empty symbol." + ^ #''! Item was removed: - ----- Method: Symbol class>>findInterned: (in category 'instance creation') ----- - findInterned:aString - - self hasInterned:aString ifTrue:[:symbol| ^symbol]. - ^nil.! Item was changed: ----- Method: Symbol class>>hasInterned:ifTrue: (in category 'private') ----- hasInterned: aString ifTrue: symBlock "Answer with false if aString hasnt been interned (into a Symbol), otherwise supply the symbol to symBlock and return true." + (self lookup: aString) + ifNil: [ ^false ] + ifNotNil: [ :symbol | + symBlock value: symbol. + ^true ]! - | symbol | - ^ (symbol := self lookup: aString) - ifNil: [false] - ifNotNil: [symBlock value: symbol. - true]! Item was changed: ----- Method: Symbol class>>intern: (in category 'instance creation') ----- intern: aStringOrSymbol + "Answer the unique Symbol formed with given String. + If it does not exist yet, create it and intern it in the NewSymbols. + Interning a Symbol should return the Symbol itself, no Symbol should be duplicated" + "See the class comment for details about the usage of the class variables before changing this method" | originalNewSymbols | originalNewSymbols := NewSymbols. ^(self lookup: aStringOrSymbol) ifNil:[ + | aSymbol newNewSymbols | - | aClass aSymbol newNewSymbols | aStringOrSymbol isSymbol ifTrue:[ aSymbol := aStringOrSymbol. ] ifFalse:[ + aSymbol := (aStringOrSymbol isOctetString ifTrue:[ByteSymbol] ifFalse:[WideSymbol]) + new: aStringOrSymbol size. + aSymbol + copyFrom: aStringOrSymbol; + beReadOnlyObject. - aClass := aStringOrSymbol isOctetString ifTrue:[ByteSymbol] ifFalse:[WideSymbol]. - aSymbol := aClass new: aStringOrSymbol size. - aSymbol string: aStringOrSymbol. ]. newNewSymbols := originalNewSymbols copyWith: aSymbol. + newNewSymbols beReadOnlyObject. originalNewSymbols == NewSymbols ifTrue: [ NewSymbols := newNewSymbols. newNewSymbols size > 1000 ifTrue: [ self condenseNewSymbols ]. aSymbol ] ifFalse: [ "Some other process has modified the symbols. Try again." self intern: aStringOrSymbol ] ]! Item was removed: - ----- Method: Symbol class>>internCharacter: (in category 'instance creation') ----- - internCharacter: aCharacter - ^self intern: aCharacter asString! Item was changed: ----- Method: Symbol class>>lookup: (in category 'instance creation') ----- lookup: aStringOrSymbol + "Answer the unique Symbol formed with given String, if it exists. + Answer nil if no such Symbol does exist yet. + Looking up a Symbol should return the Symbol itself + - no Symbol should be duplicated + - every Symbol should be registered in one of the two Symbol tables" + "See the class comment for details about the usage of the class variables before changing this method" | originalNewSymbols originalSymbolTable | originalNewSymbols := NewSymbols. originalSymbolTable := SymbolTable. + ^(originalSymbolTable like: aStringOrSymbol) ifNil: [ "Most symbols are in originalSymbolTable, so look for existing symbols in there first" + originalNewSymbols like: aStringOrSymbol ]! - ^(originalNewSymbols like: aStringOrSymbol) ifNil: [ - originalSymbolTable like: aStringOrSymbol ]! Item was changed: ----- Method: Symbol class>>possibleSelectorsFor: (in category 'private') ----- possibleSelectorsFor: misspelled "Answer an ordered collection of possible corrections for the misspelled selector in order of likelyhood" | numArgs candidates lookupString best binary short long first | lookupString := misspelled asLowercase. "correct uppercase selectors to lowercase" numArgs := lookupString numArgs. (numArgs < 0 or: [lookupString size < 2]) ifTrue: [^ OrderedCollection new: 0]. first := lookupString first. short := lookupString size - (lookupString size // 4 max: 3) max: 2. long := lookupString size + (lookupString size // 4 max: 3). "First assemble candidates for detailed scoring" candidates := OrderedCollection new. self allSymbolTablesDo: [:s | | ss | (((ss := s size) >= short "not too short" and: [ss <= long "not too long" or: [(s at: 1) = first]]) "well, any length OK if starts w/same letter" and: [s numArgs = numArgs]) "and numArgs is the same" ifTrue: [candidates add: s]]. "Then further prune these by correctAgainst:" best := lookupString correctAgainst: candidates. ((misspelled last ~~ $:) and: [misspelled size > 1]) ifTrue: [ binary := misspelled, ':'. "try for missing colon" + (self lookup: binary) ifNotNil: [:him | best addFirst: him]]. - Symbol hasInterned: binary ifTrue: [:him | best addFirst: him]]. ^ best! Item was changed: ----- Method: Symbol class>>rehash (in category 'private') ----- rehash "Rebuild the hash table, reclaiming unreferenced Symbols. This method will intern all symbols. You're probably looking for #condenseNewSymbols instead." + "See the class comment for details about the usage of the class variables before changing this method" | originalNewSymbols originalSymbolTable newNewSymbols newSymbolTable | + [ + originalNewSymbols := NewSymbols. + originalSymbolTable := SymbolTable. + newNewSymbols := WeakSet new. + newSymbolTable := WeakSet withAll: self allSubInstances. + newNewSymbols beReadOnlyObject. + newSymbolTable beReadOnlyObject. + originalNewSymbols == NewSymbols ifTrue: [ + NewSymbols := newNewSymbols. + SymbolTable := newSymbolTable. + ^self ]. + "Some other process has modified the symbol table. Try again." ] repeat + ! - originalNewSymbols := NewSymbols. - originalSymbolTable := SymbolTable. - newNewSymbols := WeakSet new. - newSymbolTable := WeakSet withAll: self allSubInstances. - originalNewSymbols == NewSymbols ifFalse: [ - "Some other process has modified the symbols. Try again." - ^self rehash ]. - NewSymbols := newNewSymbols. - SymbolTable := newSymbolTable! Item was changed: + ----- Method: Symbol class>>selectorsContaining: (in category 'accessing') ----- - ----- Method: Symbol class>>selectorsContaining: (in category 'access') ----- selectorsContaining: aString "Answer a list of selectors that contain aString within them. Case-insensitive. Does return symbols that begin with a capital letter." | size selectorList | selectorList := OrderedCollection new. (size := aString size) = 0 ifTrue: [ ^selectorList ]. self allSymbolTablesDo: [ :each | (each size >= size and: [ (each includesSubstring: aString caseSensitive: false) and: [ each numArgs ~= -1 ] ]) ifTrue: [ selectorList add: each ] ]. ^selectorList "Symbol selectorsContaining: 'scon'"! Item was changed: + ----- Method: Symbol class>>selectorsMatching: (in category 'accessing') ----- - ----- Method: Symbol class>>selectorsMatching: (in category 'access') ----- selectorsMatching: aStringPattern "Answer a list of selectors that match aStringPattern within them. Case-insensitive. Does return symbols that begin with a capital letter." | selectorList | selectorList := OrderedCollection new. aStringPattern isEmpty ifTrue: [ ^selectorList ]. self allSymbolTablesDo: [ :each | ((aStringPattern match: each) and: [ each numArgs ~= -1 ]) ifTrue: [selectorList add: each ] ]. ^selectorList "Symbol selectorsMatching: 'parse:*'"! Item was changed: + ----- Method: Symbol class>>thatStarts:skipping: (in category 'accessing') ----- - ----- Method: Symbol class>>thatStarts:skipping: (in category 'access') ----- thatStarts: leadingCharacters skipping: skipSym "Answer a selector symbol that starts with leadingCharacters. Symbols beginning with a lower-case letter handled directly here. Ignore case after first char. If skipSym is not nil, it is a previous answer; start searching after it. If no symbols are found, answer nil. Used by Alt-q (Command-q) routines" | size firstMatch key | size := leadingCharacters size. size = 0 ifTrue: [^skipSym ifNil: [#''] ifNotNil: [nil]]. firstMatch := leadingCharacters at: 1. size > 1 ifTrue: [key := leadingCharacters copyFrom: 2 to: size]. self allSymbolTablesDo: [:each | each size >= size ifTrue: [ ((each at: 1) == firstMatch and: [key == nil or: [(each findString: key startingAt: 2 caseSensitive: false) = 2]]) ifTrue: [^each] ] ] after: skipSym. ^nil "Symbol thatStarts: 'sf' skipping: nil" "Symbol thatStarts: 'sf' skipping: #sfpGetFile:with:with:with:with:with:with:with:with:" "Symbol thatStarts: 'candidate' skipping: nil" ! Item was changed: + ----- Method: Symbol class>>thatStartsCaseSensitive:skipping: (in category 'accessing') ----- - ----- Method: Symbol class>>thatStartsCaseSensitive:skipping: (in category 'access') ----- thatStartsCaseSensitive: leadingCharacters skipping: skipSym "Same as thatStarts:skipping: but caseSensitive" | size firstMatch key | size := leadingCharacters size. size = 0 ifTrue: [^skipSym ifNil: [#''] ifNotNil: [nil]]. firstMatch := leadingCharacters at: 1. size > 1 ifTrue: [key := leadingCharacters copyFrom: 2 to: size]. self allSymbolTablesDo: [:each | each size >= size ifTrue: [ ((each at: 1) == firstMatch and: [key == nil or: [(each findString: key startingAt: 2 caseSensitive: true) = 2]]) ifTrue: [^each] ] ] after: skipSym. ^nil ! Item was changed: ----- Method: Symbol>>= (in category 'comparing') ----- = aSymbol "Compare the receiver and aSymbol." self == aSymbol ifTrue: [^ true]. + aSymbol isSymbol ifTrue: [^ false]. - self class == aSymbol class ifTrue: [^ false]. "Use String comparison otherwise" ^ super = aSymbol! Item was removed: - ----- Method: Symbol>>asExplorerString (in category 'user interface') ----- - asExplorerString - ^ self printString! Item was removed: - ----- Method: Symbol>>asMutator (in category 'converting') ----- - asMutator - "Return a setter message from a getter message. For example, #name asMutator returns #name:" - ^ self last = $: - ifTrue: [ self ] - ifFalse: [ (self copyWith: $:) asSymbol ]! 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 removed: - ----- Method: Symbol>>clone (in category 'copying') ----- - clone - "Answer with the receiver, because Symbols are unique."! 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: + ----- Method: Symbol>>isMessageSelector (in category 'testing') ----- + isMessageSelector + "Answer if the receiver is a valid message selector. This method is not perfect. + The compiler does allow all caps to be selectors but these are not included. + If AllowUnderscoreSelectors is true then _ is a valid selector but this will be excluded + also. But it is IMO more useful to exclude class names and hence exclude some rarely + used selectors than to erroneously identify class names as message selectors." + + ^Scanner isMessageSelector: self! Item was added: + ----- Method: Symbol>>selector (in category 'accessing') ----- + selector + ^ self! Item was removed: - ----- Method: Symbol>>string: (in category 'private') ----- - string: aString - - 1 to: aString size do: [:j | super at: j put: (aString at: j)]. - ^self ! Item was changed: ----- Method: Symbol>>withFirstCharacterDownshifted (in category 'converting') ----- withFirstCharacterDownshifted + "Answer an object like the receiver but with first character downshifted if necessary" - "Answer an object like the receiver but with first character downshifted if necesary" + ^self asString withFirstCharacterDownshifted asSymbol! - ^self asString withFirstCharacterDownshifted asSymbol.! Item was added: + ----- Method: Text class>>THEQUICKBROWNFOX (in category 'filler text') ----- + THEQUICKBROWNFOX + + ^ self fromString: 'THE QUICK BROWN FOX JUMPS OVER THE LAZY DOG.'! Item was added: + ----- Method: Text class>>allDigits (in category 'filler text') ----- + allDigits + + ^ self fromString: '0123456789'! Item was added: + ----- Method: Text class>>codeSample (in category 'filler text') ----- + codeSample + + self flag: #linebreaks. "Samples are used in FontImporterTool and must contain manual linebreaks (visually stable example texts per line)." + ^ 'exampleWithNumber: x + "A method that illustrates every part of Smalltalk method syntax + including primitives. It has unary, binary, and keyboard messages; + declares arguments and temporaries; accesses a global variable + (but not an instance variable); uses literals (array, nested array, + character, symbol, string, integer, float, scaled decimal, and byte + array); uses the pseudo variables nil, true, false, self, super, and + thisContext; shows that within a literal array nil, true, and false are + still pseudo variables; and has sequence, assignment, return, + cascade, and tuple (array) creation. It has both zero argument + and one argument blocks, and has a block temporary." + <primitive: ''primitiveCopyBits'' module: #BitBltPlugin error: ec> + | y | + true & false not & (nil isNil) ifFalse: [self halt]. + y := self size + super size. + #($a #a ''a'' "a" (1 1.0 1.0s2) nil true false), { #[65]. thisContext. nil. true. false } + do: [ :each | | class | + class := each class. + Transcript + show: (class name); + show: '' '']. + ^ x < y'! Item was added: + ----- Method: Text class>>forssmanSample (in category 'filler text') ----- + forssmanSample + "Detailtypografie. Friedrich Forssmann, Ralf de Jong. Verlag Hermann Schmidt. 2004. ISBN 978-3874395687. http://www.detailtypografie.de/" + + ^ self fromString: 'Wien, Venedig, Ravenna? Also gut: Ravenna. Gleichmäßiger + Regen hüllt den Abend ein. Die Fassaden der Häuser haben ihr + Antlitz verloren. Ein korpulenter Polizist humpelt auf + Krücken zum Strand. Vergeblich halten wir Ausschau, + melancholisch spielt Frau Löwe mit ihrem Zirkel. Wir öffnen + die Tür. Wir sehen nichts. In der Ferne ein Gewitter. Früher + wägte man den Sinn und den Unsinn und entschied sich für den + Unsinn. Das war eine Geschmackssache. Wir liegen in Fesseln, + ach und in Feuchte. Frau Löwe malt ein vergangenes Bild der + Wissenschaft auf die bröcklige Leinwand der Herzen. Sie + verneigt sich und küßt uns die Augen. Wir finden keine Luft + mehr, wir halten uns nur noch auf dem laufenden. Gott im + Himmel, laß es ein Ende haben!! Gott im Himmel, erweiche dein + Herz!! Gott im Himmel schenk uns dein Fleisch!! Wir finden ... + Luft ... Das Leselicht erlischt. »Blind ist der Blinde nur + hinter der Binde.« Schiller & Goethe reichen sich die Hände. + »Na denn? Na denn!!«'! Item was added: + ----- Method: Text class>>hamburgefonstiv (in category 'filler text') ----- + hamburgefonstiv + + ^ self fromString: 'Hamburgefonstiv'! Item was changed: ----- Method: Text class>>initTextConstants (in category 'class initialization') ----- initTextConstants "Initialize constants shared by classes associated with text display, e.g., Space, Tab, Cr, Bs, ESC." "1/24/96 sw: in exasperation and confusion, changed cmd-g mapping from 231 to 232 to see if I could gain any relief?!!" + | letter varAndValue | - | letter varAndValue tempArray width | "CtrlA..CtrlZ, Ctrla..Ctrlz" letter := $A. #( 212 230 228 196 194 226 241 243 214 229 200 217 246 245 216 202 210 239 211 240 197 198 209 215 242 231 1 166 228 132 130 12 232 179 150 165 136 153 182 14 15 138 17 18 19 11 21 134 145 151 178 167 ) do: [:kbd | TextConstants at: ('Ctrl', letter asSymbol) asSymbol put: kbd asCharacter. letter := letter == $Z ifTrue: [$a] ifFalse: [(letter asciiValue + 1) asCharacter]]. varAndValue := #( Space 32 Tab 9 CR 13 Enter 3 BS 8 BS2 158 ESC 160 Clear 173 ). varAndValue size odd ifTrue: [self error: 'unpaired text constant']. (2 to: varAndValue size by: 2) do: [:i | TextConstants at: (varAndValue at: i - 1) put: (varAndValue at: i) asCharacter]. varAndValue := #( CtrlDigits (159 144 143 128 127 129 131 180 149 135) CtrlOpenBrackets (201 7 218 249 219 15) "lparen gottn by ctrl-:= = 201; should be 213 but can't type that on Mac" "values for alignment" LeftFlush 0 RightFlush 1 Centered 2 Justified 3 "subscripts for a marginTabsArray tuple" LeftMarginTab 1 RightMarginTab 2 "font faces" Basal 0 Bold 1 Italic 2 - "in case font doesn't have a width for space character" - "some plausible numbers-- are they the right ones?" - DefaultSpace 4 - DefaultTab 24 - DefaultLineGrid 16 - DefaultBaseline 12 - DefaultFontFamilySize 3 "basal, bold, italic" ). varAndValue size odd ifTrue: [self error: 'unpaired text constant']. (2 to: varAndValue size by: 2) do: [:i | TextConstants at: (varAndValue at: i - 1) put: (varAndValue at: i)]. TextConstants at: #DefaultRule put: Form over. TextConstants at: #DefaultMask put: Color black. - width := Display width max: 720. - tempArray := Array new: width // DefaultTab. - 1 to: tempArray size do: - [:i | tempArray at: i put: DefaultTab * i]. - TextConstants at: #DefaultTabsArray put: tempArray. - tempArray := Array new: (width // DefaultTab) // 2. - 1 to: tempArray size do: - [:i | tempArray at: i put: (Array with: (DefaultTab*i) with: (DefaultTab*i))]. - TextConstants at: #DefaultMarginTabsArray put: tempArray. - "Text initTextConstants "! Item was added: + ----- Method: Text class>>loremIpsum (in category 'filler text') ----- + loremIpsum + + ^ self fromString: 'Lorem ipsum dolor sit amet, consectetur adipisicing elit, + sed do eiusmod tempor incididunt ut labore et dolore + magna aliqua. Ut enim ad minim veniam, quis nostrud + exercitation ullamco laboris nisi ut aliquip ex ea commodo + consequat. Duis aute irure dolor in reprehenderit in voluptate + velit esse cillum dolore eu fugiat nulla pariatur. Excepteur + sint occaecat cupidatat non proident, sunt in culpa qui + officia deserunt mollit anim id est laborum.'! Item was added: + ----- Method: Text class>>melvilleSample (in category 'filler text') ----- + melvilleSample + " + https://en.wikipedia.org/wiki/Moby-Dick + " + + ^ self fromString: 'Call me Ishmael. Some years ago - never mind how long + precisely - having little or no money in my purse, and + nothing particular to interest me on shore, I thought I + would sail about a little and see the watery part of the + world. It is a way I have of driving off the spleen and + regulating the circulation. Whenever I find myself growing + grim about the mouth; whenever it is a damp, drizzly + November in my soul; whenever I find myself involuntarily + pausing before coffin warehouses, and bringing up the rear + of every funeral I meet; and especially whenever my hypos + get such an upper hand of me, that it requires a strong + moral principle to prevent me from deliberately stepping + into the street, and methodically knocking people''s hats off + - then, I account it high time to get to sea as soon as I + can. This is my substitute for pistol and ball. With a + philosophical flourish Cato throws himself upon his sword; I + quietly take to the ship. There is nothing surprising in + this. If they but knew it, almost all men in their degree, + some time or other, cherish very nearly the same feelings + towards the ocean with me. + + There now is your insular city of the Manhattoes, belted + round by wharves as Indian isles by coral reefs - commerce + surrounds it with her surf. Right and left, the streets take + you waterward. Its extreme down-town is the battery, where + that noble mole is washed by waves, and cooled by breezes, + which a few hours previous were out of sight of land. Look + at the crowds of water-gazers there. + + -- Herman Melville'! Item was added: + ----- Method: Text class>>new:streamContents: (in category 'instance creation') ----- + new: newSize streamContents: blockWithArg + + | stream | + stream := TextStream on: (self new: newSize). + blockWithArg value: stream. + ^ stream contents! Item was changed: ----- Method: Text class>>string:runs: (in category 'private') ----- string: aString runs: anArray + ^self basicNew setString: aString setRunsChecking: anArray! - ^self basicNew setString: aString setRuns: anArray! Item was added: + ----- Method: Text class>>symbolSample (in category 'filler text') ----- + symbolSample + "Symbols are specific to a font family. We cannot know which code points are supported and how symbols will look like. Thus, you should ask the font of your choice to provide you with a #symbolSample." + + ^ TextStyle defaultFont symbolSample! Item was added: + ----- Method: Text class>>textSample (in category 'filler text') ----- + textSample + + ^ self streamContents: [:stream | + stream + nextPutAll: self hamburgefonstiv; cr; + nextPutAll: self theQuickBrownFox; cr; + nextPutAll: self THEQUICKBROWNFOX; cr; cr; + nextPutAll: self allDigits; cr; cr; + nextPutAll: self loremIpsum]! Item was added: + ----- Method: Text class>>theQuickBrownFox (in category 'filler text') ----- + theQuickBrownFox + + ^ self fromString: 'the quick brown fox jumps over the lazy dog'! Item was changed: ----- Method: Text>><=> (in category 'sorting') ----- <=> aCharacterArray "Return a collation order of -1, 0, or 1, indicating whether I should be collated before the receiver, am equal, or after. See also: http://en.wikipedia.org/wiki/Spaceship_operator" + aCharacterArray isString ifTrue: [ ^string <=> aCharacterArray ]. + ^string <=> aCharacterArray asString! - ^string = aCharacterArray - ifTrue: [ 0 ] - ifFalse: [string < aCharacterArray asString - ifTrue: [ -1 ] - ifFalse: [ 1 ]]! Item was changed: ----- Method: Text>>= (in category 'comparing') ----- = other "Am I equal to the other Text or String? ***** Warning ***** Two Texts are considered equal if they have the same characters in them. They might have completely different emphasis, fonts, sizes, text actions, or embedded morphs. If you need to find out if one is a true copy of the other, you must do (text1 = text2 and: [text1 runs = text2 runs])." + other isText ifTrue: [ ^string = other string ]. + other isString ifTrue: [ ^string = other ]. + ^false! - other isText ifTrue: ["This is designed to run fast even for megabytes" - ^ string == other string or: [string = other string]]. - other isString ifTrue: [^ string == other or: [string = other]]. - ^ false! Item was added: + ----- Method: Text>>addAllAttributes: (in category 'emphasis') ----- + addAllAttributes: attributes + + attributes do: [:attribute | + self addAttribute: attribute].! Item was added: + ----- Method: Text>>addAllAttributes:from:to: (in category 'emphasis') ----- + addAllAttributes: attributes from: start to: stop + + attributes do: [:attribute | + self addAttribute: attribute from: start to: stop].! 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 added: + ----- Method: Text>>addAttribute:unless: (in category 'emphasis') ----- + addAttribute: anAttribute unless: aBlock + "Only add anAttribute when aBlock evaluates to false. Can be used to avoid overwriting existing attributes without knowing exactly where they are. Kind of complements the #dominates: protocol in TextAttribute." + + | offset | + self flag: #performance. "mt: Can we do this faster?" + runs copy withIndexDo: [:attrs :index | + (aBlock cull: attrs cull: index) + ifFalse: [offset ifNil: [ + offset := index]] + ifTrue: [offset ifNotNil: [ + self addAttribute: anAttribute from: offset to: index - 1. + offset := nil]]]. + offset ifNotNil: [ + self addAttribute: anAttribute from: offset to: self size].! Item was changed: ----- Method: Text>>alignmentAt:ifAbsent: (in category 'emphasis') ----- alignmentAt: characterIndex ifAbsent: aBlock | attributes emph | self size = 0 ifTrue: [^aBlock value]. emph := nil. + attributes := runs atPin: characterIndex. - attributes := runs at: characterIndex. attributes do:[:att | (att isKindOf: TextAlignment) ifTrue:[emph := att]]. emph ifNil: [ ^aBlock value ]. ^emph alignment! Item was added: + ----- Method: Text>>applyLanguageInformation: (in category 'accessing') ----- + applyLanguageInformation: aLanguage + "Apply language-specific information to the receiver. Note that aLanguage can be an instance of Locale or LanguageEnvironment here." + + self flag: #todo. "mt: Add and use a TextLanguage attribute to avoid having to modify the receiver's string contents. Then we could directly use locale or locale-id and avoid Squeak's custom leadingChar. Maybe the some language info (or sane defaults) can be derived from Unicode code points and blocks." + self string applyLanguageInformation: aLanguage.! Item was added: + ----- Method: Text>>asSymbol (in category 'converting') ----- + asSymbol + + ^ self asString asSymbol + ! Item was removed: - ----- Method: Text>>askIfAddStyle:req: (in category 'attributes') ----- - askIfAddStyle: priorMethod req: requestor - "Ask the user if we have a complex style (i.e. bold) for the first time" - | tell answ old | - (SystemBrowser browseWithPrettyPrint) - ifTrue: [self couldDeriveFromPrettyPrinting ifTrue: [^ self asString]]. - self runs coalesce. - self unembellished ifTrue: [^ self asString]. - priorMethod ifNotNil: [old := priorMethod getSourceFromFile]. - (old == nil or: [old unembellished]) - ifTrue: - [tell := 'This method contains style for the first time (e.g. bold or colored text). - Do you really want to save the style info?'. - answ := (UIManager default - chooseFrom: #('Save method with style' 'Save method simply') - title: tell). - answ = 2 ifTrue: [^ self asString]]! Item was changed: ----- Method: Text>>attributesAt: (in category 'emphasis') ----- attributesAt: characterIndex "Answer the code for characters in the run beginning at characterIndex." "NB: no senders any more (supplanted by #attributesAt:forStyle: but retained for the moment in order not to break user code that may exist somewhere that still calls this" | attributes | self size = 0 ifTrue: [^ Array with: (TextFontChange new fontNumber: 1)]. "null text tolerates access" + attributes := runs atPin: characterIndex. - attributes := runs at: characterIndex. ^ attributes! Item was changed: ----- Method: Text>>attributesAt:do: (in category 'emphasis') ----- attributesAt: characterIndex do: aBlock "Answer the code for characters in the run beginning at characterIndex." "NB: no senders any more (supplanted by #attributesAt:forStyle: but retained for the moment in order not to break user code that may exist somewhere that still calls this" self size = 0 ifTrue:[^self]. + (runs atPin: characterIndex) do: aBlock! - (runs at: characterIndex) do: aBlock! Item was changed: ----- Method: Text>>attributesAt:forStyle: (in category 'emphasis') ----- attributesAt: characterIndex forStyle: aTextStyle + "Answer text attributes for characters in the run beginning at characterIndex." + + ^ self + ifEmpty: [#("Rely on TextStyle >> #defaultFontIndex")] + ifNotEmpty: [runs atPin: characterIndex]! - "Answer the code for characters in the run beginning at characterIndex." - | attributes | - self size = 0 - ifTrue: [^ Array with: (TextFontChange new fontNumber: aTextStyle defaultFontIndex)]. "null text tolerates access" - attributes := runs at: characterIndex. - ^ attributes! Item was added: + ----- Method: Text>>colorAt: (in category 'emphasis') ----- + colorAt: characterIndex + + ^ self colorAt: characterIndex ifNone: [Color black]! Item was added: + ----- Method: Text>>colorAt:ifNone: (in category 'emphasis') ----- + colorAt: characterIndex ifNone: block + + self size = 0 ifTrue: [^ block value]. "null text tolerates access." + + ^ (runs atPin: characterIndex) + detect: [:attr | attr class == TextColor] + ifFound: [:attr | attr color] + ifNone: block! Item was removed: - ----- Method: Text>>embeddedMorphs (in category 'accessing') ----- - embeddedMorphs - "return the list of morphs embedded in me" - - | morphs | - morphs := IdentitySet new. - runs withStartStopAndValueDo: - [:start :stop :attribs | - attribs - do: [:attrib | attrib anchoredMorph ifNotNil: [morphs add: attrib anchoredMorph]]]. - ^morphs select: [:m | m isMorph]! Item was removed: - ----- Method: Text>>embeddedMorphsFrom:to: (in category 'accessing') ----- - embeddedMorphsFrom: start to: stop - "return the list of morphs embedded in me" - - | morphs | - morphs := IdentitySet new. - runs - runsFrom: start - to: stop - do: - [:attribs | - attribs - do: [:attr | attr anchoredMorph ifNotNil: [morphs add: attr anchoredMorph]]]. - ^morphs select: [:m | m isMorph]! Item was changed: ----- Method: Text>>emphasisAt: (in category 'emphasis') ----- emphasisAt: characterIndex "Answer the fontfor characters in the run beginning at characterIndex." | attributes | self size = 0 ifTrue: [^ 0]. "null text tolerates access" + attributes := runs atPin: characterIndex. - attributes := runs at: characterIndex. ^attributes inject: 0 into: [:emph :att | emph bitOr: att emphasisCode]. ! Item was added: + ----- Method: Text>>fontAt:withDefault: (in category 'emphasis') ----- + fontAt: characterIndex withDefault: aFont + "Answer the font for characters in the run beginning at characterIndex." + + | attributes font | + self size = 0 ifTrue: [^ aFont]. "null text tolerates access" + attributes := runs atPin: characterIndex. + font := aFont. "default" + attributes do: [:att | att forFontInStyle: nil do: [:f | font := f]]. + ^ font! Item was changed: ----- Method: Text>>fontAt:withStyle: (in category 'emphasis') ----- fontAt: characterIndex withStyle: aTextStyle "Answer the fontfor characters in the run beginning at characterIndex." | attributes font | self size = 0 ifTrue: [^ aTextStyle defaultFont]. "null text tolerates access" + attributes := runs atPin: characterIndex. - attributes := runs at: characterIndex. font := aTextStyle defaultFont. "default" attributes do: [:att | att forFontInStyle: aTextStyle do: [:f | font := f]]. ^ font! Item was changed: ----- Method: Text>>fontNumberAt: (in category 'emphasis') ----- fontNumberAt: characterIndex "Answer the fontNumber for characters in the run beginning at characterIndex." | attributes fontNumber | self size = 0 ifTrue: [^1]. "null text tolerates access" + attributes := runs atPin: characterIndex. - attributes := runs at: characterIndex. fontNumber := 1. attributes do: [:att | (att isMemberOf: TextFontChange) ifTrue: [fontNumber := att fontNumber]]. ^ fontNumber ! Item was added: + ----- Method: Text>>format: (in category 'formatting') ----- + format: arguments + "Format the receiver with arguments, respecting the attributes in both receiver and all collection elements that are texts. + + Complete example: + '\{ \} \\ <b>foo {1}</b> <u>bar {2}</u>' asTextFromHtml format: {12. 't<i>ex</i>t' asTextFromHtml}. + " + + ^ self class new: self size * 11 // 10 "+10%" streamContents: [ :output | + | nextIndex | + nextIndex := 1. + [ nextIndex <= self size ] whileTrue: [ + (self at: nextIndex) caseOf: { + [ $\ ] -> [ + nextIndex := nextIndex + 1. + output withAttributes: (runs at: nextIndex) do: [ + output nextPut: (self at: nextIndex) ] ]. + [ ${ ] -> [ + "Parse the index - a positive integer in base 10." + | digitValue collectionIndex attributes | + collectionIndex := 0. + attributes := Set new. + [ (digitValue := string basicAt: (nextIndex := nextIndex + 1)) between: 48 "$0 asciiValue" and: 57 "$9 asciiValue" ] whileTrue: [ + collectionIndex := collectionIndex * 10 + digitValue - 48 "$0 asciiValue". + attributes addAll: (runs at: nextIndex) ]. + digitValue = 125 "$} asciiValue" ifFalse: [ self error: ('{1} expected' translated format: {$}}) ]. + output withAttributes: attributes do: [ + output nextPutAll: (arguments at: collectionIndex) asStringOrText ] ] } + otherwise: [ + output withAttributes: (runs at: nextIndex) do: [ + output nextPut: (self at: nextIndex) ] ]. + nextIndex := nextIndex + 1 ] ]! Item was added: + ----- Method: Text>>hasClickableAttribute (in category 'testing') ----- + hasClickableAttribute + + ^ self runs anySatisfy: [:attrs | attrs anySatisfy: [:attr | + attr respondsTo: #mayActOnClick]]! Item was added: + ----- Method: Text>>hasColorAttribute (in category 'testing') ----- + hasColorAttribute + + ^ self runs anySatisfy: [:attrs | attrs anySatisfy: [:attr | + attr respondsTo: #color]]! Item was added: + ----- Method: Text>>hasFontAttribute (in category 'testing') ----- + hasFontAttribute + + ^ self runs anySatisfy: [:attrs | attrs anySatisfy: [:attr | + (attr respondsTo: #fontNumber) or: [attr respondsTo: #font]]]! Item was added: + ----- Method: Text>>hashWithInitialHash: (in category 'comparing') ----- + hashWithInitialHash: initialHash + "Implemented to be polymorphic with String" + ^ self string hashWithInitialHash: initialHash + ! Item was added: + ----- Method: Text>>indentationAmountAt: (in category 'attributes') ----- + indentationAmountAt: anInterval + anInterval do: + [ : position | self + attributesAt: position + do: [ : attr | attr isTextIndent ifTrue: [ ^ attr amount ] ] ]. + ^ 0! Item was changed: + ----- Method: Text>>isText (in category 'testing') ----- - ----- Method: Text>>isText (in category 'comparing') ----- isText ^ true! Item was changed: ----- Method: Text>>printHtmlOn: (in category 'html') ----- + printHtmlOn: aStream + + ^ self + printHtmlOn: aStream + breakLines: true! - printHtmlOn: aStream - - (HtmlReadWriter on: aStream) - nextPutText: self.! Item was added: + ----- Method: Text>>printHtmlOn:breakLines: (in category 'html') ----- + printHtmlOn: aStream breakLines: aBoolean + + (HtmlReadWriter on: aStream) + breakLines: aBoolean; + nextPutText: self.! Item was added: + ----- Method: Text>>removeAllAttributes (in category 'converting') ----- + removeAllAttributes + + runs := RunArray new: self size withAll: #().! 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]) ! Item was added: + ----- Method: Text>>removeAttributesThat: (in category 'converting') ----- + removeAttributesThat: removalBlock + "Enumerate all attributes in the receiver. Remove those passing removalBlock." + + self + removeAttributesThat: removalBlock + replaceAttributesThat: [:att | false] + by: nil.! Item was changed: ----- Method: Text>>removeAttributesThat:replaceAttributesThat:by: (in category 'converting') ----- removeAttributesThat: removalBlock replaceAttributesThat: replaceBlock by: convertBlock + "Enumerate all attributes in the receiver. Remove those passing removalBlock and replace those passing replaceBlock after converting it through convertBlock. All blocks may also accept a second and third argument indicating the start and stop positions of the current attribute." - "Enumerate all attributes in the receiver. Remove those passing removalBlock and replace those passing replaceBlock after converting it through convertBlock" | added removed | "Deliberately optimized for the no-op default." added := removed := nil. runs withStartStopAndValueDo: [ :start :stop :attribs | attribs do: [ :attrib | | new | + (removalBlock cull: attrib cull: start cull: stop) ifTrue:[ - (removalBlock value: attrib) ifTrue:[ removed ifNil:[removed := WriteStream on: #()]. removed nextPut: {start. stop. attrib}. ] ifFalse:[ + (replaceBlock cull: attrib cull: start cull: stop) ifTrue:[ - (replaceBlock value: attrib) ifTrue:[ removed ifNil:[removed := WriteStream on: #()]. removed nextPut: {start. stop. attrib}. + new := convertBlock cull: attrib cull: start cull: stop. - new := convertBlock value: attrib. added ifNil:[added := WriteStream on: #()]. added nextPut: {start. stop. new}. ]. ]. ]. ]. (added == nil and:[removed == nil]) ifTrue:[^self]. "otherwise do the real work" removed ifNotNil:[removed contents do:[:spec| self removeAttribute: spec last from: spec first to: spec second]]. added ifNotNil:[added contents do:[:spec| self addAttribute: spec last from: spec first to: spec second]].! Item was added: + ----- Method: Text>>replaceAttributesThat:by: (in category 'converting') ----- + replaceAttributesThat: replaceBlock by: convertBlock + "Enumerate all attributes in the receiver. Replace those passing replaceBlock after converting it through convertBlock." + + self + removeAttributesThat: [:att | false] + replaceAttributesThat: replaceBlock + by: convertBlock.! Item was changed: ----- Method: Text>>setString:setRunsChecking: (in category 'private') ----- setString: aString setRunsChecking: aRunArray + | stringSize runsSize | - "Check runs and do the best you can to make them fit..." - string := aString. - "check the runs" aRunArray ifNil: [^ aString asText]. - (aRunArray isKindOf: RunArray) ifFalse: [^ aString asText]. - aRunArray runs size = aRunArray values size ifFalse: [^ aString asText]. - aRunArray size = aString size ifFalse: [^ aString asText]. + "Check runs and do the best you can to make them fit..." + aRunArray runs size = aRunArray values size ifFalse: [^ aString asText]. "raise error here?" + runsSize := aRunArray size. + stringSize := string size. + runs := stringSize = runsSize + ifTrue: [aRunArray] + ifFalse: [ stringSize > runsSize + ifTrue: [aRunArray add: {} withOccurrences: stringSize - runsSize] + ifFalse: [aRunArray copyFrom: 1 to: stringSize]].! - runs := aRunArray.! Item was changed: + ----- Method: Text>>unembellished (in category 'testing') ----- - ----- Method: Text>>unembellished (in category 'attributes') ----- unembellished "Return true if the only emphases are the default font and bold" | font1 bold | font1 := TextFontChange defaultFontChange. bold := TextEmphasis bold. Text ignoreStyleIfOnlyBold ifFalse: ["Ignore font1 only or font1-bold followed by font1-plain" ^ (runs values = (Array with: (Array with: font1))) or: [runs values = (Array with: (Array with: font1 with: bold) with: (Array with: font1))]]. "If preference is set, then ignore any combo of font1 and bold" runs withStartStopAndValueDo: [:start :stop :emphArray | emphArray do: [:emph | (font1 = emph or: [bold = emph]) ifFalse: [^ false]]]. ^ true! Item was added: + ----- Method: Text>>withNoLineLongerThan: (in category 'converting') ----- + withNoLineLongerThan: numChars + "Font-specific version of String >> #withNoLineLongerThan: that supports font family and point size changes throughout the text. Compose the receiver's contents and answer a text that has all soft line breaks converted to hard line breaks. + NOTE THAT while we keep the name from the String protocol, it will happen that some lines are longer or shorter than numChars because composition happens in a rectangle. If you want a character-perfect result, call #withNoLineLongerThan: on the receiver's string contents. The average length of a line, however, will approximate numChars. + (Note that, in Morphic, you can use TextMorph if you want to keep the soft line breaks and not modify the text contents.)" + + | style paragraph | + self ifEmpty: [^ self copy]. + + (self environment classNamed: #NewParagraph) + ifNil: [^ (self asString withNoLineLongerThan: numChars) asText] + ifNotNil: [:paragraphClass | paragraph := paragraphClass new]. + + "Configure the paragraph with a text style. Use the default text style only if the receiver has no custom font set for the first character. In that case, use the style that comes with that custom font. Use #asNewTextStyle to create a copy that has the correct #defaultFont (and point size) set." + paragraph + compose: self + style: (style := (self fontAt: 1 withStyle: TextStyle default) + asNewTextStyle) + from: 1 + in: (0 at 0 extent: (style compositionWidthFor: numChars) @ 9999999). + + ^ paragraph asTextWithLineBreaks! Item was added: + ----- Method: Text>>withoutLeadingBlanks (in category 'converting') ----- + withoutLeadingBlanks + "Return a copy of the receiver from which leading blanks have been trimmed." + + | first | + first := string indexOfAnyOf: CharacterSet nonSeparators startingAt: 1. + first = 0 ifTrue: [ ^'' ]. "no non-separator character" + first = 1 ifTrue: [ ^self copy ]. + ^self + copyFrom: first + to: self size + ! Item was added: + ----- Method: TextAction class>>applyUserInterfaceTheme (in category 'preferences') ----- + applyUserInterfaceTheme + + Purple := nil.! Item was added: + ----- Method: TextAction class>>themePriority (in category 'preferences') ----- + themePriority + + ^ 60! Item was added: + ----- Method: TextAction class>>themeProperties (in category 'preferences') ----- + themeProperties + + ^ super themeProperties, { + { #color. 'Colors'. 'Color for clickable text links.' } + } ! Item was added: + ----- Method: TextAction>>actionColor (in category 'accessing') ----- + actionColor + + ^ Purple ifNil: [Purple := self userInterfaceTheme color ifNil: [Color r: 0.4 g: 0.0 b: 1]]! Item was changed: + ----- Method: TextAction>>analyze: (in category 'initialize-release') ----- - ----- Method: TextAction>>analyze: (in category 'as yet unclassified') ----- analyze: aString + "Analyze the selected text to find both the parameter to store and the text to emphesize (may be different from original selection). Does not return self!!. May be multiline or of the form: - "Analyze the selected text to find both the parameter to store and the text to emphesize (may be different from original selection). Does not return self!!. May be of the form: 3+4 <3+4> Click Here<3+4> <3+4>Click Here " "Obtain the showing text and the instructions" + | b1 b2 singleLine trim param show | - | b1 b2 trim param show | b1 := aString indexOf: $<. b2 := aString indexOf: $>. + singleLine := aString lineCount = 0. + (singleLine or: [(b1 < b2) & (b1 > 0)]) ifFalse: ["only one part" - (b1 < b2) & (b1 > 0) ifFalse: ["only one part" param := self validate: aString. param ifNil: [ ^{ nil. nil } ]. + ^ Array with: param with: (param size = 0 ifFalse: [param])]. - ^ Array with: param with: (param size = 0 ifTrue: [nil] ifFalse: [param])]. "Two parts" trim := aString withBlanksTrimmed. (trim at: 1) == $< ifTrue: [(trim last) == $> ifTrue: ["only instructions" param := self validate: (aString copyFrom: b1+1 to: b2-1). + show := param size = 0 ifFalse: [param]] - show := param size = 0 ifTrue: [nil] ifFalse: [param]] ifFalse: ["at the front" param := self validate: (aString copyFrom: b1+1 to: b2-1). + show := param size = 0 ifFalse: [aString copyFrom: b2+1 to: aString size]]] - show := param size = 0 ifTrue: [nil] - ifFalse: [aString copyFrom: b2+1 to: aString size]]] ifFalse: [(trim last) == $> ifTrue: ["at the end" param := self validate: (aString copyFrom: b1+1 to: b2-1). + show := param size = 0 ifFalse: [aString copyFrom: 1 to: b1-1]] + ifFalse: ["Arbitrary string. Let the compiler handle the complete string" + param := self validate: aString. + param ifNil: [ ^{ nil. nil }]. + show := (param size = 0 ifFalse: [param])]]. - show := param size = 0 ifTrue: [nil] - ifFalse: [aString copyFrom: 1 to: b1-1]] - ifFalse: ["Illegal -- <> has text on both sides" - show := nil]]. ^ Array with: param with: show ! Item was added: + ----- Method: TextAction>>applyUserInterfaceTheme (in category 'updating') ----- + applyUserInterfaceTheme + + "Ignore. Only class-side cache."! Item was added: + ----- Method: TextAction>>canApplyUserInterfaceTheme (in category 'updating') ----- + canApplyUserInterfaceTheme + + ^ false! Item was changed: + ----- Method: TextAction>>emphasizeScanner: (in category 'accessing') ----- - ----- Method: TextAction>>emphasizeScanner: (in category 'as yet unclassified') ----- emphasizeScanner: scanner "Set the emphasis for text display" + + scanner textColor: self actionColor.! - scanner textColor: Purple! Item was changed: + ----- Method: TextAction>>info (in category 'accessing') ----- - ----- Method: TextAction>>info (in category 'as yet unclassified') ----- info ^ 'no hidden info'! Item was changed: + ----- Method: TextAction>>validate: (in category 'initialize-release') ----- - ----- Method: TextAction>>validate: (in category 'as yet unclassified') ----- validate: aString "any format is OK with me" ^ aString! Item was added: + ----- Method: TextAlignment>>closeHtmlOn: (in category 'html') ----- + closeHtmlOn: aHtmlReadWriter + + self alignment = Centered ifTrue: [aHtmlReadWriter nextPutAll: '</center>']. + ({ Justified. LeftFlush. RightFlush. } includes: self alignment) + ifTrue: [aHtmlReadWriter nextPutAll: '</div>']. + ! Item was changed: + ----- Method: TextAlignment>>dominates: (in category 'testing') ----- - ----- Method: TextAlignment>>dominates: (in category 'as yet unclassified') ----- dominates: other + "Alignment dominates other alignments or indentations." + ^ other isTextAlignment or: [ other isTextIndent ]! - "There can be only one..." - ^self class == other class! Item was changed: + ----- Method: TextAlignment>>emphasizeScanner: (in category 'accessing') ----- - ----- Method: TextAlignment>>emphasizeScanner: (in category 'as yet unclassified') ----- emphasizeScanner: scanner "Set the emphasist for text scanning" scanner setAlignment: alignment.! Item was added: + ----- Method: TextAlignment>>isTextAlignment (in category 'testing') ----- + isTextAlignment + ^ true! Item was added: + ----- Method: TextAlignment>>openHtmlOn: (in category 'html') ----- + openHtmlOn: aHtmlReadWriter + + self alignment = Centered ifTrue: [aHtmlReadWriter nextPutAll: '<center>']. + self alignment = Justified ifTrue: [aHtmlReadWriter nextPutAll: '<div align=justify>']. + self alignment = LeftFlush ifTrue: [aHtmlReadWriter nextPutAll: '<div align=left>']. + self alignment = RightFlush ifTrue: [aHtmlReadWriter nextPutAll: '<div align=right>']. + ! Item was added: + ----- Method: TextAlignment>>shouldFormBlocks (in category 'testing') ----- + shouldFormBlocks + + ^ true! Item was added: + ----- Method: TextAttribute class>>scanFrom: (in category 'fileIn/Out') ----- + scanFrom: strm + "Read the text attribute properties from the stream. When this method has + been called the concrete TextAttribute class has already been selected via + scanCharacter. (see TextAttribute class>>#newFrom:). + For writing the format see TextAttribute>>#writeScanOn:"! Item was changed: + ----- Method: TextAttribute>>anchoredMorph (in category 'accessing') ----- - ----- Method: TextAttribute>>anchoredMorph (in category 'as yet unclassified') ----- anchoredMorph "If one hides here, return it" ^nil! Item was changed: + ----- Method: TextAttribute>>dominates: (in category 'testing') ----- - ----- Method: TextAttribute>>dominates: (in category 'as yet unclassified') ----- dominates: another "Subclasses may override condense multiple attributes" ^ false! Item was changed: + ----- Method: TextAttribute>>emphasisCode (in category 'accessing') ----- - ----- Method: TextAttribute>>emphasisCode (in category 'as yet unclassified') ----- emphasisCode "Subclasses may override to add bold, italic, etc" ^ 0! Item was changed: + ----- Method: TextAttribute>>emphasizeScanner: (in category 'accessing') ----- - ----- Method: TextAttribute>>emphasizeScanner: (in category 'as yet unclassified') ----- emphasizeScanner: scanner "Subclasses may override to set, eg, font, color, etc"! Item was changed: + ----- Method: TextAttribute>>forFontInStyle:do: (in category 'private') ----- - ----- Method: TextAttribute>>forFontInStyle:do: (in category 'as yet unclassified') ----- forFontInStyle: aTextStyle do: aBlock "No action is the default. Overridden by font specs"! Item was added: + ----- Method: TextAttribute>>isOblivious (in category 'testing') ----- + isOblivious + "Mark text attributes to be removed upon interaction such as copy-and-paste." + + ^ false! Item was added: + ----- Method: TextAttribute>>isTextAlignment (in category 'testing') ----- + isTextAlignment + ^ false! Item was added: + ----- Method: TextAttribute>>isTextFontChange (in category 'testing') ----- + isTextFontChange + ^ false! Item was added: + ----- Method: TextAttribute>>isTextIndent (in category 'testing') ----- + isTextIndent + ^ false! Item was changed: + ----- Method: TextAttribute>>mayActOnClick (in category 'testing') ----- - ----- Method: TextAttribute>>mayActOnClick (in category 'as yet unclassified') ----- mayActOnClick "Subclasses may override to provide, eg, hot-spot actions" ^ false! Item was changed: + ----- Method: TextAttribute>>mayBeExtended (in category 'testing') ----- - ----- Method: TextAttribute>>mayBeExtended (in category 'as yet unclassified') ----- mayBeExtended "A quality that may be overridden by subclasses, such as TextAnchors, that really only apply to a single character" ^ true! Item was changed: + ----- Method: TextAttribute>>menu (in category 'accessing') ----- - ----- Method: TextAttribute>>menu (in category 'as yet unclassified') ----- menu ^nil! Item was changed: + ----- Method: TextAttribute>>oldEmphasisCode: (in category 'accessing') ----- - ----- Method: TextAttribute>>oldEmphasisCode: (in category 'as yet unclassified') ----- oldEmphasisCode: default "Allows running thorugh possibly multiple attributes and getting the emphasis out of any that has an emphasis (font number)" ^ default! Item was changed: + ----- Method: TextAttribute>>reset (in category 'initialize-release') ----- - ----- Method: TextAttribute>>reset (in category 'as yet unclassified') ----- reset "Allow subclasses to prepare themselves for merging attributes"! Item was changed: + ----- Method: TextAttribute>>set (in category 'accessing') ----- - ----- Method: TextAttribute>>set (in category 'as yet unclassified') ----- set "Respond true to include this attribute (as opposed to, eg, a bold emphasizer that is clearing the property" ^ true! Item was added: + ----- Method: TextAttribute>>shouldFormBlocks (in category 'html') ----- + shouldFormBlocks + " whether this attribute should form larger blocks even if split up for combination with other attributes " + ^ false! Item was added: + ----- Method: TextAttribute>>turnOff (in category 'initialize-release') ----- + turnOff + "Backstop for TextEmphasis. Do nothing." + + self flag: #refactor. "mt: Needs clean-up together with of #dominates: is used in the image." + ! Item was added: + ----- Method: TextAttribute>>writeScanOn: (in category 'fileIn/fileOut') ----- + writeScanOn: strm + "Implement this method for a text attribute to define how it it should be written + to a serialized form of a text object. The form should correspond to the source + file format, i.e. use a scan character to denote its subclass. + As TextAttributes are stored in RunArrays, this method is mostly called from RunArray>>#write scan. + For reading the written information see TextAttribute class>>#scanFrom:" + + "Do nothing because of abstract class"! Item was changed: + ----- Method: TextDoIt>>actOnClickFor: (in category 'event handling') ----- - ----- Method: TextDoIt>>actOnClickFor: (in category 'as yet unclassified') ----- actOnClickFor: anObject "Note: evalString gets evaluated IN THE CONTEXT OF anObject -- meaning that self and all instVars are accessible" + Project current addDeferredUIMessage: [Compiler evaluate: evalString for: anObject]. - Compiler evaluate: evalString for: anObject. ^ true ! Item was changed: + ----- Method: TextDoIt>>analyze: (in category 'initialize-release') ----- - ----- Method: TextDoIt>>analyze: (in category 'as yet unclassified') ----- analyze: aString | list | list := super analyze: aString. + evalString := (list at: 1) asString. - evalString := list at: 1. ^ list at: 2! Item was added: + ----- Method: TextDoIt>>closeHtmlOn: (in category 'html') ----- + closeHtmlOn: aStream + + self evalString lines size > 1 ifTrue: [ + aStream + breakLines: true; + nextPutAll: '</pre>']. + aStream nextPutAll: '</code>'. + ! Item was added: + ----- Method: TextDoIt>>emphasizeScanner: (in category 'accessing') ----- + emphasizeScanner: scanner + scanner addEmphasis: 4! Item was changed: + ----- Method: TextDoIt>>info (in category 'accessing') ----- - ----- Method: TextDoIt>>info (in category 'as yet unclassified') ----- info ^ evalString! Item was added: + ----- Method: TextDoIt>>openHtmlOn: (in category 'html') ----- + openHtmlOn: aStream + + aStream nextPutAll: '<code>'. + self evalString lines size > 1 ifTrue: [ + aStream + breakLines: false; + cr; + nextPutAll: '<pre>'].! Item was added: + ----- Method: TextDoIt>>shouldFormBlocks (in category 'html') ----- + shouldFormBlocks + + ^ true! Item was changed: ----- Method: TextEmphasis>>closeHtmlOn: (in category 'html') ----- closeHtmlOn: aStream "put on the given stream the tag to close the html representation of the receiver" emphasisCode = 1 ifTrue: [aStream nextPutAll: '</b>']. emphasisCode = 2 ifTrue: [aStream nextPutAll: '</i>']. emphasisCode = 4 + ifTrue: [aStream nextPutAll: '</u>']. + emphasisCode = 16 + ifTrue: [aStream nextPutAll: '</s>'].! - ifTrue: [aStream nextPutAll: '</u>']! Item was changed: + ----- Method: TextEmphasis>>dominates: (in category 'testing') ----- - ----- Method: TextEmphasis>>dominates: (in category 'as yet unclassified') ----- dominates: other (emphasisCode = 0 and: [other dominatedByCmd0]) ifTrue: [^ true]. ^ (other class == self class) and: [emphasisCode = other emphasisCode]! Item was changed: + ----- Method: TextEmphasis>>emphasizeScanner: (in category 'accessing') ----- - ----- Method: TextEmphasis>>emphasizeScanner: (in category 'as yet unclassified') ----- emphasizeScanner: scanner "Set the emphasist for text scanning" scanner addEmphasis: emphasisCode! Item was changed: ----- Method: TextEmphasis>>openHtmlOn: (in category 'html') ----- openHtmlOn: aStream "put on the given stream the tag to open the html representation of the receiver" emphasisCode = 1 ifTrue: [aStream nextPutAll: '<b>']. emphasisCode = 2 ifTrue: [aStream nextPutAll: '<i>']. emphasisCode = 4 + ifTrue: [aStream nextPutAll: '<u>']. + emphasisCode = 16 + ifTrue: [aStream nextPutAll: '<s>']! - ifTrue: [aStream nextPutAll: '<u>']! Item was added: + ----- Method: TextFontChange>>canFontBeSubstituted (in category 'testing') ----- + canFontBeSubstituted + "Generic font changes rely on text styles, which should always contain generic fonts." + + ^ true! Item was added: + ----- Method: TextFontChange>>dominatedByCmd0 (in category 'testing') ----- + dominatedByCmd0 + "Revert to default font using current paragraph's text style. See TextStyle >> #defaultFont." + + ^ true! Item was changed: + ----- Method: TextFontChange>>dominates: (in category 'testing') ----- - ----- Method: TextFontChange>>dominates: (in category 'as yet unclassified') ----- dominates: other ^ other isKindOf: TextFontChange! Item was changed: + ----- Method: TextFontChange>>emphasizeScanner: (in category 'accessing') ----- - ----- Method: TextFontChange>>emphasizeScanner: (in category 'as yet unclassified') ----- emphasizeScanner: scanner "Set the font for text display" scanner setFont: fontNumber! Item was changed: + ----- Method: TextFontChange>>forFontInStyle:do: (in category 'private') ----- + forFontInStyle: aTextStyleOrNil do: aBlock + + ^ aTextStyleOrNil ifNotNil: [aBlock value: (aTextStyleOrNil fontAt: fontNumber)]! - ----- Method: TextFontChange>>forFontInStyle:do: (in category 'as yet unclassified') ----- - forFontInStyle: aTextStyle do: aBlock - aBlock value: (aTextStyle fontAt: fontNumber)! Item was added: + ----- Method: TextFontChange>>isTextFontChange (in category 'testing') ----- + isTextFontChange + ^ true! Item was added: + ----- Method: TextFontReference>>canFontBeSubstituted (in category 'testing') ----- + canFontBeSubstituted + "Absolute font references can only be replaced if the referenced font has different glyphs for different characters." + + ^ (self font class name = #FixedFaceFont "e.g. password font" + or: [self font class name = #FormSetFont "e.g. embedded pictures/forms"]) not! Item was added: + ----- Method: TextFontReference>>closeHtmlOn: (in category 'html') ----- + closeHtmlOn: aStream + + font closeHtmlOn: aStream.! Item was changed: + ----- Method: TextFontReference>>forFontInStyle:do: (in category 'private') ----- - ----- Method: TextFontReference>>forFontInStyle:do: (in category 'as yet unclassified') ----- forFontInStyle: aTextStyle do: aBlock aBlock value: font! Item was added: + ----- Method: TextFontReference>>openHtmlOn: (in category 'html') ----- + openHtmlOn: aStream + + font openHtmlOn: aStream.! Item was added: + ----- Method: TextIndent class>>scanCharacter (in category 'fileIn/Out') ----- + scanCharacter + "The character used to identify a subclass of TextAttribute for filein and fileout" + ^ $I! Item was added: + ----- Method: TextIndent class>>scanFrom: (in category 'fileIn/Out') ----- + scanFrom: aStream + + ^ self amount: (Integer readFrom: aStream)! Item was changed: + ----- Method: TextIndent>>amount (in category 'accessing') ----- - ----- Method: TextIndent>>amount (in category 'access') ----- amount "number of tab spaces to indent by" ^amount! Item was changed: + ----- Method: TextIndent>>amount: (in category 'accessing') ----- - ----- Method: TextIndent>>amount: (in category 'access') ----- amount: anInteger "change the number of tabs to indent by" amount := anInteger! Item was changed: ----- Method: TextIndent>>dominates: (in category 'condensing') ----- + dominates: aTextAttribute + "Indentation should replace any existing alignment or indentation." + ^ aTextAttribute isTextIndent + or: [ aTextAttribute isTextAlignment ]! - dominates: anAttribute - ^(self class == anAttribute class)! Item was added: + ----- Method: TextIndent>>isTextIndent (in category 'testing') ----- + isTextIndent + ^ true! Item was added: + ----- Method: TextIndent>>shouldFormBlocks (in category 'testing') ----- + shouldFormBlocks + + ^ true! Item was added: + ----- Method: TextIndent>>writeScanOn: (in category 'fileIn/fileOut') ----- + writeScanOn: aStream + + aStream + nextPut: self class scanCharacter; + store: self amount.! Item was added: + TextDoIt subclass: #TextInspectIt + instanceVariableNames: 'target' + classVariableNames: '' + poolDictionaries: '' + category: 'Collections-Text'! Item was added: + ----- Method: TextInspectIt class>>on: (in category 'instance creation') ----- + on: anObject + + ^ self new target: anObject; yourself! Item was added: + ----- Method: TextInspectIt>>actOnClickFor:in:at:editor: (in category 'mouse events') ----- + actOnClickFor: anObject in: aParagraph at: clickPoint editor: editor + "Note: evalString gets evaluated IN THE CONTEXT OF anObject + -- meaning that self and all instVars are accessible" + Project current addDeferredUIMessage: [ + self target + ifNil: [(Compiler evaluate: evalString for: anObject) inspect] + ifNotNil: [:object | object inspect] ]. + ^ true ! Item was added: + ----- Method: TextInspectIt>>emphasizeScanner: (in category 'accessing') ----- + emphasizeScanner: scanner + "Set the emphasis for text display" + + scanner textColor: self actionColor.! Item was added: + ----- Method: TextInspectIt>>isOblivious (in category 'testing') ----- + isOblivious + "Avoid spreading object references by copy-and-paste." + + ^ true! Item was added: + ----- Method: TextInspectIt>>target (in category 'accessing') ----- + target + + ^ target! Item was added: + ----- Method: TextInspectIt>>target: (in category 'accessing') ----- + target: anObject + + target := anObject.! Item was changed: ----- Method: TextLink>>actOnClickFor: (in category 'event handling') ----- actOnClickFor: aMessageSet "Add to the end of the list. 'aClass selector', 'aClass Comment', 'aClass Definition', 'aClass Hierarchy' are the formats allowed." + Project current addDeferredUIMessage: [aMessageSet addItem: classAndMethod]. - aMessageSet addItem: classAndMethod. ^ true! Item was changed: ----- Method: TextLink>>validate: (in category 'initialize-release') ----- validate: specString "Can this string be decoded to be Class space Method (or Comment, Definition, Hierarchy)? If so, return it in valid format, else nil" | list first mid last | list := specString findTokens: ' .|'. list isEmpty ifTrue: [ ^nil ]. last := list last. last first isUppercase ifTrue: [ + (#('Comment' 'Definition' 'Hierarchy' 'Help') includes: last) ifFalse: [^ nil]. - (#('Comment' 'Definition' 'Hierarchy') includes: last) ifFalse: [^ nil]. "Check for 'Rectangle Comment Comment' and remove last one" (list at: list size - 1 ifAbsent: [^nil]) = last ifTrue: [list := list allButLast]]. list size > 3 ifTrue: [^ nil]. list size < 2 ifTrue: [^ nil]. + first := Symbol lookup: list first. - Symbol hasInterned: list first ifTrue: [:sym | first := sym]. first ifNil: [^ nil]. Smalltalk at: first ifAbsent: [^ nil]. mid := list size = 3 ifTrue: [(list at: 2) = 'class' ifTrue: ['class '] ifFalse: [^ nil]] ifFalse: ['']. "OK if method name is not interned -- may not be defined yet" ^ first, ' ', mid, last! Item was changed: Object subclass: #TextReadWriter instanceVariableNames: 'stream' classVariableNames: '' poolDictionaries: '' category: 'Collections-Text'! + + !TextReadWriter commentStamp: 'mt 5/7/2016 10:22' prior: 0! + Subclasses of me provide means to create instances of Text from various document formats such as HTML (Hyper Text Markup Language), DOCX (Microsoft Word Document), ODF (Open Document Format), and RTF (Rich Text Format). They should also be able to write such formats.! Item was added: + ----- Method: TextReadWriter class>>textFromFileNamed: (in category 'instance creation') ----- + textFromFileNamed: fileName + + ^ self textFromStream: (FileStream readOnlyFileNamed: fileName)! Item was added: + ----- Method: TextReadWriter class>>textFromStream: (in category 'instance creation') ----- + textFromStream: aBinaryStream + + | reader readerClass text | + readerClass := self. "no auto-detection yet" + aBinaryStream reset. + reader := readerClass new on: aBinaryStream. + Cursor read showWhile: [ + text := reader nextText. + reader close]. + ^ text + ! Item was added: + ----- Method: TextReadWriter>>close (in category 'initialize-release') ----- + close + + stream close.! Item was changed: + ----- Method: TextStream>>applyAttribute:beginningAt: (in category 'private') ----- - ----- Method: TextStream>>applyAttribute:beginningAt: (in category 'as yet unclassified') ----- applyAttribute: att beginningAt: startPos collection addAttribute: att from: startPos to: self position! Item was changed: + ----- Method: TextStream>>nextPutAll: (in category 'writing') ----- - ----- Method: TextStream>>nextPutAll: (in category 'as yet unclassified') ----- nextPutAll: aCollection "Optimized access to get around Text at:Put: overhead" | n | n := aCollection size. position + n > writeLimit ifTrue: + [self growTo: position + n]. - [self growTo: position + n + 10]. collection replaceFrom: position+1 to: position + n with: aCollection startingAt: 1. position := position + n. ^aCollection! Item was changed: + ----- Method: TextStream>>withAttribute:do: (in category 'private') ----- - ----- Method: TextStream>>withAttribute:do: (in category 'as yet unclassified') ----- withAttribute: att do: strmBlock | pos1 val | pos1 := self position. val := strmBlock value. collection addAttribute: att from: pos1+1 to: self position. ^ val! Item was changed: + ----- Method: TextStream>>withAttributes:do: (in category 'private') ----- - ----- Method: TextStream>>withAttributes:do: (in category 'as yet unclassified') ----- withAttributes: attributes do: streamBlock | pos1 val | pos1 := self position. val := streamBlock value. attributes do: [:attribute | collection addAttribute: attribute from: pos1 + 1 to: self position]. ^ val! Item was added: + ----- Method: TextURL class>>url: (in category 'instance creation') ----- + url: anUrl + + ^ self new + url: anUrl; + yourself! Item was changed: + ----- Method: TextURL>>analyze: (in category 'initialize-release') ----- - ----- Method: TextURL>>analyze: (in category 'as yet unclassified') ----- analyze: aString + | list answer | - | list | list := super analyze: aString. + + answer := Project uiManager multiLineRequest: 'URL to open' translated centerAt: Sensor cursorPoint initialAnswer: (list at: 1) answerHeight: 200. + answer isEmptyOrNil ifTrue: [^ nil]. + url := answer. + - url := list at: 1. ^ list at: 2! Item was added: + ----- Method: TextURL>>closeHtmlOn: (in category 'html') ----- + closeHtmlOn: aStream + + aStream nextPutAll: '</a>'.! Item was added: + ----- Method: TextURL>>openHtmlOn: (in category 'html') ----- + openHtmlOn: aStream + + aStream + nextPutAll: '<a href="'; + nextPutAll: self url; + nextPutAll: '">'.! Item was added: + ----- Method: TextURL>>url (in category 'accessing') ----- + url + ^ url! Item was changed: WriteStream subclass: #TranscriptStream + instanceVariableNames: 'lastChar lock' + classVariableNames: 'CharacterLimit ForceUpdate RedirectToStdOut' - instanceVariableNames: 'lastChar' - classVariableNames: 'AccessSema ForceUpdate RedirectToStdOut' poolDictionaries: '' category: 'Collections-Streams'! !TranscriptStream commentStamp: 'fbs 12/30/2013 09:53' prior: 0! This class is a much simpler implementation of Transcript protocol that supports multiple views and very simple conversion to morphic. Because it inherits from Stream, it is automatically compatible with code that is designed to write to streams.! Item was added: + ----- Method: TranscriptStream class>>characterLimit (in category 'preferences') ----- + characterLimit + <preference: 'Maximum number of characters in a transcript' + categoryList: #(printing morphic debug) + description: 'When the number of characters in a transcript exceeds this limit, characters at the start of the text are discarded.' + type: #Number> + ^CharacterLimit ifNil: [20000]! Item was added: + ----- Method: TranscriptStream class>>characterLimit: (in category 'preferences') ----- + characterLimit: anInteger + + CharacterLimit := anInteger.! Item was changed: ----- Method: TranscriptStream class>>redirectToStdOut (in category 'preferences') ----- redirectToStdOut <preference: 'Redirect transcript to stdout' categoryList: #(printing morphic debug) + description: 'When enabled, anything sent to the transcript will be redirected to the stdout stream and (hopefully) the OS terminal.' - description: 'When enabled, no Morphic is needed when using the transcript interface to debug.' type: #Boolean> ^ RedirectToStdOut ifNil: [false]! Item was changed: ----- Method: TranscriptStream class>>redirectToStdOut: (in category 'preferences') ----- + redirectToStdOut: aBooleanOrNil + "In setting up redirection, first remove all dependents that are stdout, + which may include stale files from the last session. Then add a dependency + only if asked to redirect to stdout. Blithely doing + Transcript removeDependent: FileStream stdout + raises an error if stdout is unavailable." + Transcript dependents do: + [:dep| + (dep isStream and: [dep name = #stdout]) ifTrue: + [Transcript removeDependent: dep]]. + RedirectToStdOut := aBooleanOrNil. + self redirectToStdOut ifTrue: + [Transcript addDependent: FileStream stdout]! - redirectToStdOut: aBoolean - - RedirectToStdOut := aBoolean.! Item was changed: ----- Method: TranscriptStream class>>registerInFlapsRegistry (in category 'class initialization') ----- registerInFlapsRegistry "Register the receiver in the system's flaps registry" self environment at: #Flaps + ifPresent: [:cl | cl registerQuad: {#TranscriptStream. #openMorphicTranscript. 'Transcript' translatedNoop. 'A Transcript is a window usable for logging and debugging; browse references to #Transcript for examples of how to write to it.' translatedNoop} - ifPresent: [:cl | cl registerQuad: #(TranscriptStream openMorphicTranscript 'Transcript' 'A Transcript is a window usable for logging and debugging; browse references to #Transcript for examples of how to write to it.') forFlapNamed: 'Tools'] ! Item was added: + ----- Method: TranscriptStream class>>themeProperties (in category 'preferences') ----- + themeProperties + + ^ Model themeProperties! Item was added: + ----- Method: TranscriptStream>>addModelItemsToWindowMenu: (in category 'menu') ----- + addModelItemsToWindowMenu: aMenu + + aMenu addLine. + aMenu + add: 'clear' translated + target: self + action: #clear.! Item was added: + ----- Method: TranscriptStream>>applyUserInterfaceTheme (in category 'model protocol') ----- + applyUserInterfaceTheme + + self dependents do: [:ea | + ea isSystemWindow ifTrue: [ + ea refreshWindowColor]].! Item was changed: + ----- Method: TranscriptStream>>characterLimit (in category 'accessing') ----- - ----- Method: TranscriptStream>>characterLimit (in category 'access') ----- characterLimit "Tell the views how much to retain on screen" + ^self class characterLimit! - ^ 20000! Item was changed: ----- Method: TranscriptStream>>endEntry (in category 'stream extensions') ----- endEntry "Display all the characters since the last endEntry, and reset the stream" + self lock critical: + [(self == Transcript and: [self class redirectToStdOut]) + ifTrue: + [FileStream stdout nextPutAll: self contents; flush] + ifFalse: + [self changed: (self class forceUpdate + ifTrue: [#appendEntry] + ifFalse: [#appendEntryLater])]. + self reset]! - self semaphore critical:[ - self class forceUpdate - ifTrue: [self changed: #appendEntry] - ifFalse: [self changed: #appendEntryLater]. - self reset. - ].! Item was added: + ----- Method: TranscriptStream>>lock (in category 'private') ----- + lock + ^lock ifNil:[lock := Mutex new]! Item was removed: - ----- Method: TranscriptStream>>perform:orSendTo: (in category 'model protocol') ----- - perform: selector orSendTo: otherTarget - "Selector was just chosen from a menu by a user. If can respond, then - perform it on myself. If not, send it to otherTarget, presumably the - editPane from which the menu was invoked." - - (self respondsTo: selector) - ifTrue: [^ self perform: selector] - ifFalse: [^ otherTarget perform: selector]! Item was added: + ----- Method: TranscriptStream>>reset (in category 'positioning') ----- + reset + "Override to set lastChar" + position > 0 ifTrue: + [lastChar := collection at: position]. + ^super reset! Item was removed: - ----- Method: TranscriptStream>>semaphore (in category 'private') ----- - semaphore - ^AccessSema ifNil:[AccessSema := Semaphore forMutualExclusion]! Item was changed: ----- Method: TranscriptStream>>show: (in category 'stream extensions') ----- show: anObject "TextCollector compatibility" [ + self nextPutAll: anObject asString. - self target nextPutAll: anObject asString. self endEntry ] on: FileWriteError do: [self class redirectToStdOut: false].! Item was changed: ----- Method: TranscriptStream>>showln: (in category 'stream extensions') ----- showln: anObject "TextCollector compatibility. Ensure a new line before inserting a message." [ + self - self target cr; nextPutAll: anObject asString. self endEntry. ] on: FileWriteError do: [self class redirectToStdOut: false].! Item was changed: ----- Method: TranscriptStream>>target (in category 'stream extensions') ----- target + ^(self == Transcript and: [self class redirectToStdOut]) - - ^ self class redirectToStdOut ifTrue: [FileStream stdout] ifFalse: [self]! Item was added: + ----- Method: TranscriptStream>>windowActiveOnFirstClick (in category 'model protocol') ----- + windowActiveOnFirstClick + + ^ Model windowActiveOnFirstClick! Item was added: + ----- Method: TranscriptStream>>windowColorToUse (in category 'model protocol') ----- + windowColorToUse + + ^ Color colorFrom: (Model useColorfulWindows + ifTrue: [self userInterfaceTheme customWindowColor ifNil: [Color r: 0.9 g: 0.75 b: 0.45]] + ifFalse: [self userInterfaceTheme uniformWindowColor ifNil: [Color veryVeryLightGray]])! 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! Item was added: + RawBitsArray subclass: #UnsignedIntegerArray + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Collections-Arrayed'! + + !UnsignedIntegerArray commentStamp: 'nice 5/10/2020 16:00' prior: 0! + UnsignedIntegerArray is an abstract class for all arrays of unsigned integer of fixed bit-width. + + ! Item was added: + ----- Method: UnsignedIntegerArray>>atAllPut: (in category 'accessing') ----- + atAllPut: value + "Fill the receiver with the given value" + + <primitive: 145> + super atAllPut: value! Item was added: + ----- Method: UnsignedIntegerArray>>defaultElement (in category 'accessing') ----- + defaultElement + "Return the default element of the receiver" + ^0! Item was added: + ----- Method: UnsignedIntegerArray>>isUnsignedIntegerArray (in category 'testing') ----- + isUnsignedIntegerArray + ^true! Item was added: + ----- Method: UnsignedIntegerArray>>replaceFrom:to:with:startingAt: (in category 'private') ----- + replaceFrom: start to: stop with: replacement startingAt: repStart + <primitive: 105> + ^super replaceFrom: start to: stop with: replacement startingAt: repStart ! Item was added: + Link subclass: #ValueLink + instanceVariableNames: 'value' + classVariableNames: '' + poolDictionaries: '' + category: 'Collections-Support'! + + !ValueLink commentStamp: 'HenrikSperreJohansen 10/18/2009 15:57' prior: 0! + A ValueLink is a Link containing a Value. + Adding an object to a LinkedList which is not a Link will create a ValueLink containing that object. + + + value - The object this link points to.! Item was added: + ----- Method: ValueLink class>>value: (in category 'instance creation') ----- + value: aValue + + ^self new value: aValue! Item was added: + ----- Method: ValueLink>>= (in category 'comparing') ----- + = anotherObject + + ^self species == anotherObject species + and: [self value = anotherObject value + and: [self nextLink == anotherObject nextLink]]! Item was added: + ----- Method: ValueLink>>hash (in category 'comparing') ----- + hash + + ^self value hash bitXor: self nextLink identityHash + ! Item was added: + ----- Method: ValueLink>>printOn: (in category 'printing') ----- + printOn: aStream + + super printOn: aStream. + aStream nextPut: $(. + value printOn: aStream. + aStream nextPut: $) + ! Item was added: + ----- Method: ValueLink>>value (in category 'accessing') ----- + value + + ^ value! Item was added: + ----- Method: ValueLink>>value: (in category 'accessing') ----- + value: anObject + + value := anObject.! Item was added: + ----- Method: WeakArray class>>primitiveFetchMourner (in category 'private') ----- + primitiveFetchMourner + "Answer the next mourner in the VM's queue of objects to be finalized. + The queue contains weak arrays and ephemerons. If the primitive is + not implemented, raise an error telling people to upgrade the VM. If + implemented, the primitive fails if the queue is empty, with the error + code #'not found'. Primitive. Essential." + + <primitive: 172 error: ec> + ec ifNil: [^self error: 'The primitiveFetchMourner primitive is missing.\Please upgrade your virtual machine to one that has the primitive.' withCRs]. + ^nil! Item was removed: - ----- Method: WeakArray class>>pvtCreateTemporaryObjectIn: (in category 'private') ----- - pvtCreateTemporaryObjectIn: tempObject - "We have to create the temporary object in a separate stack frame" - tempObject at: 1 put: Object new! Item was changed: ----- Method: WeakArray class>>restartFinalizationProcess (in category 'private') ----- restartFinalizationProcess "kill any old process, just in case" + FinalizationProcess ifNotNil: + [FinalizationProcess terminate. + FinalizationProcess := nil]. - FinalizationProcess - ifNotNil: [FinalizationProcess terminate. - FinalizationProcess := nil]. FinalizationSemaphore := Smalltalk specialObjectsArray at: 42. FinalizationDependents ifNil: [FinalizationDependents := WeakArray new: 10]. FinalizationLock := Semaphore forMutualExclusion. FinalizationProcess := [self finalizationProcess] + forkAt: Processor userInterruptPriority + 1 + named: 'the finalization process'! - forkAt: Processor userInterruptPriority! Item was added: + IdentityDictionary subclass: #WeakIdentityDictionary + instanceVariableNames: 'vacuum' + classVariableNames: '' + poolDictionaries: '' + category: 'Collections-Weak'! + + !WeakIdentityDictionary commentStamp: 'nice 8/17/2022 15:45' prior: 0! + I am a WeakIdentityDictionary, that is a dictionary pointing weakly to its associations of key->value pairs. + I am especially usefull for handling undeclared bindings that will be naturally garbage collected without having to scan all the CompiledMethods. + + Instance variables: + vacuum <Object> a unique object used for marking empty slots + + Due to usage of WeakArray for my own storage, reclaimed slots will be nilled out. + I cannot consider a nil slot as empty because garbage collection does not fix collisions. + Thus I need to differentiate empty slots (vacuum) from garbaged collected slots (nil). + + If I did not reclaim the nil slots and make them vacuum again, then my capacity would grow indefinitely. + I skip those nil slots when growing in order to avoid such unbounded growth (see #growTo:). + + Due to those not yet cleaned-up nil slots I might over-estimate my size. See #slowSize to get a more relevant but slower answer.! Item was added: + ----- Method: WeakIdentityDictionary>>add: (in category 'accessing') ----- + add: anAssociation + + | index | + index := self scanFor: anAssociation key. + (array at: index) + ifNil: [ self atNewIndex: index put: anAssociation ] + ifNotNil: [ :element | + element == vacuum + ifTrue: [ self atNewIndex: index put: anAssociation ] + ifFalse: [ element value: anAssociation value ] ]. + ^anAssociation! Item was added: + ----- Method: WeakIdentityDictionary>>arrayType (in category 'private') ----- + arrayType + ^ WeakArray! Item was added: + ----- Method: WeakIdentityDictionary>>associationAt:ifAbsent: (in category 'accessing') ----- + associationAt: key ifAbsent: aBlock + "Answer the association with the given key. + If key is not found, return the result of evaluating aBlock." + + ^((array at: (self scanFor: key)) + ifNil: [ aBlock value ] + ifNotNil: [:association | + association == vacuum + ifTrue: [ aBlock value ] + ifFalse: [ association ] ])! Item was added: + ----- Method: WeakIdentityDictionary>>associationsDo: (in category 'enumerating') ----- + associationsDo: aBlock + "Evaluate aBlock for each of the receiver's elements (key/value + associations)." + + tally = 0 ifTrue: [ ^self]. + 1 to: array size do: [ :index | + (array at: index) ifNotNil: [ :element | + element == vacuum ifFalse: [ aBlock value: element ] ] ]! Item was added: + ----- Method: WeakIdentityDictionary>>at:ifAbsent: (in category 'accessing') ----- + at: key ifAbsent: aBlock + "Answer the value associated with the key or, if key isn't found, + answer the result of evaluating aBlock." + + ^((array at: (self scanFor: key)) + ifNil: [ aBlock ] + ifNotNil: [:association | + association == vacuum + ifTrue: [ aBlock ] + ifFalse: [ association ] ]) value "Blocks and Associations expect #value"! Item was added: + ----- Method: WeakIdentityDictionary>>at:ifPresent: (in category 'accessing') ----- + at: key ifPresent: aBlock + "Lookup the given key in the receiver. If it is present, answer the value of evaluating the given block with the value associated with the key. Otherwise, answer nil." + + ^(array at: (self scanFor: key)) ifNotNil: [ :association | + association == vacuum ifFalse: [ + aBlock value: association value ] ]! Item was added: + ----- Method: WeakIdentityDictionary>>at:ifPresent:ifAbsent: (in category 'accessing') ----- + at: key ifPresent: oneArgBlock ifAbsent: absentBlock + "Lookup the given key in the receiver. If it is present, answer the + value of evaluating the oneArgBlock with the value associated + with the key, otherwise answer the value of absentBlock." + ^(array at: (self scanFor: key)) + ifNil: [absentBlock value] + ifNotNil: + [:association| + association == vacuum + ifTrue: [absentBlock value] + ifFalse: [oneArgBlock value: association value]]! Item was added: + ----- Method: WeakIdentityDictionary>>at:ifPresent:ifAbsentPut: (in category 'accessing') ----- + at: key ifPresent: oneArgBlock ifAbsentPut: absentBlock + "Lookup the given key in the receiver. If it is present, answer the value of + evaluating oneArgBlock with the value associated with the key. Otherwise + add the value of absentBlock under the key, and answer that value." + + | index value | + index := self scanFor: key. + (array at: index) ifNotNil: + [:element| + element == vacuum ifFalse: [^oneArgBlock value: element value] ]. + value := absentBlock value. + self atNewIndex: index put: (self associationClass key: key value: value). + ^value! Item was added: + ----- Method: WeakIdentityDictionary>>at:put: (in category 'accessing') ----- + at: key put: anObject + "Set the value at key to be anObject. If key is not found, create a + new entry for key and set is value to anObject. Answer anObject." + + | index | + index := self scanFor: key. + (array at: index) + ifNil: + ["it's possible to get here if the association just died" + self atNewIndex: index put: (self associationClass key: key value: anObject) ] + ifNotNil: [ :association | + association == vacuum + ifTrue: [ self atNewIndex: index put: (self associationClass key: key value: anObject) ] + ifFalse: [association value: anObject ] ]. + ^anObject! Item was added: + ----- Method: WeakIdentityDictionary>>fixCollisionsFrom: (in category 'private') ----- + fixCollisionsFrom: start + "The element at start has been removed and replaced by vacuum. + This method moves forward from there, relocating any entries + that had been placed below due to collisions with this one." + + | element index | + index := start. + [ (element := array at: (index := index \\ array size + 1)) == vacuum ] whileFalse: [ + element + ifNil: + [ "The binding at this slot was reclaimed - finish the cleanup" + array at: index put: vacuum. + tally := tally - 1 ] + ifNotNil: + [| newIndex | + (newIndex := self scanFor: element key) = index ifFalse: [ + array + at: newIndex put: element; + at: index put: vacuum ] ] ]! Item was added: + ----- Method: WeakIdentityDictionary>>growTo: (in category 'private') ----- + growTo: anInteger + "Grow the elements array and reinsert the old elements" + + | oldElements | + oldElements := array. + array := self arrayType new: anInteger withAll: vacuum. + self noCheckNoGrowFillFrom: oldElements! Item was added: + ----- Method: WeakIdentityDictionary>>includesKey: (in category 'testing') ----- + includesKey: key + "Answer whether the receiver has a key equal to the argument, key." + + (array at: (self scanFor: key)) + ifNil: [ + "it just has been reclaimed" + ^false] + ifNotNil: [ :element | + element == vacuum + ifTrue: [ ^false ] + ifFalse: [ ^true ] ]! Item was added: + ----- Method: WeakIdentityDictionary>>initialize: (in category 'private') ----- + initialize: n + vacuum := Object new. + array := self arrayType new: n withAll: vacuum. + tally := 0! Item was added: + ----- Method: WeakIdentityDictionary>>noCheckNoGrowFillFrom: (in category 'private') ----- + noCheckNoGrowFillFrom: anArray + "Add the elements of anArray except nils to me assuming that I don't contain any of them, they are unique and I have more free space than they require." + + tally := 0. + 1 to: anArray size do: [ :index | + (anArray at: index) ifNotNil: [ :association | + association == vacuum ifFalse: [ + array + at: (self scanForEmptySlotFor: association key) + put: association. + tally := tally + 1 ] ] ]! Item was added: + ----- Method: WeakIdentityDictionary>>postCopy (in category 'copying') ----- + postCopy + "Beware: do share the bindings, so changing a binding value in the copy will also change it in the original. + Copying the bindings would not make sense: we hold weakly on them, so they would die at first garbage collection." + + | oldVacuum | + super postCopy. + oldVacuum := vacuum. + vacuum := Object new. + array := array collect: [ :association | + association ifNotNil: [ + association == oldVacuum + ifTrue: [ vacuum ] + ifFalse: [ association ] ] ]! Item was added: + ----- Method: WeakIdentityDictionary>>removeKey:ifAbsent: (in category 'removing') ----- + removeKey: key ifAbsent: aBlock + "Remove key (and its associated value) from the receiver. If key is not in + the receiver, answer the result of evaluating aBlock. Otherwise, answer + the value externally named by key." + + | index association | + index := self scanFor: key. + (association := (array at: index)) == vacuum ifTrue: [ ^aBlock value ]. + tally := tally - 1. "Update tally first, so that read-only hashed collections raise an error before modifying array." + array at: index put: vacuum. + self fixCollisionsFrom: index. + ^association value! Item was added: + ----- Method: WeakIdentityDictionary>>removeUnreferencedKeys (in category 'removing') ----- + removeUnreferencedKeys + "Make sure tally is set to the right size by #compact." + + super removeUnreferencedKeys. + self compact! Item was added: + ----- Method: WeakIdentityDictionary>>scanFor: (in category 'private') ----- + scanFor: anObject + "Scan the array for the first slot containing either + - a vacuum object indicating an empty slot + - or a binding whose key matches anObject. + Answer the index of that slot or raise an error if no slot is found which should never happen." + + | index start size | + index := start := anObject scaledIdentityHash \\ (size := array size) + 1. + [ + (array at: index) ifNotNil: [ :element | + (element == vacuum or: [ element key == anObject ]) + ifTrue: [ ^index ] ]. + (index := index \\ size + 1) = start ] whileFalse. + self errorNoFreeSpace! Item was added: + ----- Method: WeakIdentityDictionary>>scanForEmptySlotFor: (in category 'private') ----- + scanForEmptySlotFor: anObject + "Scan the array for the first empty slot marked by vacuum object or nil. + Answer the index of that slot or raise an error if no slot is found, which should never happen." + + | index start | + index := start := anObject scaledIdentityHash \\ array size + 1. + [ + | element | + ((element := array at: index) == vacuum or: [ element == nil ]) ifTrue: [ ^index ]. + (index := index \\ array size + 1) = start ] whileFalse. + self errorNoFreeSpace! Item was added: + ----- Method: WeakIdentityDictionary>>slowSize (in category 'accessing') ----- + slowSize + "Careful!! Answer the maximum amount + of elements in the receiver, not the + exact amount" + + | count | + count := 0. + 1 to: array size do: [ :index | + (array at: index) ifNotNil: [ :object | + object == vacuum ifFalse: [ + count := count + 1 ] ] ]. + ^count! Item was changed: ----- Method: WeakIdentityKeyDictionary>>scanFor: (in category 'private') ----- scanFor: anObject "Scan the key array for the first slot containing either a nil (indicating an empty slot) or an element that matches anObject. Answer the index of that slot or raise an error if no slot is found. This method will be overridden in various subclasses that have different interpretations for matching elements." + | index start size | + index := start := anObject scaledIdentityHash \\ (size := array size) + 1. - | index start | - index := start := anObject scaledIdentityHash \\ array size + 1. [ | element | ((element := array at: index) == nil or: [ element key == anObject ]) ifTrue: [ ^index ]. + (index := index \\ size + 1) = start ] whileFalse. - (index := index \\ array size + 1) = start ] whileFalse. self errorNoFreeSpace! Item was changed: ----- Method: WeakIdentityKeyDictionary>>scanForEmptySlotFor: (in category 'private') ----- scanForEmptySlotFor: anObject "Scan the key array for the first slot containing an empty slot (indicated by a nil). Answer the index of that slot. This method will be overridden in various subclasses that have different interpretations for matching elements." + | index start size | + index := start := anObject scaledIdentityHash \\ (size := array size) + 1. - | index start | - index := start := anObject scaledIdentityHash \\ array size + 1. [ (array at: index) ifNil: [ ^index ]. + (index := index \\ size + 1) = start ] whileFalse. - (index := index \\ array size + 1) = start ] whileFalse. self errorNoFreeSpace! Item was added: + ----- Method: WeakKeyDictionary>>associationClass (in category 'accessing') ----- + associationClass + + ^WeakKeyAssociation! Item was added: + ----- Method: WeakKeyDictionary>>at:ifAbsent: (in category 'accessing') ----- + at: key ifAbsent: aBlock + "While no nil key can be added, keys become nil when they are garbage collected. + This must not let nil accidentally 'inherit' the value of such a stale association." + key ifNil: [^ aBlock value]. + ^ super at: key ifAbsent: aBlock! Item was added: + ----- Method: WeakKeyDictionary>>at:ifPresent: (in category 'accessing') ----- + at: key ifPresent: aBlock + "Lookup the given key in the receiver. If it is present, answer the value of evaluating the given block with the value associated with the key. Otherwise, answer nil. + While no nil key can be added, keys become nil when they are garbage collected. + This must not let nil accidentally 'inherit' the value of such a stale association." + + ^key ifNotNil: [ super at: key ifPresent: aBlock ]! Item was added: + ----- Method: WeakKeyDictionary>>at:ifPresent:ifAbsent: (in category 'accessing') ----- + at: key ifPresent: oneArgBlock ifAbsent: absentBlock + "Lookup the given key in the receiver. If it is present, answer the + value of evaluating the oneArgBlock with the value associated + with the key, otherwise answer the value of absentBlock." + + ^key ifNotNil: [ super at: key ifPresent: oneArgBlock ifAbsent: absentBlock ]! Item was changed: ----- Method: WeakKeyDictionary>>at:put: (in category 'accessing') ----- at: key put: anObject "Set the value at key to be anObject. If key is not found, create a new entry for key and set is value to anObject. Answer anObject." - | index | key ifNil: [ ^anObject ]. + ^super at: key put: anObject! - index := self scanFor: key. - (array at: index) - ifNil: [ self atNewIndex: index put: (WeakKeyAssociation key: key value: anObject) ] - ifNotNil: [ :association | association value: anObject ]. - ^anObject! Item was removed: - ----- Method: WeakKeyDictionary>>compact (in category 'private') ----- - compact - "Reduce the size of array so that the load factor will be ~75%." - - | newCapacity | - newCapacity := self class goodPrimeAtLeast: self slowSize * 4 // 3. - self growTo: newCapacity! Item was removed: - ----- Method: WeakKeyDictionary>>growSize (in category 'private') ----- - growSize - "Answer what my next table size should be. - Note that, it can be less than the current." - - ^self class goodPrimeAtLeast: self slowSize * 2 + 2! Item was added: + ----- Method: WeakKeyDictionary>>replace: (in category 'enumerating') ----- + replace: aBlock + "Like super except that aBlock shouldn't be invoked for any reclaimed (nil) key." + + tally = 0 ifTrue: [ ^self]. + 1 to: array size do: [ :index | + (array at: index) ifNotNil: [ :association | + association key ifNotNil: [ :key | "Don't let the key go away." + association value: (aBlock value: association value) ] ] ]! Item was removed: - ----- Method: WeakOrderedCollection class>>arrayType (in category 'as yet unclassified') ----- - arrayType - ^ WeakArray! Item was added: + ----- Method: WeakOrderedCollection>>arrayType (in category 'private') ----- + arrayType + ^ WeakArray! Item was added: + ----- Method: WeakSet>>arrayType (in category 'private') ----- + arrayType + + ^WeakArray! Item was removed: - ----- Method: WeakSet>>compact (in category 'private') ----- - compact - "Reduce the size of array so that the load factor will be ~75%." - - | newCapacity | - newCapacity := self class goodPrimeAtLeast: self slowSize * 4 // 3. - self growTo: newCapacity! Item was removed: - ----- Method: WeakSet>>growSize (in category 'private') ----- - growSize - "Answer what my next table size should be. - Note that, it can be less than the current." - - ^self class goodPrimeAtLeast: self slowSize * 2 + 2! Item was changed: ----- Method: WeakSet>>growTo: (in category 'private') ----- growTo: anInteger "Grow the elements array and reinsert the old elements" | oldElements | oldElements := array. + array := self arrayType new: anInteger withAll: flag. - array := WeakArray new: anInteger withAll: flag. self noCheckNoGrowFillFrom: oldElements! Item was changed: ----- Method: WeakSet>>includes: (in category 'testing') ----- includes: anObject (array at: (self scanFor: anObject)) ifNil: [ ^false ] + ifNotNil: [ :object | + object == flag + ifTrue: [ ^false ] + ifFalse: [ ^true ] ]! - ifNotNil: [ :object | ^object ~~ flag ]! Item was changed: ----- Method: WeakSet>>initialize: (in category 'private') ----- initialize: n "Initialize array to an array size of n" + super initialize: n. flag := Object new. + array atAllPut: flag! - array := WeakArray new: n. - array atAllPut: flag. - tally := 0! Item was changed: ----- Method: WeakSet>>postCopy (in category 'copying') ----- postCopy + | oldFlag | super postCopy. oldFlag := flag. flag := Object new. + 1 to: array size do: [ :index | + (array at: index) == oldFlag ifTrue: [ + array at: index put: flag ] ]! - array replaceAll: oldFlag with: flag.! Item was changed: ----- Method: WeakSet>>remove:ifAbsent: (in category 'removing') ----- remove: oldObject ifAbsent: aBlock | index | index := self scanFor: oldObject. (array at: index) == flag ifTrue: [ ^ aBlock value ]. + tally := tally - 1. "Update tally first, so that read-only hashed collections raise an error before modifying array." array at: index put: flag. - tally := tally - 1. self fixCollisionsFrom: index. ^oldObject! Item was changed: ----- Method: WeakSet>>scanFor: (in category 'private') ----- scanFor: anObject "Scan the key array for the first slot containing either flag (indicating an empty slot) or an element that matches anObject. Answer the index of that slot or raise an error if no slot is found. This method will be overridden in various subclasses that have different interpretations for matching elements." + | index start size | + index := start := anObject hash \\ (size := array size) + 1. - | index start | - index := start := anObject hash \\ array size + 1. [ | element | ((element := array at: index) == flag or: [ element enclosedSetElement = anObject ]) ifTrue: [ ^index ]. + (index := index \\ size + 1) = start ] whileFalse. - (index := index \\ array size + 1) = start ] whileFalse. self errorNoFreeSpace! Item was changed: ----- Method: WeakSet>>scanForEmptySlotFor: (in category 'private') ----- scanForEmptySlotFor: anObject "Scan the key array for the first slot containing an empty slot (indicated by flag or a nil). Answer the index of that slot. This method will be overridden in various subclasses that have different interpretations for matching elements." + | index start size | + index := start := anObject hash \\ (size := array size) + 1. - | index start | - index := start := anObject hash \\ array size + 1. [ | element | ((element := array at: index) == flag or: [ element == nil ]) ifTrue: [ ^index ]. + (index := index \\ size + 1) = start ] whileFalse. - (index := index \\ array size + 1) = start ] whileFalse. self errorNoFreeSpace! Item was added: + ----- Method: WeakValueDictionary>>associationClass (in category 'accessing') ----- + associationClass + + ^WeakValueAssociation! Item was removed: - ----- Method: WeakValueDictionary>>at:put: (in category 'accessing') ----- - at: key put: anObject - "Set the value at key to be anObject. If key is not found, create a new - entry for key and set is value to anObject. Answer anObject." - | index element | - index := self scanFor: key. - element := array at: index. - element == nil - ifTrue: [self atNewIndex: index put: (WeakValueAssociation key: key value: anObject)] - ifFalse: [element value: anObject]. - ^ anObject! Item was changed: + CharacterSet subclass: #WideCharacterSet + instanceVariableNames: 'map bitsetCapacity highBitsShift lowBitsMask' - Collection subclass: #WideCharacterSet - instanceVariableNames: 'map byteArrayMap' classVariableNames: '' poolDictionaries: '' category: 'Collections-Support'! !WideCharacterSet commentStamp: 'nice 12/10/2009 19:17' prior: 0! WideCharacterSet is used to store a Set of WideCharacter with fast access and inclusion test. Implementation should be efficient in memory if sets are sufficently sparse. Wide Characters are at most 32bits. We split them into 16 highBits and 16 lowBits. map is a dictionary key: 16 highBits value: map of 16 lowBits. Maps of lowBits are stored as arrays of bits in a ByteArray. If a bit is set to 1, this indicate that corresponding character is present. 8192 bytes are necessary in each lowmap. Empty lowmap are removed from the map Dictionary. A byteArrayMap is maintained in parallel with map for fast handling of ByteString. (byteArrayMap at: i+1) = 0 means that character of asciiValue i is absent, = 1 means present.! Item was changed: ----- Method: WideCharacterSet>>= (in category 'comparing') ----- = anObject + ^self species == anObject species + and: [ anObject canBeEnumerated + and: [ self wideCharacterMap = anObject wideCharacterMap ] ]! - ^self species == anObject species and: [ - self wideCharacterMap = anObject wideCharacterMap ]! Item was changed: + ----- Method: WideCharacterSet>>add: (in category 'adding') ----- + add: aCharacter + + | value highBits lowBits | + (value := aCharacter asInteger) < 256 ifTrue: [ + byteArrayMap at: value + 1 put: 1 ]. + highBits := value bitShift: highBitsShift. + lowBits := value bitAnd: lowBitsMask. + (map at: highBits ifAbsentPut: [ Bitset new: bitsetCapacity ]) + setBitAt: lowBits. + ^aCharacter! - ----- Method: WideCharacterSet>>add: (in category 'collection ops') ----- - add: aCharacter - | val high low lowmap | - val := aCharacter asciiValue. - val < 256 ifTrue: [self byteArrayMap at: val + 1 put: 1]. - high := val bitShift: -16. - low := val bitAnd: 16rFFFF. - lowmap := map at: high ifAbsentPut: ["create a chunk of 65536=8192*8 bits" - ByteArray new: 8192]. - self setBitmap: lowmap at: low. - ^ aCharacter! Item was removed: - ----- Method: WideCharacterSet>>bitmap:at: (in category 'private') ----- - bitmap: aMap at: shortInteger - "access a single bit in aMap. - shortInteger should be between: 0 and: 16rFFFF" - - | collecIndex bitIndex | - collecIndex := shortInteger bitShift: -3. - bitIndex := shortInteger bitAnd: 7. - ^(aMap at: collecIndex + 1) bitAnd: (1 bitShift: bitIndex)! Item was removed: - ----- Method: WideCharacterSet>>bitmap:do: (in category 'private') ----- - bitmap: aMap do: aBlock - "Execute a block with each value (0 based) corresponding to set bits. - Implementation notes: this version works best for sparse maps. - It has (byte lowBit) inlined for speed." - - | byte byteOffset lowBits | - lowBits := #[1 2 1 3 1 2 1 4 1 2 1 3 1 2 1 5 1 2 1 3 1 2 1 4 1 2 1 3 1 2 1 6 1 2 1 3 1 2 1 4 1 2 1 3 1 2 1 5 1 2 1 3 1 2 1 4 1 2 1 3 1 2 1 7 1 2 1 3 1 2 1 4 1 2 1 3 1 2 1 5 1 2 1 3 1 2 1 4 1 2 1 3 1 2 1 6 1 2 1 3 1 2 1 4 1 2 1 3 1 2 1 5 1 2 1 3 1 2 1 4 1 2 1 3 1 2 1 8 1 2 1 3 1 2 1 4 1 2 1 3 1 2 1 5 1 2 1 3 1 2 1 4 1 2 1 3 1 2 1 6 1 2 1 3 1 2 1 4 1 2 1 3 1 2 1 5 1 2 1 3 1 2 1 4 1 2 1 3 1 2 1 7 1 2 1 3 1 2 1 4 1 2 1 3 1 2 1 5 1 2 1 3 1 2 1 4 1 2 1 3 1 2 1 6 1 2 1 3 1 2 1 4 1 2 1 3 1 2 1 5 1 2 1 3 1 2 1 4 1 2 1 3 1 2 1]. "The lowBits table gives a 1-based bitOffset" - 1 to: aMap size do: [:i | - (byte := aMap at: i) = 0 ifFalse: [ - byteOffset := (i bitShift: 3) - 9. "This byteOffset is -1 based" - ["Evaluate the block with 0-based (byteOffset + bitOffset)" - aBlock value: (byteOffset + (lowBits at: byte)). - "Eliminate the low bit and loop if some bit remain" - (byte := byte bitAnd: byte - 1) = 0] whileFalse]]! Item was changed: ----- Method: WideCharacterSet>>byteArrayMap (in category 'comparing') ----- byteArrayMap "return a ByteArray mapping each ascii value to a 1 if that ascii value is in the set, and a 0 if it isn't. Intended for use by primitives only. (and comparison) This version will answer a subset with only byte characters" - | lowmap | - byteArrayMap ifNil: [ - byteArrayMap := ByteArray new: 256. - lowmap := map at: 0 ifAbsent: [^byteArrayMap]. - lowmap := lowmap copyFrom: 1 to: 32. "Keep first 8*32=256 bits..." - self bitmap: lowmap do: [:code | byteArrayMap at: code + 1 put: 1]]. ^byteArrayMap! Item was removed: - ----- Method: WideCharacterSet>>clearBitmap:at: (in category 'private') ----- - clearBitmap: aMap at: shortInteger - "clear a single bit in aMap. - shortInteger should be between: 0 and: 16rFFFF" - - | collecIndex bitIndex | - collecIndex := shortInteger bitShift: -3. - bitIndex := shortInteger bitAnd: 7. - ^aMap at: collecIndex + 1 put: ((aMap at: collecIndex + 1) bitClear: (1 bitShift: bitIndex))! Item was removed: - ----- Method: WideCharacterSet>>complement (in category 'converting') ----- - complement - "return a character set containing precisely the characters the receiver does not" - - ^CharacterSetComplement of: self copy! Item was changed: + ----- Method: WideCharacterSet>>do: (in category 'enumerating') ----- + do: aBlock + + map keysAndValuesDo: [ :index :bitset | + | highBits | + highBits := index * bitsetCapacity. + bitset do: [ :lowBits | + aBlock value: (Character value: highBits + lowBits) ] ]! - ----- Method: WideCharacterSet>>do: (in category 'collection ops') ----- - do: aBlock - map - keysAndValuesDo: [:index :lowmap | - | high16Bits | - high16Bits := index bitShift: 16. - self - bitmap: lowmap - do: [:low16Bits | aBlock value: (Character value: high16Bits + low16Bits)]]! Item was added: + ----- Method: WideCharacterSet>>enumerationCost (in category 'private') ----- + enumerationCost + "Medium cost. I can hold many characters eventually." + + ^50! Item was removed: - ----- Method: WideCharacterSet>>findFirstInByteString:startingAt: (in category 'collection ops') ----- - findFirstInByteString: aByteString startingAt: startIndex - "Double dispatching: since we know this is a ByteString, we can use a superfast primitive using a ByteArray map with 0 slots for byte characters not included and 1 for byte characters included in the receiver." - ^ByteString - findFirstInString: aByteString - inSet: self byteArrayMap - startingAt: startIndex! Item was changed: ----- Method: WideCharacterSet>>hash (in category 'comparing') ----- hash "Answer a hash code aimed at storing and retrieving the receiver in a Set or Dictionary. Two equal objects should have equal hash. Note: as the receiver can be equal to an ordinary CharacterSet, the hash code must reflect this" + self hasWideCharacters ifTrue: [ ^map hash ]. + ^byteArrayMap hash! - ^self hasWideCharacters - ifTrue: [map hash] - ifFalse: [self asCharacterSet hash]! Item was removed: - ----- Method: WideCharacterSet>>includes: (in category 'collection ops') ----- - includes: aCharacter - | val high low | - val := aCharacter asciiValue. - high := val bitShift: -16. - low := val bitAnd: 16rFFFF. - ^(self - bitmap: (map - at: high - ifAbsent: [^ false]) - at: low) isZero not! Item was added: + ----- Method: WideCharacterSet>>includesCode: (in category 'testing') ----- + includesCode: anInteger + anInteger < 256 ifTrue: [ ^(byteArrayMap at: anInteger + 1) ~= 0 ]. + ^((map at: (anInteger bitShift: highBitsShift) ifAbsent: nil) ifNil: [ ^false ]) + includes: (anInteger bitAnd: lowBitsMask)! Item was changed: ----- Method: WideCharacterSet>>initialize (in category 'initialize-release') ----- initialize + + map := PluggableDictionary integerDictionary. + byteArrayMap := ByteArray new: 256. + self initializeWithLowBits: 8! - map := Dictionary new. - byteArrayMap := ByteArray new: 256! Item was added: + ----- Method: WideCharacterSet>>initializeWithLowBits: (in category 'initialize-release') ----- + initializeWithLowBits: lowBits + + bitsetCapacity := 1 bitShift: lowBits. + highBitsShift := 0 - lowBits. + lowBitsMask := bitsetCapacity - 1. + ! Item was changed: + ----- Method: WideCharacterSet>>remove: (in category 'removing') ----- + remove: aCharacter + "Don't signal an error when aCharacter is not present." + + ^self remove: aCharacter ifAbsent: aCharacter! - ----- Method: WideCharacterSet>>remove: (in category 'collection ops') ----- - remove: aCharacter - | val high low lowmap | - val := aCharacter asciiValue. - val < 256 ifTrue: [self byteArrayMap at: val + 1 put: 0]. - high := val bitShift: -16. - low := val bitAnd: 16rFFFF. - lowmap := map - at: high - ifAbsent: [^ aCharacter]. - self clearBitmap: lowmap at: low. - (lowmap allSatisfy: [:e | e = 0]) - ifTrue: [map removeKey: high]. - ^ aCharacter! Item was changed: + ----- Method: WideCharacterSet>>remove:ifAbsent: (in category 'removing') ----- - ----- Method: WideCharacterSet>>remove:ifAbsent: (in category 'collection ops') ----- remove: aCharacter ifAbsent: aBlock + + | value highBits lowBits bitset | + (value := aCharacter asInteger) < 256 ifTrue: [ + (byteArrayMap at: value + 1) = 0 ifTrue: [ ^aBlock value ]. + byteArrayMap at: value + 1 put: 0 ]. + highBits := value bitShift: highBitsShift. + lowBits := value bitAnd: lowBitsMask. + bitset := (map at: highBits ifAbsent: nil) ifNil: [ ^aBlock value ]. + ((bitset clearBitAt: lowBits) and: [ bitset size = 0 ]) ifTrue: [ + map removeKey: highBits ]. + ^aCharacter! - (self includes: aCharacter) ifFalse: [^aBlock value]. - ^self remove: aCharacter! Item was changed: + ----- Method: WideCharacterSet>>removeAll (in category 'removing') ----- - ----- Method: WideCharacterSet>>removeAll (in category 'collection ops') ----- removeAll + + map isEmpty ifTrue: [ ^self ]. map removeAll. + byteArrayMap atAllPut: 0! - byteArrayMap := ByteArray new: 256! Item was removed: - ----- Method: WideCharacterSet>>setBitmap:at: (in category 'private') ----- - setBitmap: aMap at: shortInteger - "set a single bit in aMap. - shortInteger should be between: 0 and: 16rFFFF" - - | collecIndex bitIndex | - collecIndex := shortInteger bitShift: -3. - bitIndex := shortInteger bitAnd: 7. - ^aMap at: collecIndex + 1 put: ((aMap at: collecIndex + 1) bitOr: (1 bitShift: bitIndex))! Item was changed: + ----- Method: WideCharacterSet>>size (in category 'accessing') ----- - ----- Method: WideCharacterSet>>size (in category 'collection ops') ----- size + + ^map detectSum: [ :each | each size ]! - | size | - size := 0. - map - keysAndValuesDo: [:high :lowmap | self - bitmap: lowmap - do: [:low | size := size + 1]]. - ^ size! Item was removed: - ----- Method: WideCharacterSet>>species (in category 'comparing') ----- - species - ^self hasWideCharacters - ifTrue: [WideCharacterSet] - ifFalse: [CharacterSet]! Item was removed: - ----- Method: WideSymbol class>>initialize (in category 'class initialization') ----- - initialize - Smalltalk removeFromShutDownList: self. "@@@ Remove this later @@@"! Item was removed: - ----- Method: WideSymbol>>pvtAt:put: (in category 'private') ----- - pvtAt: index put: aCharacter - "Primitive. Store the Character in the field of the receiver indicated by - the index. Fail if the index is not an Integer or is out of bounds, or if - the argument is not a Character. Essential. See Object documentation - whatIsAPrimitive." - - <primitive: 61> - index isInteger - ifTrue: [self errorSubscriptBounds: index] - ifFalse: [self errorNonIntegerIndex]! Item was removed: - ----- Method: WideSymbol>>string: (in category 'private') ----- - string: aString - 1 to: aString size do: [:j | self pvtAt: j put: (aString at: j) asInteger]. - ^self! Item was changed: + UnsignedIntegerArray variableWordSubclass: #WordArray - ArrayedCollection variableWordSubclass: #WordArray instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Collections-Arrayed'! !WordArray commentStamp: '<historical>' prior: 0! WordArrays store 32-bit unsigned Integer values. ! Item was removed: - ----- Method: WordArray>>atAllPut: (in category 'accessing') ----- - atAllPut: value - "Fill the receiver with the given value" - - <primitive: 145> - super atAllPut: value! Item was removed: - ----- Method: WordArray>>byteSize (in category 'accessing') ----- - byteSize - ^self size * 4! Item was removed: - ----- Method: WordArray>>defaultElement (in category 'accessing') ----- - defaultElement - "Return the default element of the receiver" - ^0! Item was removed: - ----- Method: WordArray>>replaceFrom:to:with:startingAt: (in category 'private') ----- - replaceFrom: start to: stop with: replacement startingAt: repStart - <primitive: 105> - ^super replaceFrom: start to: stop with: replacement startingAt: repStart ! Item was changed: + ----- Method: WordArrayForSegment>>restoreEndianness (in category 'objects from disk') ----- - ----- Method: WordArrayForSegment>>restoreEndianness (in category 'as yet unclassified') ----- restoreEndianness "This word object was just read in from a stream. Do not correct the Endianness because the load primitive will reverse bytes as needed." "^ self" ! Item was changed: + ----- Method: WordArrayForSegment>>writeOn: (in category 'objects from disk') ----- - ----- Method: WordArrayForSegment>>writeOn: (in category 'as yet unclassified') ----- writeOn: aByteStream "Write quickly and disregard the endianness of the words. Store the array of bits onto the argument, aStream. (leading byte ~= 16r80) identifies this as raw bits (uncompressed)." aByteStream nextInt32Put: self size. "4 bytes" aByteStream nextPutAll: self ! Item was changed: ----- Method: WriteStream>><< (in category 'printing') ----- << aCollection "we want a readable version of nextPutAll however it may be difficult to fully recreate nextPutAll: for all the different types of stream. Rather then simply send to nextPutAll: we handle the String (or ByteArray) argument as fast as possible - the rest we delegate to putOn: This means that we handle single characters and bytes whereas nextPutAll: is only for sequencable collections. . Note this may not work in every case that nextPutAll: does subject to extensive testing, but it should work in the important cases" | newEnd | collection class == aCollection class ifFalse: [ aCollection putOn: self. ^ self ]. newEnd := position + aCollection size. newEnd > writeLimit ifTrue: + [self growTo: newEnd]. - [self growTo: newEnd + 10]. collection replaceFrom: position+1 to: newEnd with: aCollection startingAt: 1. position := newEnd. ! Item was removed: - ----- Method: WriteStream>>flush (in category 'accessing') ----- - flush! Item was changed: ----- Method: WriteStream>>growTo: (in category 'private') ----- growTo: anInteger + " anInteger is the required minimal new size of the collection " + | oldSize newSize | - " anInteger is the required minimal new size of the collection " - | oldSize grownCollection newSize | oldSize := collection size. + newSize := anInteger + (oldSize // 4 max: 20). + collection := collection grownBy: newSize - oldSize. - newSize := anInteger + (oldSize // 4 max: 20). - grownCollection := collection class new: newSize. - collection := grownCollection replaceFrom: 1 to: oldSize with: collection startingAt: 1. writeLimit := collection size. ! Item was changed: ----- Method: WriteStream>>next:putAll:startingAt: (in category 'accessing') ----- next: anInteger putAll: aCollection startingAt: startIndex "Store the next anInteger elements from the given collection." - | newEnd | + anInteger > 0 ifFalse: [ ^aCollection ]. + (collection class == aCollection class + or: [ collection isString + and: [ aCollection isString + and: [ collection class format = aCollection class format ] ] ]) "Let Strings with the same field size as collection take the quick route too." + ifFalse: [ ^super next: anInteger putAll: aCollection startingAt: startIndex ]. - collection class == aCollection class ifFalse: - [^ super next: anInteger putAll: aCollection startingAt: startIndex]. newEnd := position + anInteger. newEnd > writeLimit ifTrue: + [self growTo: newEnd]. - [self growTo: newEnd + 10]. collection replaceFrom: position+1 to: newEnd with: aCollection startingAt: startIndex. position := newEnd. ^aCollection! Item was changed: ----- Method: WriteStream>>nextChunkPut: (in category 'fileIn/Out') ----- nextChunkPut: aString "Append the argument, aString, to the receiver, doubling embedded terminators." + | start matchIndex | + start := 1. + [ (matchIndex := aString indexOf: $!! startingAt: start) = 0 ] whileFalse: [ + self + next: matchIndex - start + 1 putAll: aString startingAt: start; + nextPut: $!!. + start := matchIndex + 1 ]. + self next: aString size - start + 1 putAll: aString startingAt: start. - | i remainder terminator | - terminator := $!!. - remainder := aString. - [(i := remainder indexOf: terminator) = 0] whileFalse: - [self nextPutAll: (remainder copyFrom: 1 to: i). - self nextPut: terminator. "double imbedded terminators" - remainder := remainder copyFrom: i+1 to: remainder size]. - self nextPutAll: remainder. aString includesUnifiedCharacter ifTrue: [ + self nextPutAll: '!!]lang['. + aString writeLeadingCharRunsOn: self ]. + self nextPut: $!! - self nextPut: terminator. - self nextPutAll: ']lang['. - aString writeLeadingCharRunsOn: self. - ]. - self nextPut: terminator. ! Item was changed: ----- Method: WriteStream>>nextPutAll: (in category 'accessing') ----- nextPutAll: aCollection | newEnd | + (collection class == aCollection class + or: [ collection class isBits + and: [ aCollection isString + and: [ collection class format = aCollection class format ] ] ]) "Let Strings with the same field size as collection take the quick route too." + ifFalse: [ ^ super nextPutAll: aCollection ]. - collection class == aCollection class ifFalse: - [^ super nextPutAll: aCollection ]. newEnd := position + aCollection size. newEnd > writeLimit ifTrue: + [self growTo: newEnd]. - [self growTo: newEnd + 10]. collection replaceFrom: position+1 to: newEnd with: aCollection startingAt: 1. position := newEnd. ^aCollection! Item was removed: - ----- Method: WriteStream>>nextPutKeyword:withArg: (in category 'character writing') ----- - nextPutKeyword: keyword withArg: argValue - "Emit a keyword/value pair in the alternate syntax" - - self nextPutAll: (keyword copyWithout: $:); - nextPut: $(; - store: argValue; - nextPut: $)! Item was changed: + (PackageInfo named: 'Collections') postscript: '"Make sure the symbol table consists of immutable sets" + #(SymbolTable NewSymbols) do: [ :variableName | + (Symbol classPool at: variableName) beReadOnlyObject ]'! - (PackageInfo named: 'Collections') postscript: 'Character initializeClassificationTable. - String initialize'!
More information about the Squeak-dev mailing list |
