SystemOrganization addCategory: #'Container-Abstract'! SystemOrganization addCategory: #'Container-Exceptions'! SystemOrganization addCategory: #'Container-Iterators'! SystemOrganization addCategory: #'Container-Lists'! SystemOrganization addCategory: #'Container-Sets'! SystemOrganization addCategory: #'Container-Maps'! SystemOrganization addCategory: #'Container-Tests-Core'! TestCase subclass: #CTCollectionTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Container-Tests-Core'! !CTCollectionTest class methodsFor: 'testing' stamp: 'lr 8/7/2011 19:59'! isAbstract ^ self name = #CTCollectionTest! ! !CTCollectionTest methodsFor: 'accessing' stamp: 'lr 11/5/2011 18:42'! collectionClass ^ CTCollection! ! !CTCollectionTest methodsFor: 'accessing' stamp: 'lr 8/7/2011 19:17'! emptyCollection ^ self collectionClass new! ! !CTCollectionTest methodsFor: 'accessing' stamp: 'lr 8/7/2011 19:18'! oneElementCollection ^ self collectionClass with: 1! ! !CTCollectionTest methodsFor: 'test-testing' stamp: 'lr 8/7/2011 19:19'! testIsEmpty self assert: self emptyCollection isEmpty. self deny: self oneElementCollection isEmpty. self deny: self twoElementCollection isEmpty! ! !CTCollectionTest methodsFor: 'test-accessing' stamp: 'lr 8/7/2011 19:19'! testSize self assert: self emptyCollection size = 0. self assert: self oneElementCollection size = 1. self assert: self twoElementCollection size = 2! ! !CTCollectionTest methodsFor: 'accessing' stamp: 'lr 8/7/2011 19:25'! twoElementCollection ^ self collectionClass with: 1 with: 2! ! CTCollectionTest subclass: #CTListTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Container-Tests-Core'! CTListTest subclass: #CTArrayListTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Container-Tests-Core'! !CTArrayListTest methodsFor: 'accessing' stamp: 'lr 8/7/2011 19:21'! collectionClass ^ CTArrayList! ! CTListTest subclass: #CTLinkedListTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Container-Tests-Core'! !CTLinkedListTest methodsFor: 'accessing' stamp: 'lr 8/7/2011 19:21'! collectionClass ^ CTLinkedList! ! !CTListTest class methodsFor: 'testing' stamp: 'lr 8/7/2011 19:59'! isAbstract ^ self name = #CTListTest! ! !CTListTest methodsFor: 'accessing' stamp: 'lr 11/5/2011 18:42'! collectionClass ^ CTList! ! !CTListTest methodsFor: 'test-accessing' stamp: 'lr 8/7/2011 20:08'! testFirst self should: [ self emptyCollection first ] raise: CTNoSuchElementError. self assert: self oneElementCollection first = 1. self assert: self twoElementCollection first = 1! ! !CTListTest methodsFor: 'test-accessing' stamp: 'lr 8/7/2011 19:54'! testLast self should: [ self emptyCollection last ] raise: CTNoSuchElementError. self assert: self oneElementCollection last = 1. self assert: self twoElementCollection last = 2! ! Object subclass: #CTCollection instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Container-Abstract'! !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: 'modifying' stamp: 'lr 8/7/2011 11:03'! add: anObject "Ensures that the receiver contains anObject." self subclassResponsibility! ! !CTCollection methodsFor: 'modifying' stamp: 'lr 8/7/2011 11:03'! addAll: aCollection "Ensures that the receiver contains all elements of aCollection." aCollection iterator do: [ :each | self add: each ]! ! !CTCollection methodsFor: 'private' stamp: 'lr 8/7/2011 11:07'! elementNotFound: anObject ^ CTElementNotFoundError signal! ! !CTCollection methodsFor: 'testing' stamp: 'lr 8/7/2011 11:05'! includes: anObject "Returns true if the receiver contains anObject." self iterator do: [ :each | anObject = each ifTrue: [ ^ true ] ]. ^ false! ! !CTCollection methodsFor: 'private' stamp: 'lr 11/5/2011 18:43'! indexOutOfBounds: anInteger ^ CTIndexOutOfBoundsError 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 8/7/2011 11:00'! iterator "Returns 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: 'modifying' stamp: 'lr 8/7/2011 11:03'! remove: anObject "Removes anObject from the receiver, throw an error if the anObject is not present." self remove: anObject ifAbsent: [ self elementNotFound: anObject ]! ! !CTCollection methodsFor: 'modifying' 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: '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-Abstract'! CTList subclass: #CTArrayList instanceVariableNames: 'array firstIndex lastIndex' classVariableNames: '' poolDictionaries: '' category: 'Container-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: 'modifying' stamp: 'lr 8/7/2011 11:38'! addFirst: anObject firstIndex = 1 ifTrue: [ self growAtFirst ]. firstIndex := firstIndex - 1. array at: firstIndex put: anObject! ! !CTArrayList methodsFor: 'modifying' stamp: 'lr 8/7/2011 11:38'! addLast: anObject lastIndex = array size ifTrue: [ self growAtLast ]. lastIndex := lastIndex + 1. array at: lastIndex put: anObject! ! !CTArrayList methodsFor: 'accessing' stamp: 'lr 8/7/2011 19:57'! at: anInteger ifAbsent: aBlock "Returns the element at anIndex, otherwise answer the result of evaluating aBlock." | index | index := anInteger + firstIndex - 1. ^ (index between: firstIndex and: lastIndex) ifTrue: [ array at: index ] ifFalse: [ aBlock value ]! ! !CTArrayList methodsFor: 'accessing' stamp: 'lr 8/7/2011 19:58'! at: anInteger put: anObject "Replaces the element at anInteger with anObject." | index | index := anInteger + firstIndex - 1. (index between: firstIndex and: lastIndex) ifTrue: [ array at: index put: anObject ] ifFalse: [ self indexOutOfBounds: anInteger ]! ! !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: 'modifying' stamp: 'lr 8/7/2011 11:20'! remove: anObject ifAbsent: aBlock! ! !CTArrayList methodsFor: 'modifying' stamp: 'lr 8/7/2011 19:08'! removeFirst "Removes the first element of the receiver." | element | self isEmpty ifFalse: [ ^ self noSuchElement ]. element := array at: firstIndex. array at: firstIndex put: nil. firstIndex := firstIndex + 1. ^ element! ! !CTArrayList methodsFor: 'modifying' stamp: 'lr 8/7/2011 19:08'! removeLast "Removes the last element of the receiver." | element | self isEmpty ifFalse: [ ^ self noSuchElement ]. element := array at: lastIndex. array at: lastIndex put: nil. lastIndex := lastIndex - 1. ^ element! ! !CTArrayList methodsFor: 'accessing' stamp: 'lr 8/7/2011 16:16'! size "Returns the number of elements in this collection." ^ lastIndex - firstIndex + 1! ! CTList subclass: #CTLinkedList instanceVariableNames: 'root size' classVariableNames: '' poolDictionaries: '' category: 'Container-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: 'modifying' stamp: 'lr 8/7/2011 20:01'! addFirst: anObject "Adds anObject at the beginning of the receiver." self basicAdd: anObject before: root after! ! !CTLinkedList methodsFor: 'modifying' stamp: 'lr 8/7/2011 20:01'! addLast: anObject "Adds anObject at the end of the receiver." self basicAdd: anObject before: root! ! !CTLinkedList methodsFor: 'accessing' stamp: 'lr 8/7/2011 20:09'! at: anInteger ifAbsent: aBlock "Returns the element at anIndex, otherwise answer the result of evaluating aBlock." | entry | entry := self basicEntryAt: anInteger. ^ entry isNil ifTrue: [ aBlock value ] ifFalse: [ entry element ]! ! !CTLinkedList methodsFor: 'accessing' stamp: 'lr 8/7/2011 20:02'! at: anInteger put: anObject "Replaces the element at anInteger with anObject." | entry | (entry := self entryAt: anInteger) isNil ifTrue: [ self indexOutOfBounds: anInteger ] ifFalse: [ entry element: anObject ]! ! !CTLinkedList methodsFor: 'private' stamp: 'lr 8/7/2011 14:55'! basicAdd: anObject before: anEntry | entry | entry := self entryClass new. entry element: anObject; before: anEntry before; after: anEntry. entry before after: entry. entry after before: entry. size := size + 1! ! !CTLinkedList methodsFor: 'private' stamp: 'lr 8/7/2011 20:09'! basicEntryAt: anInteger | entry | (anInteger between: 1 and: size) ifFalse: [ ^ nil ]. entry := root. anInteger < (size // 2) ifTrue: [ 1 to: anInteger do: [ :index | entry := entry after ] ] ifFalse: [ 1 to: size - anInteger + 1 do: [ :index | entry := entry before ] ]. ^ entry! ! !CTLinkedList methodsFor: 'private' stamp: 'lr 8/7/2011 16:10'! entryClass ^ CTLinkedListEntry! ! !CTLinkedList methodsFor: 'initialization' stamp: 'lr 8/7/2011 20:01'! initialize super initialize. root := self entryClass new. root before: root; after: root. size := 0! ! !CTLinkedList methodsFor: 'accessing' stamp: 'lr 8/7/2011 11:54'! iterator "Returns a default iterator over the elements in this collection." self shouldBeImplemented! ! !CTLinkedList methodsFor: 'modifying' stamp: 'lr 8/7/2011 11:54'! remove: anObject ifAbsent: aBlock "Removes anObject from the receiver, evaluate aBlock if anObject is not present." self shouldBeImplemented! ! !CTLinkedList methodsFor: 'modifying' stamp: 'lr 8/7/2011 11:54'! removeFirst "Removes the first element of the receiver." self shouldBeImplemented! ! !CTLinkedList methodsFor: 'modifying' stamp: 'lr 8/7/2011 11:54'! removeLast "Removes the last element of the receiver." self shouldBeImplemented! ! !CTLinkedList methodsFor: 'accessing' stamp: 'lr 8/7/2011 16:16'! size "Returns the number of elements in this collection." ^ size! ! !CTList methodsFor: 'modifying' stamp: 'lr 8/7/2011 19:07'! add: anObject "Ensures that the receiver contains anObject." self addLast: anObject! ! !CTList methodsFor: 'modifying' stamp: 'lr 8/7/2011 11:28'! addFirst: anObject "Adds anObject at the beginning of the receiver." self subclassResponsibility! ! !CTList methodsFor: 'modifying' stamp: 'lr 8/7/2011 11:28'! addLast: anObject "Adds anObject at the end of the receiver." self subclassResponsibility! ! !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 8/7/2011 15:56'! at: anInteger ifAbsent: aBlock "Returns the element at anIndex, 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: 'modifying' stamp: 'lr 8/7/2011 11:29'! removeFirst "Removes the first element of the receiver." self subclassResponsibility! ! !CTList methodsFor: 'modifying' stamp: 'lr 8/7/2011 11:29'! removeLast "Removes the last element of the receiver." self subclassResponsibility! ! CTCollection subclass: #CTSet instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Container-Abstract'! CTSet subclass: #CTHashSet instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Container-Sets'! CTHashSet subclass: #CTLinkedHashSet instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Container-Sets'! CTSet subclass: #CTTreeSet instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Container-Sets'! !CTTreeSet class methodsFor: 'as yet unclassified' stamp: 'lr 7/13/2011 09:17'! foo ^ Fooo! ! !CTTreeSet methodsFor: 'as yet unclassified' stamp: 'lr 7/13/2011 09:29'! foo ^ Fooo + tally + Object! ! Object subclass: #CTHashEntry instanceVariableNames: 'key keyHash value next' classVariableNames: '' poolDictionaries: '' category: 'Container-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-Maps'! Object subclass: #CTIterator instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Container-Iterators'! CTIterator subclass: #CTArrayIterator instanceVariableNames: 'sequence position' classVariableNames: '' poolDictionaries: '' category: 'Container-Iterators'! !CTArrayIterator class methodsFor: 'instance creation' stamp: 'lr 8/3/2011 19:53'! on: aSequenceableCollection ^ self basicNew initializeOn: aSequenceableCollection! ! !CTArrayIterator methodsFor: 'testing' stamp: 'lr 8/3/2011 19:53'! hasNext ^ position < sequence size! ! !CTArrayIterator methodsFor: 'initialization' stamp: 'lr 8/3/2011 19:53'! initializeOn: aSequencableCollection self initialize. sequence := aSequencableCollection. position := 0! ! !CTArrayIterator methodsFor: 'accessing' stamp: 'lr 8/3/2011 19:52'! next self hasNext ifFalse: [ ^ self noSuchElementError ]. ^ sequence at: (position := position + 1)! ! CTIterator subclass: #CTChainingIterator instanceVariableNames: 'iterators current' classVariableNames: '' poolDictionaries: '' category: 'Container-Iterators'! !CTChainingIterator class methodsFor: 'instance creation' stamp: 'lr 8/3/2011 19:55'! on: anIterator ^ self basicNew initializeOn: anIterator! ! !CTChainingIterator methodsFor: 'testing' stamp: 'lr 8/3/2011 19:17'! hasNext | hasNext | [ (hasNext := current hasNext) not and: [ iterators hasNext ] ] whileTrue: [ current := iterators next ]. ^ hasNext! ! !CTChainingIterator methodsFor: 'initialization' stamp: 'lr 8/3/2011 19:56'! initializeOn: anIterator self initialize. iterators := anIterator. current := CTEmptyIterator new! ! !CTChainingIterator methodsFor: 'accessing' stamp: 'lr 8/3/2011 19:47'! next self hasNext ifFalse: [ ^ self noSuchElementError ]. ^ current next! ! CTIterator subclass: #CTDelegateIterator instanceVariableNames: 'iterator' classVariableNames: '' poolDictionaries: '' category: 'Container-Iterators'! CTDelegateIterator subclass: #CTCyclingIterator instanceVariableNames: 'current' classVariableNames: '' poolDictionaries: '' category: 'Container-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 8/3/2011 19:57'! initializeOn: anIterator super initializeOn: anIterator. current := anIterator copy! ! !CTCyclingIterator methodsFor: 'accessing' stamp: 'lr 8/3/2011 19:48'! next self hasNext ifFalse: [ ^ self noSuchElementError ]. ^ current next! ! !CTDelegateIterator class methodsFor: 'instance creation' stamp: 'lr 8/3/2011 19:21'! on: anInterator ^ self basicNew initializeOn: anInterator! ! !CTDelegateIterator methodsFor: 'testing' stamp: 'lr 8/3/2011 18:22'! hasNext ^ iterator hasNext! ! !CTDelegateIterator methodsFor: 'initialization' stamp: 'lr 8/3/2011 19:21'! initializeOn: anIterator self initialize. iterator := anIterator! ! !CTDelegateIterator methodsFor: 'accessing' stamp: 'lr 8/3/2011 18:22'! next ^ iterator next! ! CTDelegateIterator subclass: #CTLimitingIterator instanceVariableNames: 'limit' classVariableNames: '' poolDictionaries: '' category: 'Container-Iterators'! !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-Iterators'! !CTMutatingIterator methodsFor: 'accessing' stamp: 'lr 8/3/2011 18:21'! next ^ block value: iterator next! ! CTDelegateIterator subclass: #CTPeekingIterator instanceVariableNames: 'element' classVariableNames: 'Sentinel' poolDictionaries: '' category: 'Container-Iterators'! CTPeekingIterator subclass: #CTFilterIterator instanceVariableNames: 'predicate' classVariableNames: '' poolDictionaries: '' category: 'Container-Iterators'! !CTFilterIterator class methodsFor: 'as yet unclassified' stamp: 'lr 8/3/2011 07:30'! initialize Sentinel := Object new! ! !CTFilterIterator methodsFor: 'testing' stamp: 'lr 8/3/2011 19:44'! hasNext | next | [ element == Sentinel and: [ iterator hasNext ] ] whileTrue: [ next := iterator next. (predicate value: next) ifTrue: [ element := next ] ]. ^ element ~~ Sentinel! ! !CTFilterIterator methodsFor: 'initialization' stamp: 'lr 8/3/2011 19:41'! setPredicate: aValuable predicate := aValuable! ! !CTPeekingIterator class methodsFor: 'initialization' stamp: 'lr 8/3/2011 19:02'! initialize Sentinel := Object new! ! !CTPeekingIterator methodsFor: 'testing' stamp: 'lr 8/3/2011 19:38'! hasNext (element == Sentinel and: [ iterator hasNext ]) ifTrue: [ element := iterator next ]. ^ element ~~ Sentinel! ! !CTPeekingIterator methodsFor: 'initialization' stamp: 'lr 8/3/2011 19:02'! initialize super initialize. element := Sentinel! ! !CTPeekingIterator methodsFor: 'accessing' stamp: 'lr 8/3/2011 19:40'! next | next | self hasNext ifFalse: [ ^ self noSuchElement ]. next := element. element := Sentinel. ^ next! ! !CTPeekingIterator methodsFor: 'accessing' stamp: 'lr 8/3/2011 19:40'! peek "Answer the next element without actually consuming it, or raise an CTNoSuchElementError." self hasNext ifFalse: [ ^ self noSuchElement ]. ^ element! ! CTIterator subclass: #CTEmptyIterator instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Container-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 methodsFor: 'enumerating' stamp: 'lr 8/3/2011 07:18'! do: aBlock [ self hasNext ] whileTrue: [ aBlock value: self next ]! ! !CTIterator methodsFor: 'testing' stamp: 'lr 8/3/2011 19:01'! hasNext "Answer whether there is a next element in the iterator." self subclassResponsibility! ! !CTIterator methodsFor: 'accessing' stamp: 'lr 8/3/2011 19:16'! next "Answer the next element in the iterator, or raise CTNoSuchElementError if no such element exists." self subclassResponsibility! ! !CTIterator methodsFor: 'private' stamp: 'lr 8/3/2011 19:14'! noSuchElementError ^ CTNoSuchElementError signal! ! Object subclass: #CTLinkedListEntry instanceVariableNames: 'element before after' classVariableNames: '' poolDictionaries: '' category: 'Container-Lists'! !CTLinkedListEntry methodsFor: 'accessing' stamp: 'lr 8/7/2011 14:38'! after ^ after! ! !CTLinkedListEntry methodsFor: 'accessing' stamp: 'lr 8/7/2011 14:38'! after: anEntry after := anEntry! ! !CTLinkedListEntry methodsFor: 'accessing' stamp: 'lr 8/7/2011 14:38'! before ^ before! ! !CTLinkedListEntry methodsFor: 'accessing' stamp: 'lr 8/7/2011 14:38'! before: anEntry before := anEntry! ! !CTLinkedListEntry methodsFor: 'accessing' stamp: 'lr 8/7/2011 16:02'! element ^ element! ! !CTLinkedListEntry methodsFor: 'accessing' stamp: 'lr 8/7/2011 16:02'! element: anObject element := anObject! ! Object subclass: #CTMap instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Container-Abstract'! CTMap subclass: #CTHashMap instanceVariableNames: 'size modifications entries' classVariableNames: '' poolDictionaries: '' category: 'Container-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 7/13/2011 12:22'! 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 value: aValue hash: hash 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: '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 7/13/2011 12:23'! initialize: anInteger size := modifications := 0. entries := Array new: (self capacityFor: anInteger)! ! !CTHashMap methodsFor: 'private' stamp: 'lr 7/13/2011 12:11'! loadFactor ^ 0.75! ! !CTHashMap methodsFor: 'accessing' stamp: 'lr 6/7/2011 20:23'! size ^ size! ! CTHashMap subclass: #CTLinkedHashMap instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Container-Maps'! !CTMap methodsFor: 'querying' stamp: 'lr 6/7/2011 20:19'! at: aKey ^ self at: aKey ifAbsent: [ self keyNotFound ]! ! !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: 'modifying' stamp: 'lr 7/13/2011 12:24'! clear self subclassResponsibility! ! !CTMap methodsFor: 'accessing' stamp: 'lr 6/7/2011 20:22'! entries ^ 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: 'accessing' stamp: 'lr 6/7/2011 20:22'! keys ^ self subclassResponsibility! ! !CTMap methodsFor: 'accessing' stamp: 'lr 6/7/2011 20:23'! size self subclassResponsibility! ! !CTMap methodsFor: 'accessing' stamp: 'lr 6/7/2011 20:23'! values ^ self subclassResponsibility! ! CTMap subclass: #CTTreeMap instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Container-Maps'! Error subclass: #CTElementNotFoundError instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Container-Exceptions'! Error subclass: #CTIndexOutOfBoundsError instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Container-Exceptions'! Error subclass: #CTNoSuchElementError instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Container-Exceptions'! CTPeekingIterator initialize! CTFilterIterator initialize!