SystemOrganization addCategory: #'Container-Core-Abstract'! SystemOrganization addCategory: #'Container-Core-Exceptions'! SystemOrganization addCategory: #'Container-Core-Iterators'! SystemOrganization addCategory: #'Container-Core-Lists'! SystemOrganization addCategory: #'Container-Core-Sets'! SystemOrganization addCategory: #'Container-Core-Maps'! !SequenceableCollection methodsFor: '*container-core-iterators' stamp: 'lr 1/1/2012 10:17'! iterator "Answer a default iterator over the elements in this collection." ^ CTForwardIndexedIterator on: self! ! !SequenceableCollection methodsFor: '*container-core-iterators' stamp: 'lr 1/1/2012 18:05'! reverseIterator "Answer a reverse iterator over the elements of the receiving collection." ^ CTReverseIndexedIterator on: self! ! Error subclass: #CTElementNotFoundError instanceVariableNames: 'element' classVariableNames: '' poolDictionaries: '' category: 'Container-Core-Exceptions'! !CTElementNotFoundError methodsFor: 'accessing' stamp: 'lr 12/28/2011 16:04'! element ^ element! ! !CTElementNotFoundError methodsFor: 'accessing' stamp: 'lr 12/28/2011 16:04'! element: anObject element := anObject! ! Error subclass: #CTImmutableCollectionError instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Container-Core-Exceptions'! Error subclass: #CTIndexOutOfBoundsError instanceVariableNames: 'index' classVariableNames: '' poolDictionaries: '' category: 'Container-Core-Exceptions'! !CTIndexOutOfBoundsError methodsFor: 'accessing' stamp: 'lr 12/28/2011 16:04'! index ^ index! ! !CTIndexOutOfBoundsError methodsFor: 'accessing' stamp: 'lr 12/28/2011 16:04'! index: anInteger index := anInteger! ! Error subclass: #CTKeyNotFoundError instanceVariableNames: 'key' classVariableNames: '' poolDictionaries: '' category: 'Container-Core-Exceptions'! !CTKeyNotFoundError methodsFor: 'accessing' stamp: 'lr 1/1/2012 17:20'! key ^ key! ! !CTKeyNotFoundError methodsFor: 'accessing' stamp: 'lr 1/1/2012 17:20'! key: anObject key := anObject! ! Error subclass: #CTNoSuchElementError instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Container-Core-Exceptions'! Object subclass: #CTCollection instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Container-Core-Abstract'! !CTCollection class methodsFor: 'accessing' stamp: 'lr 1/1/2012 10:12'! browserIcon ^ #collection! ! !CTCollection class methodsFor: 'instance-creation' stamp: 'lr 8/7/2011 19:24'! with: anObject1 ^ (self new: 1) add: anObject1; yourself! ! !CTCollection class methodsFor: 'instance-creation' stamp: 'lr 8/7/2011 19:24'! with: anObject1 with: anObject2 ^ (self new: 2) add: anObject1; add: anObject2; yourself! ! !CTCollection class methodsFor: 'instance-creation' stamp: 'lr 8/7/2011 19:24'! with: anObject1 with: anObject2 with: anObject3 ^ (self new: 3) add: anObject1; add: anObject2; add: anObject3; yourself! ! !CTCollection class methodsFor: 'instance-creation' stamp: 'lr 8/7/2011 19:24'! with: anObject1 with: anObject2 with: anObject3 with: anObject4 ^ (self new: 4) add: anObject1; add: anObject2; add: anObject3; add: anObject4; yourself! ! !CTCollection methodsFor: 'adding' stamp: 'lr 8/7/2011 11:03'! add: anObject "Ensures that the receiver contains anObject." self subclassResponsibility! ! !CTCollection methodsFor: 'adding' stamp: 'lr 1/1/2012 17:43'! addAll: aCollection "Ensures that the receiver contains all elements of aCollection." aCollection iterator addTo: self! ! !CTCollection methodsFor: 'private' stamp: 'lr 12/28/2011 16:02'! elementNotFound: anObject ^ CTElementNotFoundError new element: anObject; signal! ! !CTCollection methodsFor: 'private' stamp: 'lr 12/28/2011 16:03'! indexOutOfBounds: anInteger ^ CTIndexOutOfBoundsError new index: anInteger; signal! ! !CTCollection methodsFor: 'testing' stamp: 'lr 6/7/2011 19:15'! isEmpty "Answer whether the receiver contains any elements." ^ self size = 0! ! !CTCollection methodsFor: 'accessing' stamp: 'lr 12/31/2011 13:15'! iterator "Answer a default iterator over the elements in this collection." self subclassResponsibility! ! !CTCollection methodsFor: 'private' stamp: 'lr 8/7/2011 19:55'! noSuchElement ^ CTNoSuchElementError signal! ! !CTCollection methodsFor: 'printing' stamp: 'lr 12/30/2011 10:44'! printElementsOn: aStream | iterator | iterator := self iterator. (iterator limit: 5) do: [ :each | aStream cr; tab; print: each ]. iterator hasNext ifTrue: [ aStream cr; tab; nextPutAll: '...' ]! ! !CTCollection methodsFor: 'printing' stamp: 'lr 12/28/2011 19:43'! printInformationOn: aStream aStream nextPut: $[; print: self size; nextPut: $]! ! !CTCollection methodsFor: 'printing' stamp: 'lr 12/28/2011 19:43'! printOn: aStream super printOn: aStream. self printInformationOn: aStream. self printElementsOn: aStream! ! !CTCollection methodsFor: 'removing' stamp: 'lr 12/28/2011 16:02'! remove: anObject "Removes anObject from the receiver, throw an error if not found." ^ self remove: anObject ifAbsent: [ self elementNotFound: anObject ]! ! !CTCollection methodsFor: 'removing' stamp: 'lr 8/7/2011 11:04'! remove: anObject ifAbsent: aBlock "Removes anObject from the receiver, evaluate aBlock if anObject is not present." self subclassResponsibility! ! !CTCollection methodsFor: 'removing' stamp: 'lr 12/30/2011 10:41'! removeAll "Removes all the elements from the receiver." self subclassResponsibility! ! !CTCollection methodsFor: 'accessing' stamp: 'lr 6/7/2011 19:15'! size "Returns the number of elements in this collection." self subclassResponsibility! ! CTCollection subclass: #CTList instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Container-Core-Abstract'! CTList subclass: #CTArrayList instanceVariableNames: 'array firstIndex lastIndex' classVariableNames: '' poolDictionaries: '' category: 'Container-Core-Lists'! !CTArrayList class methodsFor: 'instance creation' stamp: 'lr 8/7/2011 19:10'! new ^ self new: 10! ! !CTArrayList class methodsFor: 'instance creation' stamp: 'lr 8/7/2011 19:10'! new: anInteger ^ self basicNew initialize: anInteger! ! !CTArrayList methodsFor: 'adding' stamp: 'lr 11/6/2011 17:12'! add: anObject at: anInteger | target | anInteger = 1 ifTrue: [ ^ self addFirst: anObject ]. anInteger + 1 = self size ifTrue: [ ^ self addLast: anObject ]. target := anInteger + firstIndex - 1. (target between: firstIndex and: lastIndex) ifFalse: [ ^ self indexOutOfBounds: anInteger ]. array size // 2 < target ifTrue: [ lastIndex = array size ifTrue: [ self growAtLast ]. lastIndex to: target by: -1 do: [ :index | array at: index + 1 put: (array at: index) ]. lastIndex := lastIndex + 1 ] ifFalse: [ firstIndex = 1 ifTrue: [ self growAtFirst. target := anInteger + firstIndex - 1 ]. firstIndex to: target - 1 by: 1 do: [ :index | array at: index put: (array at: index + 1) ]. firstIndex := firstIndex - 1 ]. array at: target put: anObject. ^ anObject ! ! !CTArrayList methodsFor: 'adding' stamp: 'lr 1/1/2012 01:17'! addFirst: anObject firstIndex = 1 ifTrue: [ self growAtFirst ]. firstIndex := firstIndex - 1. array at: firstIndex put: anObject. ^ anObject! ! !CTArrayList methodsFor: 'adding' stamp: 'lr 1/1/2012 01:13'! addLast: anObject lastIndex = array size ifTrue: [ self growAtLast ]. lastIndex := lastIndex + 1. array at: lastIndex put: anObject. ^ anObject! ! !CTArrayList methodsFor: 'accessing' stamp: 'lr 12/31/2011 11:21'! at: anInteger ifAbsent: aBlock | index | index := firstIndex + anInteger - 1. (index between: firstIndex and: lastIndex) ifFalse: [ ^ aBlock value ]. ^ array at: index! ! !CTArrayList methodsFor: 'accessing' stamp: 'lr 12/31/2011 11:22'! at: anInteger put: anObject | index | index := firstIndex + anInteger - 1. (index between: firstIndex and: lastIndex) ifFalse: [ ^ self indexOutOfBounds: anInteger ]. ^ array at: index put: anObject! ! !CTArrayList methodsFor: 'private' stamp: 'lr 8/7/2011 11:42'! growAtFirst | newArray newFirstIndex newLastIndex | newArray := Array new: array size * 3 // 2 + 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! ! !CTArrayList methodsFor: 'private' stamp: 'lr 8/7/2011 11:42'! growAtLast | newArray | newArray := Array new: array size * 3 // 2 + 1. newArray replaceFrom: firstIndex to: lastIndex with: array startingAt: firstIndex. array := newArray! ! !CTArrayList methodsFor: 'initialization' stamp: 'lr 8/7/2011 19:09'! initialize: anInteger self initialize. array := Array new: anInteger. firstIndex := 1. lastIndex := 0! ! !CTArrayList methodsFor: 'accessing' stamp: 'lr 1/10/2012 07:06'! iterator ^ CTForwardIndexedIterator on: array start: firstIndex stop: lastIndex offset: firstIndex - 1! ! !CTArrayList methodsFor: 'removing' stamp: 'lr 1/1/2012 00:54'! remove: anObject ifAbsent: aBlock ^ self removeAt: (self iterator indexOf: anObject ifAbsent: [ ^ aBlock value ]) ifAbsent: aBlock! ! !CTArrayList methodsFor: 'removing' stamp: 'lr 12/30/2011 10:41'! removeAll firstIndex to: lastIndex do: [ :index | array at: index put: nil ]. firstIndex := 1. lastIndex := 0! ! !CTArrayList methodsFor: 'removing' stamp: 'lr 1/1/2012 01:02'! removeAt: anInteger ifAbsent: aBlock | target object | target := firstIndex + anInteger - 1. (target between: firstIndex and: lastIndex) ifFalse: [ ^ aBlock value ]. object := array at: target. firstIndex + lastIndex // 2 < target ifTrue: [ target to: lastIndex - 1 by: 1 do: [ :index | array at: index put: (array at: index + 1) ]. array at: lastIndex put: nil. lastIndex := lastIndex - 1 ] ifFalse: [ target to: firstIndex + 1 by: -1 do: [ :index | array at: index put: (array at: index - 1) ]. array at: firstIndex put: nil. firstIndex := firstIndex + 1 ]. ^ object! ! !CTArrayList methodsFor: 'removing' stamp: 'lr 1/1/2012 01:15'! removeFirst | element | self isEmpty ifTrue: [ ^ self noSuchElement ]. element := array at: firstIndex. array at: firstIndex put: nil. firstIndex := firstIndex + 1. ^ element! ! !CTArrayList methodsFor: 'removing' stamp: 'lr 1/1/2012 01:17'! removeLast | element | self isEmpty ifTrue: [ ^ self noSuchElement ]. element := array at: lastIndex. array at: lastIndex put: nil. lastIndex := lastIndex - 1. ^ element! ! !CTArrayList methodsFor: 'accessing' stamp: 'lr 1/10/2012 07:06'! reverseIterator ^ CTReverseIndexedIterator on: array start: firstIndex stop: lastIndex offset: firstIndex - 1! ! !CTArrayList methodsFor: 'accessing' stamp: 'lr 12/28/2011 19:36'! size ^ lastIndex - firstIndex + 1! ! CTList subclass: #CTLinkedList instanceVariableNames: 'size root' classVariableNames: '' poolDictionaries: '' category: 'Container-Core-Lists'! !CTLinkedList class methodsFor: 'instance creation' stamp: 'lr 8/7/2011 20:04'! new ^ self basicNew initialize! ! !CTLinkedList class methodsFor: 'instance creation' stamp: 'lr 8/7/2011 20:04'! new: anInteger ^ self new! ! !CTLinkedList methodsFor: 'adding' stamp: 'lr 1/1/2012 17:18'! add: anObject at: anInteger | node | anInteger = 1 ifTrue: [ ^ self addFirst: anObject ]. anInteger = (self size + 1) ifTrue: [ ^ self addLast: anObject ]. node := (self nodeAt: anInteger) ifNil: [ ^ self indexOutOfBounds: anInteger ]. self addNode: (self newNode: anObject) before: node. ^ anObject! ! !CTLinkedList methodsFor: 'adding' stamp: 'lr 1/1/2012 18:14'! addFirst: anObject self addNode: (self newNode: anObject) before: root after. ^ anObject! ! !CTLinkedList methodsFor: 'adding' stamp: 'lr 1/1/2012 17:18'! addLast: anObject self addNode: (self newNode: anObject) before: root. ^ anObject! ! !CTLinkedList methodsFor: 'private' stamp: 'lr 1/1/2012 18:08'! addNode: aNode before: anotherNode aNode before: anotherNode before. aNode after: anotherNode. aNode before after: aNode. aNode after before: aNode. size := size + 1! ! !CTLinkedList methodsFor: 'accessing' stamp: 'lr 1/1/2012 17:13'! at: anInteger ifAbsent: aBlock | node | node := (self nodeAt: anInteger) ifNil: [ ^ aBlock value ]. ^ node object! ! !CTLinkedList methodsFor: 'accessing' stamp: 'lr 1/1/2012 17:12'! at: anInteger put: anObject | node | node := (self nodeAt: anInteger) ifNil: [ ^ self indexOutOfBounds: anInteger ]. node object: anObject. ^ anObject! ! !CTLinkedList methodsFor: 'initialization' stamp: 'lr 1/1/2012 18:13'! initialize super initialize. root := self nodeClass new. root before: root; after: root. size := 0! ! !CTLinkedList methodsFor: 'accessing' stamp: 'lr 1/1/2012 18:20'! iterator ^ self isEmpty ifTrue: [ CTEmptyIterator new ] ifFalse: [ (CTForwardLinkedListIterator start: root after stop: root before) collect: [ :each | each object ] ]! ! !CTLinkedList methodsFor: 'private' stamp: 'lr 1/1/2012 17:18'! newNode: anObject ^ self nodeClass on: anObject! ! !CTLinkedList methodsFor: 'private' stamp: 'lr 1/1/2012 18:08'! nodeAt: anInteger | node | (anInteger between: 1 and: size) ifFalse: [ ^ nil ]. node := root. anInteger < (size // 2) ifTrue: [ 1 to: anInteger do: [ :index | node := node after ] ] ifFalse: [ 1 to: size - anInteger + 1 do: [ :index | node := node before ] ]. ^ node! ! !CTLinkedList methodsFor: 'private' stamp: 'lr 11/6/2011 17:07'! nodeClass ^ CTLinkedListNode! ! !CTLinkedList methodsFor: 'removing' stamp: 'lr 12/28/2011 16:28'! remove: anObject ifAbsent: aBlock "Removes anObject from the receiver, evaluate aBlock if anObject is not present." self shouldBeImplemented! ! !CTLinkedList methodsFor: 'removing' stamp: 'lr 1/1/2012 18:15'! removeAll root before: root; after: root. size := 0! ! !CTLinkedList methodsFor: 'removing' stamp: 'lr 1/1/2012 17:16'! removeAt: anInteger ifAbsent: aBlock | node | (node := self nodeAt: anInteger) isNil ifTrue: [ ^ self indexOutOfBounds: anInteger ]. self removeNode: node. ^ node object! ! !CTLinkedList methodsFor: 'removing' stamp: 'lr 1/1/2012 18:14'! removeFirst | node | self isEmpty ifTrue: [ ^ self noSuchElement ]. self removeNode: (node := root after). ^ node object! ! !CTLinkedList methodsFor: 'removing' stamp: 'lr 1/1/2012 18:07'! removeLast | node | self isEmpty ifTrue: [ ^ self noSuchElement ]. self removeNode: (node := root before). ^ node object! ! !CTLinkedList methodsFor: 'private' stamp: 'lr 1/1/2012 18:09'! removeNode: aNode aNode before after: aNode after. aNode after before: aNode before. aNode before: nil. aNode after: nil. size := size - 1! ! !CTLinkedList methodsFor: 'accessing' stamp: 'lr 1/1/2012 18:21'! reverseIterator ^ self isEmpty ifTrue: [ CTEmptyIterator new ] ifFalse: [ (CTReverseLinkedListIterator start: root after stop: root before) collect: [ :each | each object ] ]! ! !CTLinkedList methodsFor: 'accessing' stamp: 'lr 11/6/2011 17:29'! size ^ size! ! !CTList methodsFor: 'adding' stamp: 'lr 11/6/2011 09:34'! add: anObject "Appends anObject to the receiver." self addLast: anObject! ! !CTList methodsFor: 'adding' stamp: 'lr 11/6/2011 09:34'! add: anObject at: anInteger "Adds anObject at the position anInteger." self subclassResponsibility! ! !CTList methodsFor: 'adding' stamp: 'lr 11/6/2011 09:33'! addFirst: anObject "Adds anObject at the beginning of the receiver." self add: anObject at: 1! ! !CTList methodsFor: 'adding' stamp: 'lr 11/6/2011 09:34'! addLast: anObject "Adds anObject at the end of the receiver." self add: anObject at: self size + 1! ! !CTList methodsFor: 'accessing' stamp: 'lr 8/7/2011 16:14'! at: anInteger "Returns the element at index anInteger, or throws an exception." ^ self at: anInteger ifAbsent: [ self indexOutOfBounds: anInteger ]! ! !CTList methodsFor: 'accessing' stamp: 'lr 1/1/2012 18:05'! at: anInteger ifAbsent: aBlock "Returns the element at anInteger, otherwise answer the result of evaluating aBlock." self subclassResponsibility! ! !CTList methodsFor: 'accessing' stamp: 'lr 8/7/2011 15:57'! at: anInteger put: anObject "Replaces the element at anInteger with anObject." self subclassResponsibility! ! !CTList methodsFor: 'accessing' stamp: 'lr 8/7/2011 19:55'! first "Answers the first element of the collection." ^ self at: 1 ifAbsent: [ self noSuchElement ]! ! !CTList methodsFor: 'accessing' stamp: 'lr 8/7/2011 19:55'! last "Answers the last element of the collection." ^ self at: self size ifAbsent: [ self noSuchElement ]! ! !CTList methodsFor: 'removing' stamp: 'lr 12/30/2011 10:42'! removeAt: anInteger "Removes the element at index anInteger, throws an error if it does not exist." ^ self removeAt: anInteger ifAbsent: [ self indexOutOfBounds: anInteger ]! ! !CTList methodsFor: 'removing' stamp: 'lr 12/30/2011 10:42'! removeAt: anInteger ifAbsent: aBlock "Removes the element at index anInteger, evaluates aBlock if it does not exist." ^ self subclassResponsibility! ! !CTList methodsFor: 'removing' stamp: 'lr 11/6/2011 09:37'! removeFirst "Removes the first element of the receiver." ^ self removeAt: 1! ! !CTList methodsFor: 'removing' stamp: 'lr 11/6/2011 09:37'! removeLast "Removes the last element of the receiver." ^ self removeAt: self size! ! !CTList methodsFor: 'accessing' stamp: 'lr 1/1/2012 18:05'! reverseIterator "Answer a reverse iterator over the elements of the receiving collection." self subclassResponsibility! ! CTCollection subclass: #CTSet instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Container-Core-Abstract'! CTSet subclass: #CTHashSet instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Container-Core-Sets'! !CTHashSet methodsFor: 'adding' stamp: 'lr 1/1/2012 17:37'! add: anObject "Ensures that the receiver contains anObject." self shouldBeImplemented! ! !CTHashSet methodsFor: 'accessing' stamp: 'lr 1/1/2012 17:37'! iterator "Answer a default iterator over the elements in this collection." self shouldBeImplemented! ! !CTHashSet methodsFor: 'removing' stamp: 'lr 1/1/2012 17:37'! remove: anObject ifAbsent: aBlock "Removes anObject from the receiver, evaluate aBlock if anObject is not present." self shouldBeImplemented! ! !CTHashSet methodsFor: 'removing' stamp: 'lr 1/1/2012 17:37'! removeAll "Removes all the elements from the receiver." self shouldBeImplemented! ! !CTHashSet methodsFor: 'accessing' stamp: 'lr 1/1/2012 17:37'! size "Returns the number of elements in this collection." self shouldBeImplemented! ! CTHashSet subclass: #CTLinkedHashSet instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Container-Core-Sets'! CTSet subclass: #CTTreeSet instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Container-Core-Sets'! !CTTreeSet methodsFor: 'adding' stamp: 'lr 1/1/2012 17:37'! add: anObject "Ensures that the receiver contains anObject." self shouldBeImplemented! ! !CTTreeSet methodsFor: 'accessing' stamp: 'lr 1/1/2012 17:37'! iterator "Answer a default iterator over the elements in this collection." self shouldBeImplemented! ! !CTTreeSet methodsFor: 'removing' stamp: 'lr 1/1/2012 17:37'! remove: anObject ifAbsent: aBlock "Removes anObject from the receiver, evaluate aBlock if anObject is not present." self shouldBeImplemented! ! !CTTreeSet methodsFor: 'removing' stamp: 'lr 1/1/2012 17:37'! removeAll "Removes all the elements from the receiver." self shouldBeImplemented! ! !CTTreeSet methodsFor: 'accessing' stamp: 'lr 1/1/2012 17:37'! size "Returns the number of elements in this collection." self shouldBeImplemented! ! Object subclass: #CTHashEntry instanceVariableNames: 'key keyHash value next' classVariableNames: '' poolDictionaries: '' category: 'Container-Core-Maps'! !CTHashEntry class methodsFor: 'instance creation' stamp: 'lr 6/7/2011 20:30'! key: aKey hash: aHash value: aValue next: anEntry ^ self basicNew initializeKey: aKey hash: aHash value: aValue next: anEntry! ! !CTHashEntry methodsFor: 'initialization' stamp: 'lr 7/13/2011 12:06'! initializeKey: aKey hash: anInteger value: aValue next: anEntry key := aKey. keyHash := anInteger. value := aValue. next := anEntry! ! !CTHashEntry methodsFor: 'accessing' stamp: 'lr 6/7/2011 20:32'! key ^ key! ! !CTHashEntry methodsFor: 'accessing' stamp: 'lr 6/7/2011 20:31'! keyHash ^ keyHash! ! !CTHashEntry methodsFor: 'accessing' stamp: 'lr 7/13/2011 12:06'! next ^ next! ! !CTHashEntry methodsFor: 'modifying' stamp: 'lr 6/7/2011 20:32'! replaceValue: aValue | oldValue | oldValue := value. value := aValue. ^ oldValue! ! !CTHashEntry methodsFor: 'accessing' stamp: 'lr 6/7/2011 20:32'! value ^ value! ! CTHashEntry subclass: #CTLinkedHashEntry instanceVariableNames: 'before after' classVariableNames: '' poolDictionaries: '' category: 'Container-Core-Maps'! Object subclass: #CTIterator instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Container-Core-Iterators'! CTIterator subclass: #CTDelegateIterator instanceVariableNames: 'iterator' classVariableNames: '' poolDictionaries: '' category: 'Container-Core-Iterators'! CTDelegateIterator subclass: #CTCyclingIterator instanceVariableNames: 'current' classVariableNames: '' poolDictionaries: '' category: 'Container-Core-Iterators'! !CTCyclingIterator commentStamp: 'lr 8/3/2011 18:08' prior: 0! An iterator that cycles infinitely over its elements.! !CTCyclingIterator methodsFor: 'testing' stamp: 'lr 8/3/2011 18:17'! hasNext current hasNext ifFalse: [ current := iterator copy ]. ^ current hasNext! ! !CTCyclingIterator methodsFor: 'initialization' stamp: 'lr 1/1/2012 00:42'! initializeOn: anIterator super initializeOn: anIterator copy. current := anIterator! ! !CTCyclingIterator methodsFor: 'accessing' stamp: 'lr 1/1/2012 00:40'! next ^ self hasNext ifTrue: [ current next ] ifFalse: [ self noSuchElementError ]! ! !CTDelegateIterator class methodsFor: 'instance creation' stamp: 'lr 1/1/2012 18:06'! on: anIterator ^ self basicNew initializeOn: anIterator! ! !CTDelegateIterator methodsFor: 'private' stamp: 'lr 1/9/2012 21:08'! apply: aBlock with: anObject ^ iterator apply: aBlock with: anObject! ! !CTDelegateIterator methodsFor: 'private' stamp: 'lr 1/9/2012 21:09'! apply: aBlock with: anObject with: anotherObject ^ iterator apply: aBlock with: anObject with: anotherObject! ! !CTDelegateIterator methodsFor: 'testing' stamp: 'lr 8/3/2011 18:22'! hasNext ^ iterator hasNext! ! !CTDelegateIterator methodsFor: 'initialization' stamp: 'lr 12/31/2011 17:58'! initializeOn: anIterator iterator := anIterator! ! !CTDelegateIterator methodsFor: 'accessing' stamp: 'lr 8/3/2011 18:22'! next ^ iterator next! ! !CTDelegateIterator methodsFor: 'copying' stamp: 'lr 12/29/2011 10:36'! postCopy super postCopy. iterator := iterator copy! ! CTDelegateIterator subclass: #CTFilterIterator instanceVariableNames: 'predicate defined current' classVariableNames: '' poolDictionaries: '' category: 'Container-Core-Iterators'! !CTFilterIterator class methodsFor: 'instance creation' stamp: 'lr 12/31/2011 23:00'! on: anIterator predicate: aBlock ^ (self on: anIterator) setPredicate: aBlock! ! !CTFilterIterator methodsFor: 'testing' stamp: 'lr 1/9/2012 21:19'! hasNext defined ifTrue: [ ^ true ]. [ iterator hasNext ifFalse: [ ^ false ]. self apply: predicate with: (current := iterator next) ] whileFalse. ^ defined := true! ! !CTFilterIterator methodsFor: 'accessing' stamp: 'lr 12/31/2011 23:47'! next self hasNext ifFalse: [ ^ self noSuchElementError ]. defined := false. ^ current! ! !CTFilterIterator methodsFor: 'initialization' stamp: 'lr 12/31/2011 23:44'! setPredicate: aValuable predicate := aValuable. defined := false! ! CTDelegateIterator subclass: #CTLimitingIterator instanceVariableNames: 'limit' classVariableNames: '' poolDictionaries: '' category: 'Container-Core-Iterators'! !CTLimitingIterator class methodsFor: 'instance creation' stamp: 'lr 12/28/2011 19:44'! on: anIterator limit: anInteger ^ (self on: anIterator) setLimit: anInteger! ! !CTLimitingIterator methodsFor: 'testing' stamp: 'lr 8/3/2011 19:19'! hasNext ^ 0 < limit and: [ super hasNext ]! ! !CTLimitingIterator methodsFor: 'accessing' stamp: 'lr 8/3/2011 19:19'! next self hasNext ifFalse: [ ^ self noSuchElementError ]. limit := limit - 1. ^ super next! ! !CTLimitingIterator methodsFor: 'initialization' stamp: 'lr 8/3/2011 18:27'! setLimit: anInteger limit := anInteger! ! CTDelegateIterator subclass: #CTMutatingIterator instanceVariableNames: 'block' classVariableNames: '' poolDictionaries: '' category: 'Container-Core-Iterators'! !CTMutatingIterator class methodsFor: 'instance creation' stamp: 'lr 1/1/2012 00:33'! on: anIterator block: aBlock ^ (self on: anIterator) setBlock: aBlock! ! !CTMutatingIterator methodsFor: 'accessing' stamp: 'lr 1/9/2012 21:18'! next ^ self apply: block with: iterator next! ! !CTMutatingIterator methodsFor: 'initialization' stamp: 'lr 1/1/2012 00:34'! setBlock: aBlock block := aBlock! ! CTIterator subclass: #CTEmptyIterator instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Container-Core-Iterators'! !CTEmptyIterator methodsFor: 'testing' stamp: 'lr 8/3/2011 19:01'! hasNext ^ false! ! !CTEmptyIterator methodsFor: 'accessing' stamp: 'lr 8/3/2011 19:14'! next ^ self noSuchElementError! ! CTIterator subclass: #CTHashMapIterator instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Container-Core-Maps'! CTIterator subclass: #CTIndexedIterator instanceVariableNames: 'array start stop offset position' classVariableNames: '' poolDictionaries: '' category: 'Container-Core-Iterators'! !CTIndexedIterator commentStamp: 'lr 12/31/2011 14:30' prior: 0! Abstract iterator class for arrays and other collections supporting indexed access. Instance Variables: array start stop position ! CTIndexedIterator subclass: #CTForwardIndexedIterator instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Container-Core-Iterators'! !CTForwardIndexedIterator methodsFor: 'testing' stamp: 'lr 12/31/2011 13:07'! hasNext ^ position < stop! ! !CTForwardIndexedIterator methodsFor: 'initialization' stamp: 'lr 1/10/2012 06:59'! initializeOn: anArray start: aStartInteger stop: aStopInteger offset: anOffsetInteger self initializeOn: anArray start: aStartInteger stop: aStopInteger offset: anOffsetInteger position: aStartInteger - 1! ! !CTForwardIndexedIterator methodsFor: 'accessing' stamp: 'lr 12/31/2011 13:08'! next ^ self hasNext ifFalse: [ self noSuchElementError ] ifTrue: [ array at: (position := position + 1) ]! ! !CTIndexedIterator class methodsFor: 'instance creation' stamp: 'lr 12/31/2011 14:47'! on: anArray ^ self on: anArray start: 1 stop: anArray size! ! !CTIndexedIterator class methodsFor: 'instance creation' stamp: 'lr 1/10/2012 07:00'! on: anArray start: aStartIndex stop: aStopIndex ^ self on: anArray start: aStartIndex stop: aStopIndex offset: 0! ! !CTIndexedIterator class methodsFor: 'instance creation' stamp: 'lr 1/10/2012 07:00'! on: anArray start: aStartIndex stop: aStopIndex offset: anOffsetInteger ^ self basicNew initializeOn: anArray start: aStartIndex stop: aStopIndex offset: anOffsetInteger! ! !CTIndexedIterator methodsFor: 'private' stamp: 'lr 1/10/2012 06:58'! apply: aBlock with: anObject ^ aBlock numArgs = 2 ifTrue: [ aBlock value: position - offset value: anObject ] ifFalse: [ super apply: aBlock with: anObject ]! ! !CTIndexedIterator methodsFor: 'private' stamp: 'lr 1/10/2012 06:57'! apply: aBlock with: anObject with: anotherObject ^ aBlock numArgs = 3 ifTrue: [ aBlock value: position - offset value: anObject value: anotherObject ] ifFalse: [ super apply: aBlock with: anObject with: anotherObject ]! ! !CTIndexedIterator methodsFor: 'initialization' stamp: 'lr 1/10/2012 06:59'! initializeOn: anArray start: aStartInteger stop: aStopInteger offset: anOffsetInteger self subclassResponsibility! ! !CTIndexedIterator methodsFor: 'initialization' stamp: 'lr 1/10/2012 06:59'! initializeOn: anArray start: aStartInteger stop: aStopInteger offset: anOffsetInteger position: aPositionInteger array := anArray. start := aStartInteger. stop := aStopInteger. offset := anOffsetInteger. position := aPositionInteger! ! CTIndexedIterator subclass: #CTReverseIndexedIterator instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Container-Core-Iterators'! !CTReverseIndexedIterator methodsFor: 'testing' stamp: 'lr 12/31/2011 13:08'! hasNext ^ position > start! ! !CTReverseIndexedIterator methodsFor: 'initialization' stamp: 'lr 1/10/2012 07:00'! initializeOn: anArray start: aStartInteger stop: aStopInteger offset: anOffsetInteger self initializeOn: anArray start: aStartInteger stop: aStopInteger offset: anOffsetInteger position: aStopInteger + 1! ! !CTReverseIndexedIterator methodsFor: 'accessing' stamp: 'lr 12/31/2011 13:08'! next ^ self hasNext ifFalse: [ self noSuchElementError ] ifTrue: [ array at: (position := position - 1) ]! ! !CTIterator class methodsFor: 'accessing' stamp: 'lr 1/1/2012 10:12'! browserIcon ^ #stream! ! !CTIterator methodsFor: 'collections' stamp: 'lr 1/1/2012 00:17'! addTo: aCollection "Add the elements of the receiving iterator to aCollection, answer aCollection." [ self hasNext ] whileTrue: [ aCollection add: self next ]. ^ aCollection! ! !CTIterator methodsFor: 'enumerating' stamp: 'lr 1/9/2012 21:04'! allSatisfy: aBlock "Tests whether all of the elements of the receiver satisfy aBlock." [ self hasNext ] whileTrue: [ (self apply: aBlock with: self next) ifFalse: [ ^ false ] ]. ^ true! ! !CTIterator methodsFor: 'enumerating' stamp: 'lr 1/9/2012 21:04'! anySatisfy: aBlock "Tests whether any of the elements of the receiver satisfy aBlock." [ self hasNext ] whileTrue: [ (self apply: aBlock with: self next) ifTrue: [ ^ true ] ]. ^ false! ! !CTIterator methodsFor: 'private' stamp: 'lr 1/9/2012 21:03'! apply: aBlock with: anObject ^ aBlock value: anObject! ! !CTIterator methodsFor: 'private' stamp: 'lr 1/9/2012 21:05'! apply: aBlock with: anObject with: anotherObject ^ aBlock value: anObject value: anotherObject! ! !CTIterator methodsFor: 'iterators' stamp: 'lr 1/1/2012 00:33'! collect: aBlock "Answer an iterator that transforms all the elements of the receiving iterator with aBlock." ^ CTMutatingIterator on: self block: aBlock! ! !CTIterator methodsFor: 'enumerating' stamp: 'lr 1/9/2012 21:04'! count: aBlock "Counts the elements of the receiver that satisfy aBlock." | tally | tally := 0. [ self hasNext ] whileTrue: [ (self apply: aBlock with: self next) ifTrue: [ tally := tally + 1 ] ]. ^ tally! ! !CTIterator methodsFor: 'iterators' stamp: 'lr 1/1/2012 18:04'! cycle "Answer an iterator that cycles multiple times trough the receiver. If the receiver is an non-empty iterator then the resulting iterator is of an infinite size." ^ self hasNext ifTrue: [ CTCyclingIterator on: self ] ifFalse: [ CTEmptyIterator new ]! ! !CTIterator methodsFor: 'enumerating' stamp: 'lr 12/29/2011 08:10'! detect: aBlock "Answer the first element for which aBlock returns true, otherwise throw CTNoSuchElementError." ^ self detect: aBlock ifNone: [ self noSuchElementError ]! ! !CTIterator methodsFor: 'enumerating' stamp: 'lr 1/9/2012 21:04'! detect: aBlock ifNone: anAbsentBlock "Answer the first element for which aBlock returns true, otherwise answer the result of evaluating anAbsentBlock." [ self hasNext ] whileTrue: [ | current | (self apply: aBlock with: (current := self next)) ifTrue: [ ^ current ] ]. ^ anAbsentBlock value! ! !CTIterator methodsFor: 'enumerating' stamp: 'lr 1/9/2012 21:03'! do: aBlock "Evaluate aBlock with each of the elements of the receiver." [ self hasNext ] whileTrue: [ self apply: aBlock with: self next ]! ! !CTIterator methodsFor: 'enumerating' stamp: 'lr 1/9/2012 21:04'! do: aBlock separatedBy: aSeparatorBlock "Evaluate aBlock with each of the elements of the receiver, and evaluate aSeparatorBlock in-between each of the elements." | beforeFirst | beforeFirst := true. [ self hasNext ] whileTrue: [ beforeFirst ifTrue: [ beforeFirst := false ] ifFalse: [ aSeparatorBlock value ]. self apply: aBlock with: self next ]! ! !CTIterator methodsFor: 'enumerating' stamp: 'lr 12/31/2011 16:31'! find: aBlock "Answer the index of the first element satisfying aBlock, otherwise return 0." ^ self find: aBlock ifAbsent: [ 0 ]! ! !CTIterator methodsFor: 'enumerating' stamp: 'lr 1/9/2012 21:04'! find: aBlock ifAbsent: anAbsentBlock "Answer the index of the first element satisfying aBlock, otherwise evaluate anAbsentBlock." | index | index := 1. [ self hasNext ] whileTrue: [ (self apply: aBlock with: self next) ifTrue: [ ^ index ]. index := index + 1 ]. ^ anAbsentBlock value! ! !CTIterator methodsFor: 'testing' stamp: 'lr 12/29/2011 05:48'! hasNext "Answer whether there is a next element in the iterator." self subclassResponsibility ! ! !CTIterator methodsFor: 'enumerating' stamp: 'lr 1/1/2012 13:53'! includes: anObject "Tests whether the receiver contains anObject." [ self hasNext ] whileTrue: [ anObject = self next ifTrue: [ ^ true ] ]. ^ false! ! !CTIterator methodsFor: 'enumerating' stamp: 'lr 12/29/2011 23:38'! indexOf: anObject "Answer the index of the first occurence of anObject, otherwise return 0." ^ self indexOf: anObject ifAbsent: [ 0 ]! ! !CTIterator methodsFor: 'enumerating' stamp: 'lr 1/1/2012 13:53'! indexOf: anObject ifAbsent: anAbsentBlock "Answer the index of the first occurence of anObject, evaluate anAbsentBlock otherwise." | index | index := 1. [ self hasNext ] whileTrue: [ anObject = self next ifTrue: [ ^ index ]. index := index + 1 ]. ^ anAbsentBlock value! ! !CTIterator methodsFor: 'enumerating' stamp: 'lr 1/9/2012 21:05'! inject: anObject into: aBlock "Accumulate a running value associated with evaluating aBlock with the current value of anObject and the receivers elements as block arguments." | nextValue | nextValue := anObject. [ self hasNext ] whileTrue: [ nextValue := self apply: aBlock with: nextValue with: self next ]. ^ nextValue! ! !CTIterator methodsFor: 'testing' stamp: 'lr 12/29/2011 21:31'! isEmpty "Answer whether there is a next element in the iterator." ^ self hasNext not! ! !CTIterator methodsFor: 'accessing' stamp: 'lr 1/1/2012 17:32'! iterator "Answer a default iterator of the receiver." ^ self! ! !CTIterator methodsFor: 'iterators' stamp: 'lr 1/1/2012 00:48'! limit: anInteger "Answer an iterator that consumes at most anInteger elements of the receiving iterator." ^ CTLimitingIterator on: self limit: anInteger! ! !CTIterator methodsFor: 'accessing' stamp: 'lr 1/1/2012 00:29'! next "Answer the next element of this iterator, or raise CTNoSuchElementError if the receiver is exhausted." self subclassResponsibility! ! !CTIterator methodsFor: 'private' stamp: 'lr 8/3/2011 19:14'! noSuchElementError ^ CTNoSuchElementError signal! ! !CTIterator methodsFor: 'enumerating' stamp: 'lr 1/9/2012 21:04'! noneSatisfy: aBlock "Tests whether none of the elements of the receiver satisfy aBlock." [ self hasNext ] whileTrue: [ (self apply: aBlock with: self next) ifTrue: [ ^ false ] ]. ^ true! ! !CTIterator methodsFor: 'enumerating' stamp: 'lr 12/30/2011 13:18'! reduce: aBlock "Reduce the elements of the receiver into aBlock. The argument aBlock must take two or more arguments." | arguments | arguments := Array new: aBlock argumentCount. arguments at: 1 put: self next. [ self hasNext ] whileTrue: [ 2 to: arguments size do: [ :index | arguments at: index put: self next ]. arguments at: 1 put: (aBlock valueWithArguments: arguments) ]. ^ arguments at: 1! ! !CTIterator methodsFor: 'iterators' stamp: 'lr 1/1/2012 00:31'! reject: aBlockPredicate "Answer an iterator that contains all the elements of the receiving iterator that do not satisfy aBlockPredicate." ^ CTFilterIterator on: self predicate: [ :each | (aBlockPredicate value: each) not ]! ! !CTIterator methodsFor: 'collections' stamp: 'lr 1/1/2012 00:18'! removeFrom: aCollection "Remove the elements of the receiving iterator from aCollection. answer aCollection." [ self hasNext ] whileTrue: [ aCollection remove: self next ]. ^ aCollection! ! !CTIterator methodsFor: 'iterators' stamp: 'lr 1/1/2012 00:30'! select: aBlockPredicate "Answer an iterator that contains all the elements of the receiving iterator that do satisfy aBlockPredicate." ^ CTFilterIterator on: self predicate: aBlockPredicate! ! !CTIterator methodsFor: 'accessing' stamp: 'lr 1/1/2012 13:55'! size "Answer the number of remaining elements in the receiving iterator." | tally | tally := 0. [ self hasNext ] whileTrue: [ tally := tally + 1. self next ]. ^ tally! ! CTIterator subclass: #CTLinkedHashMapIterator instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Container-Core-Maps'! CTIterator subclass: #CTLinkedListIterator instanceVariableNames: 'start stop current' classVariableNames: '' poolDictionaries: '' category: 'Container-Core-Lists'! CTLinkedListIterator subclass: #CTForwardLinkedListIterator instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Container-Core-Lists'! !CTForwardLinkedListIterator methodsFor: 'testing' stamp: 'lr 12/31/2011 13:25'! hasNext ^ current ~~ stop! ! !CTForwardLinkedListIterator methodsFor: 'initialization' stamp: 'lr 1/1/2012 18:07'! initializeStart: aStartNode stop: aStopNode self initializeStart: aStartNode stop: aStopNode current: aStartNode before! ! !CTForwardLinkedListIterator methodsFor: 'accessing' stamp: 'lr 1/1/2012 18:19'! next ^ self hasNext ifTrue: [ current := current after ] ifFalse: [ self noSuchElementError ]! ! !CTLinkedListIterator class methodsFor: 'instance creation' stamp: 'lr 12/31/2011 11:06'! start: aStartNode stop: aStopNode ^ self basicNew initializeStart: aStartNode stop: aStopNode! ! !CTLinkedListIterator methodsFor: 'initialization' stamp: 'lr 12/31/2011 13:25'! initializeStart: aStartNode stop: aStopNode self subclassResponsibility! ! !CTLinkedListIterator methodsFor: 'initialization' stamp: 'lr 12/31/2011 13:25'! initializeStart: aStartNode stop: aStopNode current: aCurrentNode start := aStartNode. stop := aStopNode. current := aCurrentNode! ! CTLinkedListIterator subclass: #CTReverseLinkedListIterator instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Container-Core-Lists'! !CTReverseLinkedListIterator methodsFor: 'testing' stamp: 'lr 12/31/2011 13:27'! hasNext ^ current ~~ start! ! !CTReverseLinkedListIterator methodsFor: 'initialization' stamp: 'lr 1/1/2012 18:09'! initializeStart: aStartNode stop: aStopNode self initializeStart: aStartNode stop: aStopNode current: aStopNode after! ! !CTReverseLinkedListIterator methodsFor: 'accessing' stamp: 'lr 1/1/2012 18:19'! next ^ self hasNext ifTrue: [ current := current before ] ifFalse: [ self noSuchElementError ]! ! CTIterator subclass: #CTPluggableIterator instanceVariableNames: 'hasNextBlock nextBlock' classVariableNames: '' poolDictionaries: '' category: 'Container-Core-Iterators'! !CTPluggableIterator class methodsFor: 'instance creation' stamp: 'lr 12/31/2011 12:54'! hasNext: aHasNextBlock next: aNextBlock ^ self basicNew initializeHasNext: aHasNextBlock next: aNextBlock! ! !CTPluggableIterator methodsFor: 'testing' stamp: 'lr 12/31/2011 12:55'! hasNext ^ hasNextBlock value! ! !CTPluggableIterator methodsFor: 'initialization' stamp: 'lr 12/31/2011 12:55'! initializeHasNext: aHasNextBlock next: aNextBlock hasNextBlock := aHasNextBlock. nextBlock := aNextBlock! ! !CTPluggableIterator methodsFor: 'accessing' stamp: 'lr 12/31/2011 12:55'! next ^ nextBlock value! ! CTIterator subclass: #CTRangeIterator instanceVariableNames: 'start stop step current' classVariableNames: '' poolDictionaries: '' category: 'Container-Core-Iterators'! !CTRangeIterator class methodsFor: 'instance creation' stamp: 'lr 12/28/2011 21:07'! from: aStartValue to: aStopValue ^ self from: aStartValue to: aStopValue step: 1! ! !CTRangeIterator class methodsFor: 'instance creation' stamp: 'lr 12/28/2011 21:08'! from: aStartValue to: aStopValue step: aStepValue ^ self basicNew initializeFrom: aStartValue to: aStopValue step: aStepValue! ! !CTRangeIterator methodsFor: 'testing' stamp: 'lr 12/29/2011 21:36'! hasNext ^ step > 0 ifTrue: [ current < stop ] ifFalse: [ current > stop ]! ! !CTRangeIterator methodsFor: 'initialization' stamp: 'lr 12/29/2011 21:35'! initializeFrom: aStartValue to: aStopValue step: aStepValue self initialize. start := aStartValue. stop := aStopValue. step := aStepValue. current := aStartValue! ! !CTRangeIterator methodsFor: 'accessing' stamp: 'lr 12/29/2011 05:49'! next ^ current := current + step! ! CTIterator subclass: #CTTreeMapIterator instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Container-Core-Maps'! Object subclass: #CTLinkedListNode instanceVariableNames: 'object before after' classVariableNames: '' poolDictionaries: '' category: 'Container-Core-Lists'! !CTLinkedListNode class methodsFor: 'instance creation' stamp: 'lr 11/6/2011 17:27'! on: anObject ^ self basicNew object: anObject! ! !CTLinkedListNode methodsFor: 'accessing' stamp: 'lr 1/1/2012 18:06'! after ^ after! ! !CTLinkedListNode methodsFor: 'accessing' stamp: 'lr 1/1/2012 18:07'! after: aNode after := aNode! ! !CTLinkedListNode methodsFor: 'accessing' stamp: 'lr 1/1/2012 18:06'! before ^ before! ! !CTLinkedListNode methodsFor: 'accessing' stamp: 'lr 1/1/2012 18:06'! before: aNode before := aNode! ! !CTLinkedListNode methodsFor: 'accessing' stamp: 'lr 11/6/2011 17:26'! object ^ object! ! !CTLinkedListNode methodsFor: 'accessing' stamp: 'lr 11/6/2011 17:26'! object: anObject object := anObject! ! Object subclass: #CTMap instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Container-Core-Abstract'! CTMap subclass: #CTHashMap instanceVariableNames: 'size entries' classVariableNames: '' poolDictionaries: '' category: 'Container-Core-Maps'! !CTHashMap class methodsFor: 'instance creation' stamp: 'lr 7/13/2011 12:18'! new ^ self new: 16! ! !CTHashMap class methodsFor: 'instance creation' stamp: 'lr 7/13/2011 12:18'! new: anInteger ^ self basicNew initialize: anInteger; yourself! ! !CTHashMap methodsFor: 'querying' stamp: 'lr 6/7/2011 20:18'! at: aKey ifAbsent: aBlock | hash entry | hash := self hashFor: aKey. entry := entries at: (self indexFor: hash). [ entry isNil ] whileFalse: [ (entry hash = hash and: [ self compare: aKey with: entry key ]) ifTrue: [ ^ entry value ]. entry := entry next ]. ^ aBlock value! ! !CTHashMap methodsFor: 'modifying' stamp: 'lr 1/1/2012 17:36'! at: aKey put: aValue | hash index entry | hash := self hashFor: aKey. index := self indexFor: hash. entry := entries at: index. [ entry isNil ] whileFalse: [ (entry hash = hash and: [ self compare: aKey with: entry key ]) ifTrue: [ entry setValue: aValue. ^ aValue ] ]. entries at: index put: (CTHashEntry key: aKey hash: hash value: aValue next: (entries at: index)). size := size + 1. ^ aValue! ! !CTHashMap methodsFor: 'private' stamp: 'lr 11/5/2011 19:15'! capacityFor: anInteger | capacity | capacity := 1. [ capacity < anInteger ] whileTrue: [ capacity := 2 * capacity ]. ^ capacity! ! !CTHashMap methodsFor: 'private' stamp: 'lr 6/7/2011 20:18'! compare: anObject with: anotherObject ^ anObject = anotherObject! ! !CTHashMap methodsFor: 'accessing' stamp: 'lr 1/1/2012 17:37'! entries "Answer an iterator over the keys and values of the receiver." self shouldBeImplemented! ! !CTHashMap methodsFor: 'private' stamp: 'lr 11/5/2011 19:15'! hashFor: aKey ^ aKey hash! ! !CTHashMap methodsFor: 'private' stamp: 'lr 11/5/2011 19:15'! indexFor: anInteger ^ anInteger bitAnd: entries size - 1! ! !CTHashMap methodsFor: 'initialization' stamp: 'lr 1/1/2012 18:18'! initialize: anInteger size := 0. entries := Array new: (self capacityFor: anInteger)! ! !CTHashMap methodsFor: 'accessing' stamp: 'lr 1/1/2012 17:37'! keys "Answer an iterator over the keys of the receiver." self shouldBeImplemented! ! !CTHashMap methodsFor: 'private' stamp: 'lr 7/13/2011 12:11'! loadFactor ^ 0.75! ! !CTHashMap methodsFor: 'modifying' stamp: 'lr 1/1/2012 17:37'! removeAll self shouldBeImplemented! ! !CTHashMap methodsFor: 'modifying' stamp: 'lr 1/1/2012 17:37'! removeKey: aKey ifAbsent: aBlock self shouldBeImplemented! ! !CTHashMap methodsFor: 'accessing' stamp: 'lr 6/7/2011 20:23'! size ^ size! ! !CTHashMap methodsFor: 'accessing' stamp: 'lr 1/1/2012 17:37'! values "Answer an iterator over the values of the receiver." self shouldBeImplemented! ! CTHashMap subclass: #CTLinkedHashMap instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Container-Core-Maps'! !CTMap class methodsFor: 'accessing' stamp: 'lr 1/1/2012 10:12'! browserIcon ^ #collection! ! !CTMap methodsFor: 'querying' stamp: 'lr 1/1/2012 17:19'! at: aKey ^ self at: aKey ifAbsent: [ self keyNotFound: aKey ]! ! !CTMap methodsFor: 'querying' stamp: 'lr 6/7/2011 20:19'! at: aKey ifAbsent: aBlock self subclassResponsibility! ! !CTMap methodsFor: 'querying' stamp: 'lr 6/7/2011 20:21'! at: aKey ifPresent: aBlock ^ aBlock value: (self at: aKey ifAbsent: [ ^ nil ])! ! !CTMap methodsFor: 'modifying' stamp: 'lr 6/7/2011 20:22'! at: aKey put: aValue self subclassResponsibility! ! !CTMap methodsFor: 'accessing' stamp: 'lr 1/1/2012 17:23'! entries "Answer an iterator over the keys and values of the receiver." ^ self subclassResponsibility! ! !CTMap methodsFor: 'testing' stamp: 'lr 6/7/2011 20:22'! includesKey: aKey ^ self keys includes: aKey! ! !CTMap methodsFor: 'testing' stamp: 'lr 6/7/2011 20:22'! includesValue: aValue ^ self values includes: aValue! ! !CTMap methodsFor: 'testing' stamp: 'lr 6/7/2011 20:23'! isEmpty ^ self size = 0! ! !CTMap methodsFor: 'private' stamp: 'lr 1/1/2012 17:21'! keyNotFound: anObject ^ CTKeyNotFoundError new key: anObject; signal! ! !CTMap methodsFor: 'accessing' stamp: 'lr 1/1/2012 17:23'! keys "Answer an iterator over the keys of the receiver." ^ self subclassResponsibility! ! !CTMap methodsFor: 'modifying' stamp: 'lr 1/1/2012 17:21'! removeAll self subclassResponsibility! ! !CTMap methodsFor: 'modifying' stamp: 'lr 1/1/2012 17:21'! removeKey: aKey ^ self removeKey: aKey ifAbsent: [ self keyNotFound: aKey ]! ! !CTMap methodsFor: 'modifying' stamp: 'lr 1/1/2012 17:21'! removeKey: aKey ifAbsent: aBlock self subclassResponsibility! ! !CTMap methodsFor: 'accessing' stamp: 'lr 6/7/2011 20:23'! size self subclassResponsibility! ! !CTMap methodsFor: 'accessing' stamp: 'lr 1/1/2012 17:22'! values "Answer an iterator over the values of the receiver." self subclassResponsibility! ! CTMap subclass: #CTTreeMap instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Container-Core-Maps'! !CTTreeMap methodsFor: 'querying' stamp: 'lr 1/1/2012 17:37'! at: aKey ifAbsent: aBlock self shouldBeImplemented! ! !CTTreeMap methodsFor: 'modifying' stamp: 'lr 1/1/2012 17:37'! at: aKey put: aValue self shouldBeImplemented! ! !CTTreeMap methodsFor: 'accessing' stamp: 'lr 1/1/2012 17:37'! entries "Answer an iterator over the keys and values of the receiver." self shouldBeImplemented! ! !CTTreeMap methodsFor: 'accessing' stamp: 'lr 1/1/2012 17:37'! keys "Answer an iterator over the keys of the receiver." self shouldBeImplemented! ! !CTTreeMap methodsFor: 'modifying' stamp: 'lr 1/1/2012 17:37'! removeAll self shouldBeImplemented! ! !CTTreeMap methodsFor: 'modifying' stamp: 'lr 1/1/2012 17:37'! removeKey: aKey ifAbsent: aBlock self shouldBeImplemented! ! !CTTreeMap methodsFor: 'accessing' stamp: 'lr 1/1/2012 17:37'! size self shouldBeImplemented! ! !CTTreeMap methodsFor: 'accessing' stamp: 'lr 1/1/2012 17:37'! values "Answer an iterator over the values of the receiver." self shouldBeImplemented! ! Object subclass: #CTTreeMapNode instanceVariableNames: 'key value left right balance' classVariableNames: '' poolDictionaries: '' category: 'Container-Core-Maps'!