[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Help-smalltalk] [PATCH] Add #atAll:, improve MappedCollection
From: |
Paolo Bonzini |
Subject: |
[Help-smalltalk] [PATCH] Add #atAll:, improve MappedCollection |
Date: |
Thu, 07 Jun 2007 09:28:13 +0200 |
User-agent: |
Thunderbird 2.0.0.0 (Macintosh/20070326) |
This patch adds an #atAll: method to the keyed collections (i.e.
Dictionary, MappedCollection, SequenceableCollection). Note that the
Dictionary and MappedCollection version returns another Dictionary, thus
keeping the original keys:
st> ((Dictionary from: {1->$a. 2->$b}) atAll: #(2)) printNl; keys
Dictionary (2->$b)
Set (2 )
while the SequenceableCollection version returns another
SequenceableCollection, thus reordering the keys:
st> #($a $b) atAll: #(2)) printNl; keys
($b )
Interval(1)
An interesting side effect is that repeated keys in the keyCollection
(e.g. "foo atAll: #(2 2)") also have a different effect for Dictionaries
(where they are discarded) and for SequenceableCollections (where they
cause the same element to appear multiple times).
Since I was looking at this weird class, which I just used BTW, I redid
some of the methods in MappedCollection. I also added #copyFrom:to: to
it, which is useful because the "map" is often a SequenceableCollection.
Paolo
2007-06-07 Paolo Bonzini
* kernel/ArrayColl.st: Add #atAll:.
* kernel/Dictionary.st: Add #atAll:.
* kernel/SeqCollect.st: Add #atAll:.
* kernel/MappedColl.st: Add #atAll:, remove #domain/#map accessors,
rewrite #select:/#collect:/#reject:.
--- orig/kernel/ArrayColl.st
+++ mod/kernel/ArrayColl.st
@@ -156,6 +156,17 @@ add: value
yourself
!
+atAll: keyCollection
+ "Answer a collection of the same kind returned by #collect:, that
+ only includes the values at the given indices. Fail if any of
+ the values in keyCollection is out of bounds for the receiver."
+ | result i |
+ result := self copyEmptyForCollect: keyCollection size.
+ i := 0.
+ keyCollection do: [ :key | result at: (i := i + 1) put: (self at: key) ].
+ ^result
+!
+
copyFrom: start to: stop
"Answer a new collection containing all the items in the receiver from the
start-th and to the stop-th"
--- orig/kernel/Dictionary.st
+++ mod/kernel/Dictionary.st
@@ -109,6 +109,14 @@ at: key put: value
^value
!
+atAll: keyCollection
+ "Answer a Dictionary that only includes the given keys. Fail if any of
+ them is not found"
+ | result |
+ result := self class new: keyCollection size.
+ keyCollection do: [ :key | result at: key put: (self at: key) ].
+ ^result!
+
at: key
"Answer the value associated to the given key. Fail if the key
is not found"
--- orig/kernel/MappedColl.st
+++ mod/kernel/MappedColl.st
@@ -82,6 +82,11 @@ at: key
^domain at: (map at: key)
!
+atAll: keyCollection
+ "Answer the object at the given key"
+ ^domain atAll: (map atAll: keyCollection)
+!
+
at: key put: value
"Store value at the given key"
^domain at: (map at: key) put: value
@@ -104,54 +109,58 @@ contents
^aBag
!
+copyFrom: a to: b
+ ^domain atAll: (map atAll: (a to: b))
+!
+
do: aBlock
"Evaluate aBlock for each object"
map do: [ :value | aBlock value: (domain at: value) ]
!
-domain
- "Answer the domain"
- ^domain
-!
-
keys
"Answer the keys that can be used to access this collection."
^map keys
!
-map
- "Answer the map"
- ^map
+keysAndValuesDo: aBlock
+ "Evaluate aBlock passing two arguments, one being a key that can be used to
+ access this collection, and the other one being the value."
+ map do: [ :key | aBlock value: key value: (self at: key) ]
+!
+
+keysDo: aBlock
+ "Evaluate aBlock on the keys that can be used to access this collection."
+ map do: aBlock
!
collect: aBlock
- "Answer a MappedCollection with a copy of the receiver's map
- and a domain obtained by passing each object through aBlock"
- | newDomain |
- newDomain := domain collect: aBlock.
- ^self species collection: newDomain map: map copy.
+ "Answer a Collection with the same keys as the map, where accessing
+ a key yields the value obtained by passing through aBlock the value
+ accessible from the key in the receiver. The result need not be
+ another MappedCollection"
+
+ "This is tricky. Optimize the operation in order to perform the
+ minimal number of evaluation of aBlock"
+ ^domain size > map size
+ ifTrue: [ map collect: [ :key | aBlock value: (self at: key) ] ]
+ ifFalse: [ self class collection: (domain collect: aBlock) map: map
copy ]
!
reject: aBlock
"Answer the objects in the domain for which aBlock returns false"
- | aStream map |
- aStream := WriteStream on: (domain copyEmpty: self size).
- self do: [ :value | (aBlock value: value) ifFalse:
- [ aStream nextPut: value ] ].
-
- ^aStream contents
+ | newMap |
+ newMap := newMap reject: [ :key | aBlock value: (self at: key) ].
+ ^self class collection: domain map: newMap
!
select: aBlock
"Answer the objects in the domain for which aBlock returns true"
- | aStream |
- aStream := WriteStream on: (domain copyEmpty: self size).
- self do: [ :value | (aBlock value: value) ifFalse:
- [ aStream nextPut: value ] ].
-
- ^aStream contents
+ | newMap |
+ newMap := newMap select: [ :key | aBlock value: (self at: key) ].
+ ^self class collection: domain map: newMap
! !
--- orig/kernel/SeqCollect.st
+++ mod/kernel/SeqCollect.st
@@ -151,6 +151,15 @@ at: anIndex ifAbsent: aBlock
^self at: anIndex
!
+atAll: keyCollection
+ "Answer a collection of the same kind returned by #collect:, that
+ only includes the values at the given indices. Fail if any of
+ the values in keyCollection is out of bounds for the receiver."
+ | result |
+ result := self copyEmptyForCollect: keyCollection size.
+ keyCollection do: [ :key | result add: (self at: key) ].
+ ^result!
+
atAll: aCollection put: anObject
"Put anObject at every index contained in aCollection"
aCollection do: [ :index | self at: index put: anObject ]
- [Help-smalltalk] [PATCH] Add #atAll:, improve MappedCollection,
Paolo Bonzini <=