[Help-smalltalk] [PATCH TwistedPools 1/n] add more namespace polymorphism methods to Dictionary

[Paolo Bonzini]

This is just a preparatory patch.  The final version will have
to include an abstract class, common to LookupTable and Dictionary,
so that these methods do not pollute LookupTable.

2008-04-16  Paolo Bonzini  <address@hidden>

        * kernel/AbstNamespc.st: Move some methods...
        * kernel/BindingDict.st: ... here (#= and #hash)
        * kernel/Dictionary.st: ... and here.
---
 kernel/AbstNamespc.st |  108 ------------------------------------------
 kernel/BindingDict.st |   19 +++++++-
 kernel/Dictionary.st  |  124 +++++++++++++++++++++++++++++++++++++++++++++++-
 3 files changed, 139 insertions(+), 112 deletions(-)

diff --git a/kernel/AbstNamespc.st b/kernel/AbstNamespc.st
index fbba3b5..12dacfd 100644
--- a/kernel/AbstNamespc.st
+++ b/kernel/AbstNamespc.st
@@ -61,25 +61,6 @@ an instance of me; it is called their `environment''. '>
                    yourself)
     ]
 
-    = arg [
-       "Answer whether the receiver is equal to arg. The equality test is
-        by default the same as that for equal objects. = must not fail;
-        answer false if the receiver cannot be compared to arg"
-
-       <category: 'basic & copying'>
-       <primitive: VMpr_Object_identity>
-       
-    ]
-
-    hash [
-       "Answer an hash value for the receiver.  This is the same as the
-        object's #identityHash."
-
-       <category: 'basic & copying'>
-       <primitive: VMpr_Object_hash>
-       
-    ]
-
     whileCurrentDo: aBlock [
        "Evaluate aBlock with the current namespace set to the receiver.
         Answer the result of the evaluation."
@@ -194,48 +175,6 @@ an instance of me; it is called their `environment''. '>
        ^class
     ]
 
-    definedKeys [
-       "Answer a kind of Set containing the keys of the receiver"
-
-       <category: 'overrides for superspaces'>
-       | aSet value |
-       aSet := self keysClass new: tally * 4 // 3.
-       1 to: self primSize
-           do: 
-               [:index | 
-               value := self primAt: index.
-               value isNil ifFalse: [aSet add: value key]].
-       ^aSet
-    ]
-
-    definesKey: key [
-       "Answer whether the receiver defines the given key. `Defines'
-        means that the receiver's superspaces, if any, are not considered."
-
-       <category: 'overrides for superspaces'>
-       ^super includesKey: key
-    ]
-
-    hereAt: key ifAbsent: aBlock [
-       "Return the value associated to the variable named as specified
-        by `key' *in this namespace*. If the key is not found search will
-        *not* be carried on in superspaces and aBlock will be immediately
-        evaluated."
-
-       <category: 'overrides for superspaces'>
-       ^super at: key ifAbsent: aBlock
-    ]
-
-    hereAt: key [
-       "Return the value associated to the variable named as specified
-        by `key' *in this namespace*. If the key is not found search will
-        *not* be carried on in superspaces and the method will fail."
-
-       <category: 'overrides for superspaces'>
-       ^self hereAt: key
-           ifAbsent: [SystemExceptions.NotFound signalOn: key what: 'key']
-    ]
-
     inheritedKeys [
        "Answer a Set of all the keys in the receiver and its superspaces"
 
@@ -319,16 +258,6 @@ an instance of me; it is called their `environment''. '>
        ^aSet
     ]
 
-    allSuperspaces [
-       "Answer all the receiver's superspaces in a collection"
-
-       <category: 'namespace hierarchy'>
-       | supers |
-       supers := OrderedCollection new.
-       self allSuperspacesDo: [:superspace | supers addLast: superspace].
-       ^supers
-    ]
-
     allSuperspacesDo: aBlock [
        "Evaluate aBlock once for each of the receiver's superspaces"
 
@@ -365,20 +294,6 @@ an instance of me; it is called their `environment''. '>
        ^false
     ]
 
