[Help-smalltalk] [PATCH] Add #atAll:, improve MappedCollection

[Paolo Bonzini]

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 ]