[PATCH] support converting code with undefined namespaces

This is very common; see for example packages/numerics/NumericsAdds.st.
and packages/i18n/Sets.st ("I18N addSubspace: #Encoders").  Most
conversion failures are of this shape; I tested DhbNumericalMethods.

Paolo

2007-08-13  Paolo Bonzini  <[hidden email]>

        * STLoader.st: Create undefined namespaces.
        * STLoaderObjs.st: Support creating undefined classes in arbitrary
        namespaces.

* looking for [hidden email]--2004b/smalltalk--devo--2.2--patch-516 to compare with
* comparing to [hidden email]--2004b/smalltalk--devo--2.2--patch-516
M  packages/stinst/parser/STLoader.st
M  packages/stinst/parser/STLoaderObjs.st

* modified files

--- orig/packages/stinst/parser/STLoader.st
+++ mod/packages/stinst/parser/STLoader.st
@@ -328,31 +328,23 @@ resolveClass: node
         "Dictionary cannot have nil as a key, use the entire RBLiteralNode."
         ^self proxyNilClass ].
         
-    object := self resolveName: node.
+    object := self
+ resolveName: node
+ isNamespace: [ :index :size | index < size ].
     ^self proxyForClass: object
 !
 
 resolveNamespace: node
     | object |
-    object := self resolveName: node.
+    object := self
+ resolveName: node
+ isNamespace: [ :index :size | true ].
+
     ^self proxyForNamespace: object
 !
 
-resolveName: node
+resolveName: node isNamespace: aBlock
     | current selectors |
-    node isVariable
- ifTrue: [
-    (node name includes: $.) ifFalse: [
- ^self currentNamespace at: node name asSymbol ifAbsent: [
-    defaultNamespace
- at: node name asSymbol
- put: (UndefinedClass name: node name asSymbol for: self) ]].
-
-    ^(node name substrings: $.)
- inject: self currentNamespace
- into: [ :current :each | current at: each asSymbol ]
- ].
-
     current := node.
     selectors := OrderedCollection new.
     [ current isMessage ] whileTrue: [
@@ -361,9 +353,15 @@ resolveName: node
     ].
     selectors addAllFirst: (current name substrings: $.).
 
-    ^selectors
- inject: self currentNamespace
- into: [ :current :each | current at: each asSymbol ]
-! !
+    current := self currentNamespace.
+    selectors keysAndValuesDo: [ :index :each || name |
+ name := each asSymbol.
+ current := current
+       at: name
+       ifAbsentPut: [
+           (aBlock value: index value: selectors size)
+       ifTrue: [ current addSubspace: name ]
+       ifFalse: [ UndefinedClass name: name in: current for: self ]]].
+    ^current! !
 
 STClassLoader initialize!


--- orig/packages/stinst/parser/STLoaderObjs.st
+++ mod/packages/stinst/parser/STLoaderObjs.st
@@ -116,7 +116,7 @@ secondary: aDictionary
 
 
 PseudoBehavior subclass: #UndefinedClass
-        instanceVariableNames: 'name class'
+        instanceVariableNames: 'name class environment'
         classVariableNames: ''
         poolDictionaries: ''
         category: 'System-Compiler'!
@@ -676,8 +676,10 @@ nameIn: aNamespace
 
 !UndefinedClass class methodsFor: 'creating'!
 
-name: aSymbol for: aLoader
-    ^(self for: aLoader) setName: aSymbol
+name: aSymbol in: aNamespace for: aLoader
+    ^(self for: aLoader)
+ environment: aNamespace;
+ name: aSymbol
 ! !
 
 !UndefinedClass methodsFor: 'testing'!
@@ -699,14 +701,24 @@ classPragmas
 !
 
 name
-    ^name!
+    ^name
+!
 
-nameIn: aNamespace
-    ^name asString!
+name: aSymbol
+    name := aSymbol
+!
+
+initializeFor: aSTLoader
+    super initializeFor: aSTLoader.
+    class := UndefinedMetaclass for: self
+!
+
+environment
+    ^environment
+!
 
-setName: aSymbol
-    name := aSymbol.
-    class := UndefinedMetaclass for: self.
+environment: aNamespace
+    environment := aNamespace.
 ! !
 
 !UndefinedClass methodsFor: 'printing'!




_______________________________________________
help-smalltalk mailing list
[hidden email]
http://lists.gnu.org/mailman/listinfo/help-smalltalk