-    inheritsFrom: aNamespace [
-       "Answer whether aNamespace is one of the receiver's direct and
-        indirect superspaces"
-
-       <category: 'namespace hierarchy'>
-       | space |
-       space := self.
-       
-       [space := space superspace.
-       space == aNamespace ifTrue: [^true].
-       space notNil] 
-               whileTrue
-    ]
-
     removeSubspace: aSymbol [
        "Remove my subspace named aSymbol from the hierarchy."
 
@@ -510,29 +425,6 @@ an instance of me; it is called their `environment''. '>
                subspace allSubspacesDo: aBlock]
     ]
 
-    withAllSuperspaces [
-       "Answer the receiver and all of its superspaces in a collection"
-
-       <category: 'namespace hierarchy'>
-       | supers |
-       supers := OrderedCollection with: self.
-       self allSuperspacesDo: [:superspace | supers addLast: superspace].
-       ^supers
-    ]
-
-    withAllSuperspacesDo: aBlock [
-       "Invokes aBlock for the receiver and all superspaces, both direct
-        and indirect."
-
-       <category: 'namespace hierarchy'>
-       | space |
-       space := self.
-       
-       [aBlock value: space.
-       space := space superspace.
-       space notNil] whileTrue
-    ]
-
     nameIn: aNamespace [
        "Answer Smalltalk code compiling to the receiver when the current
         namespace is aNamespace"
diff --git a/kernel/BindingDict.st b/kernel/BindingDict.st
index ab03bbe..b5093ee 100644
--- a/kernel/BindingDict.st
+++ b/kernel/BindingDict.st
@@ -44,6 +44,24 @@ My keys are (expected to be) symbols, so I use == to match 
searched keys
 to those in the dictionary -- this is done expecting that it brings a bit
 more speed.'>
 
+    = arg [
+        "Answer whether the receiver is equal to arg. The equality test is
+         by default the same as that for equal objects. = must not fail;
+         answer false if the receiver cannot be compared to arg"
+
+        <category: 'basic & copying'>
+        <primitive: VMpr_Object_identity>
+    ]
+
+    hash [
+        "Answer an hash value for the receiver.  This is the same as the
+         object's #identityHash."
+
+        <category: 'basic & copying'>
+        <primitive: VMpr_Object_hash>
+
+    ]
+
     copy [
        <category: 'copying'>
        ^self
@@ -273,4 +291,3 @@ more speed.'>
        ^IdentityDictionary
     ]
 ]
-
diff --git a/kernel/Dictionary.st b/kernel/Dictionary.st
index 70fc5c7..6c91085 100644
--- a/kernel/Dictionary.st
+++ b/kernel/Dictionary.st
@@ -586,11 +586,129 @@ certain special cases.'>
        ^self findIndex: key
     ]
 
+    allSuperspaces [
+        "Answer all the receiver's superspaces in a collection"
+
+        <category: 'namespace protocol'>
+        | supers |
+        supers := OrderedCollection new.
+        self allSuperspacesDo: [:superspace | supers addLast: superspace].
+        ^supers
+    ]
+
+    allSuperspacesDo: aBlock [
+        "Evaluate aBlock once for each of the receiver's superspaces (which
+        is none for BindingDictionary)."
+
+        <category: 'namespace protocol'>
+    ]
+
+    definedKeys [
+        "Answer a kind of Set containing the keys of the receiver"
+
+        <category: 'namespace protocol'>
+        | aSet value |
+        aSet := self keysClass new: tally * 4 // 3.
+        1 to: self primSize
+            do:
+                [:index |
+                value := self primAt: index.
+                value isNil ifFalse: [aSet add: value key]].
+        ^aSet
+    ]
+
+    inheritsFrom: aNamespace [
+        "Answer whether aNamespace is one of the receiver's direct and
+         indirect superspaces"
+
+        <category: 'namespace protocol'>
+        | space |
+        space := self.
+
+        [space := space superspace.
+        space == aNamespace ifTrue: [^true].
+        space notNil]
+                whileTrue
+    ]
+
+    superspace [
+        "Answer the receiver's superspace, which is nil for BindingDictionary."
+
+        <category: 'namespace protocol'>
+        ^nil
+    ]
+
     withAllSuperspaces [
-       "This method is needed by the compiler"
+        "Answer the receiver and all of its superspaces in a collection,
+        which is none for BindingDictionary"
 
-       <category: 'polymorphism hacks'>
-       ^{self}
+        <category: 'namespace protocol'>
+        | supers |
+        supers := OrderedCollection with: self.
+        self allSuperspacesDo: [:superspace | supers addLast: superspace].
+        ^supers
+    ]
+
+    withAllSuperspacesDo: aBlock [
+        "Invokes aBlock for the receiver and all superspaces, both direct
+         and indirect (though a BindingDictionary does not have any)."
+
+        <category: 'namespace protocol'>
+        aBlock value: self.
+        self allSuperspacesDo: aBlock
+    ]
+
+    definesKey: key [
+        "Answer whether the receiver defines the given key. `Defines'
+         means that the receiver's superspaces, if any, are not considered."
+
+        <category: 'namespace protocol'>
+       ^super includes: key
+    ]
+
+    hereAssociationAt: key ifAbsent: aBlock [
+        "Return the association for the variable named as specified
+         by `key' *in this namespace*. If the key is not found search will
+         *not* be carried on in superspaces and aBlock will be immediately
+         evaluated."
+ 
+        <category: 'namespace protocol'>
+       | index |
+       index := self findIndexOrNil: key.
+       ^index isNil ifTrue: [aBlock value] ifFalse: [self primAt: index]
+    ]
+ 
+    hereAssociationAt: key [
+        "Return the association for the variable named as specified
+         by `key' *in this namespace*. If the key is not found search will
+         *not* be carried on in superspaces and the method will fail."
+ 
+        <category: 'namespace protocol'>
+        ^self hereAssociationAt: key
+            ifAbsent: [SystemExceptions.NotFound signalOn: key what: 'key']
+    ]
+
+    hereAt: key ifAbsent: aBlock [
+        "Return the value associated to the variable named as specified
+         by `key' *in this namespace*. If the key is not found search will
+         *not* be carried on in superspaces and aBlock will be immediately
+         evaluated."
+
+        <category: 'namespace protocol'>
+       | index |
+       index := self findIndexOrNil: key.
+       ^index isNil ifTrue: [aBlock value] ifFalse: [(self primAt: index) 
value]
+    ]
+
+    hereAt: key [
+        "Return the value associated to the variable named as specified
+         by `key' *in this namespace*. If the key is not found search will
+         *not* be carried on in superspaces and the method will fail."
+
+        <category: 'namespace protocol'>
+        ^self hereAt: key
+            ifAbsent: [SystemExceptions.NotFound signalOn: key what: 'key']
     ]
 ]
 
+
-- 
1.5.5