[Help-smalltalk] [PATCH TwistedPools 3/n] class renaming, and changing TwistedPools to use the default pool resolution

[Paolo Bonzini]

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

        * PoolResolutionTests.st: Rename TestTwistedPools to
        TestDefaultPoolResolution, TestClassicPools to
        TestClassicPoolResolution, TwistedPools to
        DefaultPoolResolution, ClassicPools to ClassicPoolResolution
        * STSymTable.st: Likewise.  Remove HereAssociator and herePools.
        In DefaultPoolResolution, use #allSharedPoolDictionariesDo:
        instead of implementing TwistedPools manually.
        * package.xml: Adjust for naming changes.
---
 packages/stinst/parser/PoolResolutionTests.st |   22 +++---
 packages/stinst/parser/STSymTable.st          |  100 ++-----------------------
 packages/stinst/parser/package.xml            |    5 +-
 3 files changed, 21 insertions(+), 106 deletions(-)

diff --git a/packages/stinst/parser/PoolResolutionTests.st 
b/packages/stinst/parser/PoolResolutionTests.st
index a7f4a24..3e5872f 100644
--- a/packages/stinst/parser/PoolResolutionTests.st
+++ b/packages/stinst/parser/PoolResolutionTests.st
@@ -29,10 +29,8 @@
 |
  ======================================================================"
 
