More work on environments...
authorJan Vrany <jan.vrany@fit.cvut.cz>
Mon, 14 Sep 2015 16:27:00 +0100
changeset 10 2b9beeac547e
parent 9 569bf5707c7e
child 11 6d39860d0fdb
More work on environments...
compiler/TClassBinding.st
compiler/TCompilerExamples.st
compiler/TConstantBinding.st
compiler/TEnvironment.st
compiler/TEnvironmentProvider.st
compiler/TFilesystemProvider.st
compiler/TLLVMCodeGenerator.st
--- a/compiler/TClassBinding.st	Mon Sep 14 15:03:03 2015 +0100
+++ b/compiler/TClassBinding.st	Mon Sep 14 16:27:00 2015 +0100
@@ -64,5 +64,11 @@
 
 isClassBinding
     ^ true
+!
+
+isMetaclass
+    ^ clazz isMetaclass
+
+    "Created: / 14-09-2015 / 15:34:53 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 ! !
 
--- a/compiler/TCompilerExamples.st	Mon Sep 14 15:03:03 2015 +0100
+++ b/compiler/TCompilerExamples.st	Mon Sep 14 16:27:00 2015 +0100
@@ -61,21 +61,12 @@
 example_three_plus_four
     | environment unit compiler|
 
-    environment := TNamespaceDefinition new.
+    environment := TEnvironment new.
     unit := TSourceReader read:'
-nil subclass: #tSIntegerW
-    category: ''tKernel''
+nil subclass: #ThreePlusFour
+    category: ''t-Examples''
 !!
-!!tSIntegerW methodsFor:''arithmetic''!!
-+ another <tSIntegerW> <^ tSIntegerW> 
-    %[:asm | 
-        asm ret: (asm add: self _: another)
-    %].
-    "Following code is actually used only in hosted environment"
-    ^ self + another
-!! !!
-
-!!tSIntegerW class methodsFor:''test''!!
+!!ThreePlusFour class methodsFor:''examples''!!
 threePlusFour <^ tSIntegerW> 
         ^ 3 + 4
 
@@ -90,5 +81,6 @@
     "
 
     "Created: / 14-09-2015 / 11:56:57 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+    "Modified: / 14-09-2015 / 15:15:23 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 ! !
 
--- a/compiler/TConstantBinding.st	Mon Sep 14 15:03:03 2015 +0100
+++ b/compiler/TConstantBinding.st	Mon Sep 14 16:27:00 2015 +0100
@@ -40,13 +40,13 @@
 initializeWithValue: anObject
     value := anObject.
     value class == SmallInteger ifTrue:[ 
-        type := TSimpleType named: 'tSmallInteger'.
+        type := TSimpleType named: 'tSIntegerW'.
         ^ self.
     ].
     self error: 'Unsupported constant'
 
     "Created: / 25-08-2015 / 23:15:00 / Jan Vrany <jan.vrany@fit.cvut.cz>"
-    "Modified: / 01-09-2015 / 21:55:17 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+    "Modified: / 14-09-2015 / 15:18:47 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 ! !
 
 !TConstantBinding methodsFor:'testing'!
--- a/compiler/TEnvironment.st	Mon Sep 14 15:03:03 2015 +0100
+++ b/compiler/TEnvironment.st	Mon Sep 14 16:27:00 2015 +0100
@@ -23,6 +23,15 @@
     "Modified (comment): / 12-09-2015 / 09:52:28 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 ! !
 
+!TEnvironment methodsFor:'initialization'!
+
+initialize
+    super initialize.
+    provider := TFilesystemProvider new
+
+    "Created: / 14-09-2015 / 15:13:36 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
 !TEnvironment methodsFor:'lookup by name'!
 
 classOrTraitNamed: className
@@ -30,11 +39,17 @@
 
     classOrTrait := super classOrTraitNamed: className.
     classOrTrait isNil ifTrue:[ 
-        self addElements: (provider definitionForClassNamed: className).
+        | class |
+
+        class := provider classNamed:className.
+        class notNil ifTrue:[ 
+            self addElement: class.
+        ]
     ].
     classOrTrait := super classOrTraitNamed: className.
     ^ classOrTrait.
 
     "Created: / 12-09-2015 / 09:48:36 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+    "Modified: / 14-09-2015 / 15:28:29 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 ! !
 
