More work on environments...
--- 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