-Eval [
-    Tests addSubspace: #MyLibrary; addSubspace: #MyProject.
-    MyProject addSubspace: #MyLibWrapper.
-]
+Tests addSubspace: #MyLibrary; addSubspace: #MyProject.
+MyProject addSubspace: #MyLibWrapper.
 
 Namespace current: STInST.Tests.MyLibrary [
 
@@ -76,7 +74,7 @@ MyLibrary.Foo subclass: Baz [
 
 Namespace current: STInST.Tests [
 
-TestCase subclass: TestTwistedPools [
+TestCase subclass: TestDefaultPoolResolution [
     | foo bar baz |
 
     assertVariable: symbol of: pools is: value description: str [
@@ -87,9 +85,9 @@ TestCase subclass: TestTwistedPools [
     ]
 
     setUp [
-       foo := TwistedPools of: MyLibrary.Foo.
-       bar := TwistedPools of: MyLibrary.Bar.
-       baz := TwistedPools of: MyProject.MyLibWrapper.Baz.
+       foo := DefaultPoolResolution of: MyLibrary.Foo.
+       bar := DefaultPoolResolution of: MyLibrary.Bar.
+       baz := DefaultPoolResolution of: MyProject.MyLibWrapper.Baz.
     ]
 
     testClassPoolFirst [
@@ -110,7 +108,7 @@ TestCase subclass: TestTwistedPools [
     ]
 ]
 
-TestCase subclass: TestClassicPools [
+TestCase subclass: TestClassicPoolResolution [
     | foo bar baz |
 
     assertVariable: symbol of: pools is: value description: str [
@@ -121,9 +119,9 @@ TestCase subclass: TestClassicPools [
     ]
 
     setUp [
-       foo := ClassicPools of: MyLibrary.Foo.
-       bar := ClassicPools of: MyLibrary.Bar.
-       baz := ClassicPools of: MyProject.MyLibWrapper.Baz.
+       foo := ClassicPoolResolution of: MyLibrary.Foo.
+       bar := ClassicPoolResolution of: MyLibrary.Bar.
+       baz := ClassicPoolResolution of: MyProject.MyLibWrapper.Baz.
     ]
 
     testNamespaceFirst [
diff --git a/packages/stinst/parser/STSymTable.st 
b/packages/stinst/parser/STSymTable.st
index 9180444..359aece 100644
--- a/packages/stinst/parser/STSymTable.st
+++ b/packages/stinst/parser/STSymTable.st
@@ -453,7 +453,7 @@ use compiling methods for that class.'>
 
 
 
-PoolResolution subclass: ClassicPools [
+PoolResolution subclass: ClassicPoolResolution [
     | pools |
     <comment: 'I provide shared pool variable resolution as it was
 before the PoolResolution hierarchy was added, and TwistedPools became
@@ -494,8 +494,8 @@ default.'>
 
 
 
-PoolResolution subclass: TwistedPools [
-    | pools herePools |
+PoolResolution subclass: DefaultPoolResolution [
+    | pools |
     <comment: 'I provide a "namespace is application" oriented method
 of shared pool searching, intended to be more intuitive for those who
 expect things to be found in their own namespace first.         This is more
@@ -506,7 +506,6 @@ PoolResolution.'>
        "Add poolDictionary and all superspaces to the end of the
         search order.  Always succeed."
        <category: 'accessing'>
-       herePools := nil.
        pools addAll: poolDictionary withAllSuperspaces.
        ^true
     ]
@@ -514,10 +513,8 @@ PoolResolution.'>
     lookupBindingOf: symbol [
        "Search all pools in order (see super comment)."
        <category: 'accessing'>
-       herePools isNil ifTrue: [herePools := pools collect: [:pool |
-           HereAssociator around: pool]].
-       herePools do: [:pool |
-           (pool associationAt: symbol ifAbsent: [nil])
+       pools do: [:pool |
+           (pool hereAssociationAt: symbol ifAbsent: [nil])
                ifNotNil: [:assoc | ^assoc]].
        ^nil
     ]
@@ -526,89 +523,8 @@ PoolResolution.'>
        <category: 'initializing'>
        pools := OrderedSet identityNew: 7.
        aBehavior ifNil: [^nil].
-       self addTwistedPools: aBehavior.
-    ]
-
-    addTwistedPools: class [
-       "Implement the twisted pool search for a real class.  See
-        class comment."
-       <category: 'private'>
-       | withSuperspaces nextSuperspaces isCommonSpace |
-       "build with a single inheritance walk"
-       class withAllSuperclassesDo: [:class |
-           class classPool isEmpty ifFalse: [pools add: class classPool].
-           withSuperspaces := class environment withAllSuperspaces.
-           (self combineInheritablePools: class sharedPoolDictionaries
-                 reject: [:pool | withSuperspaces identityIncludes: pool])
-               do: [:pool | pools add: pool].
-           "only take spaces that aren't in the superclass's spaces"
-           isCommonSpace := class superclass ifNil: [[:space | false]]
-                ifNotNil: [:superclass |
-                   nextSuperspaces :=
-                       superclass environment withAllSuperspaces asSet.
-                   [:space | nextSuperspaces includes: space]].
-           self addPoolsLast: withSuperspaces until: isCommonSpace]
-    ]
-
-    addPoolsLast: newPools until: invPredicate [
-       <category: 'private'>
-       newPools do: [:pool |
-           (invPredicate value: pool) ifTrue: [^newPools].
-           pools add: pool].
-       ^newPools
-    ]
-
-    combineInheritablePools: list reject: invPredicate [
-       "Answer the result of combining the list of pools using a
-        topological sort, preferring dependent to prerequisite, and
-        then left to right.  Any pool that passes invPredicate will
-        not be answered."
-       <category: 'private'>
-       | visitState order descend |
-       visitState := IdentityDictionary new: list size.
-       order := OrderedCollection new: list size.
-       descend := [:pool | | state |
-           state := visitState at: pool ifAbsent: [nil].
-           #visiting == state ifTrue:
-               [SystemExceptions.InvalidValue
-                    signalOn: list
-                    reason: 'includes circular dependency'].
-           (state isNil and: [(invPredicate value: pool) not]) ifTrue:
-               [visitState at: pool put: #visiting.
-                "#allSuperspaces is not available on all pools"
-                pool withAllSuperspaces allButFirst reverseDo: descend.
-                order addFirst: pool.
-                visitState at: pool put: #visited]].
-       list reverseDo: descend.
-       ^order
-    ]
-]
-
-
-
-Object subclass: HereAssociator [
-    | namespace hasSupers |
-
-    <comment: 'I exist purely to help TwistedPools, and am not meant
-to make sense as a good independent protocol, even though I borrow
-from dictionaries.'>
-
-    HereAssociator class >> around: namespace [
-       <category: 'methods for TwistedPools'>
-       ^self new init: namespace; yourself
-    ]
-
-    init: aNamespace [
-       <category: 'methods for TwistedPools'>
-       namespace := aNamespace.
-       hasSupers := aNamespace withAllSuperspaces size > 1.
-    ]
-
-    associationAt: key ifAbsent: block [
-       <category: 'methods for TwistedPools'>
-       ^(hasSupers not or: [namespace definesKey: key])
-           ifTrue: [namespace associationAt: key ifAbsent: block]
-           ifFalse: block
+       aBehavior allSharedPoolDictionariesDo: [ :each |
+           each isEmpty ifFalse: [ pools add: each ] ]
     ]
 ]
 
@@ -636,6 +552,6 @@ Metaclass extend [
 
 Eval [
     STSymbolTable initialize.
-    PoolResolution current: TwistedPools.
+    PoolResolution current: DefaultPoolResolution.
 ]
 
diff --git a/packages/stinst/parser/package.xml 
b/packages/stinst/parser/package.xml
index 333f838..2d43b4c 100644
--- a/packages/stinst/parser/package.xml
+++ b/packages/stinst/parser/package.xml
@@ -21,9 +21,10 @@
   <filein>Exporter.st</filein>
 
   <test>
+   <namespace>STInST.Tests</namespace>
    <sunit>STInST.Tests.TestStandardRewrites</sunit>
-   <sunit>STInST.Tests.TestTwistedPools</sunit>
-   <sunit>STInST.Tests.TestClassicPools</sunit>
+   <sunit>STInST.Tests.TestDefaultPoolResolution</sunit>
+   <sunit>STInST.Tests.TestClassicPoolResolution</sunit>
    <filein>RewriteTests.st</filein>
    <filein>PoolResolutionTests.st</filein>
   </test>
-- 
1.5.5