help-smalltalk
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[Help-smalltalk] [PATCH] support converting code with undefined namespac


From: Paolo Bonzini
Subject: [Help-smalltalk] [PATCH] support converting code with undefined namespaces
Date: Mon, 13 Aug 2007 16:23:26 +0200
User-agent: Thunderbird 2.0.0.6 (Macintosh/20070728)

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  <address@hidden>

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

* looking for address@hidden/smalltalk--devo--2.2--patch-516 to compare with
* comparing to address@hidden/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'!




reply via email to

[Prev in Thread] Current Thread [Next in Thread]