--- a/compiler/TEnvironmentProvider.st	Mon Sep 14 15:03:03 2015 +0100
+++ b/compiler/TEnvironmentProvider.st	Mon Sep 14 16:27:00 2015 +0100
@@ -10,6 +10,14 @@
 !
 
 
+!TEnvironmentProvider methodsFor:'accessing'!
+
+classNamed:name 
+    self subclassResponsibility
+
+    "Created: / 14-09-2015 / 15:07:27 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
 !TEnvironmentProvider class methodsFor:'documentation'!
 
 version
--- a/compiler/TFilesystemProvider.st	Mon Sep 14 15:03:03 2015 +0100
+++ b/compiler/TFilesystemProvider.st	Mon Sep 14 16:27:00 2015 +0100
@@ -3,9 +3,58 @@
 "{ NameSpace: Smalltalk }"
 
 TEnvironmentProvider subclass:#TFilesystemProvider
-	instanceVariableNames:''
+	instanceVariableNames:'classpath'
 	classVariableNames:''
 	poolDictionaries:''
 	category:'Languages-Tea-Compiler-Model-Provider'
 !
 
+!TFilesystemProvider class methodsFor:'instance creation'!
+
+new
+    "return an initialized instance"
+
+    ^ self basicNew initialize.
+! !
+
+!TFilesystemProvider methodsFor:'accessing'!
+
+classNamed:name 
+    classpath do:[:each | 
+        | classes |
+
+        classes := self classNamed:name from:each.
+        classes notEmptyOrNil ifTrue:[
+            ^ classes.
+        ]
+    ].
+    ^ nil
+
+    "Created: / 14-09-2015 / 15:08:14 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+classNamed:name from:classpathentry 
+    | dir file unit |
+
+    dir := classpathentry asFilename.
+    dir isDirectory ifFalse:[
+        ^ nil
+    ].
+    file := dir / (name , '.tea').
+    file isReadable ifFalse:[
+        ^ nil
+    ].
+    unit := TSourceReader read:file.
+    ^ unit classes detect:[:class | class name = name ] ifNone:[ nil ]
+
+    "Created: / 14-09-2015 / 15:10:59 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!TFilesystemProvider methodsFor:'initialization'!
+
+initialize
+    classpath := OrderedCollection with: (Smalltalk packageDirectoryForPackageId: 'jv:tea') / 'libt'
+
+    "Modified: / 14-09-2015 / 15:06:58 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
--- a/compiler/TLLVMCodeGenerator.st	Mon Sep 14 15:03:03 2015 +0100
+++ b/compiler/TLLVMCodeGenerator.st	Mon Sep 14 16:27:00 2015 +0100
@@ -165,18 +165,26 @@
     | binding |
 
     binding := aMethodNode binding.
-    function := context module 
-                    addFunctionNamed: (self class llvmFunctionNameForClass: currentClass selector: currentMethod selector)      
-                    type: (LLVMType 
-                            function: { binding receiverType asLLVMTypeInModule: context module } ,
-                                       (binding parameterTypes collect:[:t|t asLLVMTypeInModule: context module])
-                            returning: (binding returnType asLLVMTypeInModule: context module)).
+    binding mclass isMetaclass ifTrue:[
+        function := context module 
+                        addFunctionNamed: (self class llvmFunctionNameForClass: currentClass selector: currentMethod selector)
+                        type: (LLVMType 
+                                function:  (binding parameterTypes collect:[:t|t asLLVMTypeInModule: context module])
+                                returning: (binding returnType asLLVMTypeInModule: context module)).
+    ] ifFalse:[ 
+        function := context module 
+                        addFunctionNamed: (self class llvmFunctionNameForClass: currentClass selector: currentMethod selector)      
+                        type: (LLVMType 
+                                function:  {binding receiverType asLLVMTypeInModule: context module } ,
+                                           (binding parameterTypes collect:[:t|t asLLVMTypeInModule: context module])
+                                returning: (binding returnType asLLVMTypeInModule: context module)).
+        (function parameterAt: 1) name: 'self'.
+    ].
     asm := function builder.
-    (function parameterAt: 1) name: 'self'.
     super acceptMethodNode: aMethodNode
 
     "Created: / 31-08-2015 / 09:42:58 / Jan Vrany <jan.vrany@fit.cvut.cz>"
-    "Modified: / 02-09-2015 / 21:31:19 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+    "Modified: / 14-09-2015 / 15:37:02 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 !
 
 acceptOptimizedNode: anOptimizedNode