# HG changeset patch # User Jan Vrany # Date 1442239383 -3600 # Node ID 569bf5707c7eae7ff1be6b0cad328aa3f4a14e34 # Parent eec72263ed75afd0f53833706a03716bfc6634a2 Added support for special forms to parser and typechecker (somewhat) diff -r eec72263ed75 -r 569bf5707c7e compiler/Make.proto --- a/compiler/Make.proto Mon Sep 14 11:19:10 2015 +0100 +++ b/compiler/Make.proto Mon Sep 14 15:03:03 2015 +0100 @@ -132,6 +132,7 @@ $(OUTDIR)TCompilationUnitDefinition.$(O) TCompilationUnitDefinition.$(H): TCompilationUnitDefinition.st $(INCLUDE_TOP)/stx/goodies/ring/RGAbstractContainer.$(H) $(INCLUDE_TOP)/stx/goodies/ring/RGDefinition.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR) $(OUTDIR)TCompiler.$(O) TCompiler.$(H): TCompiler.st $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR) $(OUTDIR)TCompilerContext.$(O) TCompilerContext.$(H): TCompilerContext.st $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR) +$(OUTDIR)TCompilerError.$(O) TCompilerError.$(H): TCompilerError.st $(INCLUDE_TOP)/stx/libbasic/Error.$(H) $(INCLUDE_TOP)/stx/libbasic/Exception.$(H) $(INCLUDE_TOP)/stx/libbasic/GenericException.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR) $(OUTDIR)TEnvironmentProvider.$(O) TEnvironmentProvider.$(H): TEnvironmentProvider.st $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR) $(OUTDIR)TFormatter.$(O) TFormatter.$(H): TFormatter.st $(INCLUDE_TOP)/stx/goodies/refactoryBrowser/parser/RBFormatter.$(H) $(INCLUDE_TOP)/stx/goodies/refactoryBrowser/parser/RBProgramNodeVisitor.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR) $(OUTDIR)TInlineAssemblyBeginToken.$(O) TInlineAssemblyBeginToken.$(H): TInlineAssemblyBeginToken.st $(INCLUDE_TOP)/stx/goodies/refactoryBrowser/parser/RBToken.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR) @@ -145,6 +146,7 @@ $(OUTDIR)TScanner.$(O) TScanner.$(H): TScanner.st $(INCLUDE_TOP)/stx/goodies/refactoryBrowser/parser/RBScanner.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(INCLUDE_TOP)/stx/libbasic/Stream.$(H) $(STCHDR) $(OUTDIR)TScope.$(O) TScope.$(H): TScope.st $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR) $(OUTDIR)TSourceReader.$(O) TSourceReader.$(H): TSourceReader.st $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR) +$(OUTDIR)TSpecialFormNode.$(O) TSpecialFormNode.$(H): TSpecialFormNode.st $(INCLUDE_TOP)/stx/goodies/refactoryBrowser/parser/RBMessageNode.$(H) $(INCLUDE_TOP)/stx/goodies/refactoryBrowser/parser/RBProgramNode.$(H) $(INCLUDE_TOP)/stx/goodies/refactoryBrowser/parser/RBStatementNode.$(H) $(INCLUDE_TOP)/stx/goodies/refactoryBrowser/parser/RBValueNode.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR) $(OUTDIR)TType.$(O) TType.$(H): TType.st $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR) $(OUTDIR)TTypeNode.$(O) TTypeNode.$(H): TTypeNode.st $(INCLUDE_TOP)/stx/goodies/refactoryBrowser/parser/RBProgramNode.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR) $(OUTDIR)TTypeSpecNode.$(O) TTypeSpecNode.$(H): TTypeSpecNode.st $(INCLUDE_TOP)/stx/goodies/refactoryBrowser/parser/RBProgramNode.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR) @@ -161,12 +163,11 @@ $(OUTDIR)TSimpleTypeNode.$(O) TSimpleTypeNode.$(H): TSimpleTypeNode.st $(INCLUDE_TOP)/jv/tea/compiler/TTypeNode.$(H) $(INCLUDE_TOP)/stx/goodies/refactoryBrowser/parser/RBProgramNode.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR) $(OUTDIR)TValueBinding.$(O) TValueBinding.$(H): TValueBinding.st $(INCLUDE_TOP)/jv/tea/compiler/TBinding.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR) $(OUTDIR)TBlockBinding.$(O) TBlockBinding.$(H): TBlockBinding.st $(INCLUDE_TOP)/jv/tea/compiler/TBinding.$(H) $(INCLUDE_TOP)/jv/tea/compiler/TFunctionBinding.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR) -$(OUTDIR)TCodeGenerator.$(O) TCodeGenerator.$(H): TCodeGenerator.st $(INCLUDE_TOP)/jv/tea/compiler/TCompilerPass.$(H) $(INCLUDE_TOP)/jv/tea/compiler/TProgramNodeVisitor.$(H) $(INCLUDE_TOP)/stx/goodies/refactoryBrowser/parser/RBProgramNodeVisitor.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR) $(OUTDIR)TConstantBinding.$(O) TConstantBinding.$(H): TConstantBinding.st $(INCLUDE_TOP)/jv/tea/compiler/TBinding.$(H) $(INCLUDE_TOP)/jv/tea/compiler/TValueBinding.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR) +$(OUTDIR)TLLVMCodeGenerator.$(O) TLLVMCodeGenerator.$(H): TLLVMCodeGenerator.st $(INCLUDE_TOP)/jv/tea/compiler/TCompilerPass.$(H) $(INCLUDE_TOP)/jv/tea/compiler/TProgramNodeVisitor.$(H) $(INCLUDE_TOP)/stx/goodies/refactoryBrowser/parser/RBProgramNodeVisitor.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR) $(OUTDIR)TMethodBinding.$(O) TMethodBinding.$(H): TMethodBinding.st $(INCLUDE_TOP)/jv/tea/compiler/TBinding.$(H) $(INCLUDE_TOP)/jv/tea/compiler/TFunctionBinding.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR) $(OUTDIR)TSemanticAnalyser.$(O) TSemanticAnalyser.$(H): TSemanticAnalyser.st $(INCLUDE_TOP)/jv/tea/compiler/TCompilerPass.$(H) $(INCLUDE_TOP)/jv/tea/compiler/TProgramNodeVisitor.$(H) $(INCLUDE_TOP)/stx/goodies/refactoryBrowser/parser/RBProgramNodeVisitor.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR) $(OUTDIR)TTypechecker.$(O) TTypechecker.$(H): TTypechecker.st $(INCLUDE_TOP)/jv/tea/compiler/TCompilerPass.$(H) $(INCLUDE_TOP)/jv/tea/compiler/TProgramNodeVisitor.$(H) $(INCLUDE_TOP)/stx/goodies/refactoryBrowser/parser/RBProgramNodeVisitor.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR) -$(OUTDIR)TTypeseeder.$(O) TTypeseeder.$(H): TTypeseeder.st $(INCLUDE_TOP)/jv/tea/compiler/TCompilerPass.$(H) $(INCLUDE_TOP)/jv/tea/compiler/TProgramNodeVisitor.$(H) $(INCLUDE_TOP)/stx/goodies/refactoryBrowser/parser/RBProgramNodeVisitor.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR) $(OUTDIR)TVariableBinding.$(O) TVariableBinding.$(H): TVariableBinding.st $(INCLUDE_TOP)/jv/tea/compiler/TBinding.$(H) $(INCLUDE_TOP)/jv/tea/compiler/TValueBinding.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR) $(OUTDIR)TArgumentBinding.$(O) TArgumentBinding.$(H): TArgumentBinding.st $(INCLUDE_TOP)/jv/tea/compiler/TBinding.$(H) $(INCLUDE_TOP)/jv/tea/compiler/TValueBinding.$(H) $(INCLUDE_TOP)/jv/tea/compiler/TVariableBinding.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR) $(OUTDIR)TLocalBinding.$(O) TLocalBinding.$(H): TLocalBinding.st $(INCLUDE_TOP)/jv/tea/compiler/TBinding.$(H) $(INCLUDE_TOP)/jv/tea/compiler/TValueBinding.$(H) $(INCLUDE_TOP)/jv/tea/compiler/TVariableBinding.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR) diff -r eec72263ed75 -r 569bf5707c7e compiler/Make.spec --- a/compiler/Make.spec Mon Sep 14 11:19:10 2015 +0100 +++ b/compiler/Make.spec Mon Sep 14 15:03:03 2015 +0100 @@ -56,6 +56,7 @@ TCompilationUnitDefinition \ TCompiler \ TCompilerContext \ + TCompilerError \ TEnvironmentProvider \ TFormatter \ TInlineAssemblyBeginToken \ @@ -69,6 +70,7 @@ TScanner \ TScope \ TSourceReader \ + TSpecialFormNode \ TType \ TTypeNode \ TTypeSpecNode \ @@ -85,12 +87,11 @@ TSimpleTypeNode \ TValueBinding \ TBlockBinding \ - TCodeGenerator \ TConstantBinding \ + TLLVMCodeGenerator \ TMethodBinding \ TSemanticAnalyser \ TTypechecker \ - TTypeseeder \ TVariableBinding \ TArgumentBinding \ TLocalBinding \ @@ -104,6 +105,7 @@ $(OUTDIR_SLASH)TCompilationUnitDefinition.$(O) \ $(OUTDIR_SLASH)TCompiler.$(O) \ $(OUTDIR_SLASH)TCompilerContext.$(O) \ + $(OUTDIR_SLASH)TCompilerError.$(O) \ $(OUTDIR_SLASH)TEnvironmentProvider.$(O) \ $(OUTDIR_SLASH)TFormatter.$(O) \ $(OUTDIR_SLASH)TInlineAssemblyBeginToken.$(O) \ @@ -117,6 +119,7 @@ $(OUTDIR_SLASH)TScanner.$(O) \ $(OUTDIR_SLASH)TScope.$(O) \ $(OUTDIR_SLASH)TSourceReader.$(O) \ + $(OUTDIR_SLASH)TSpecialFormNode.$(O) \ $(OUTDIR_SLASH)TType.$(O) \ $(OUTDIR_SLASH)TTypeNode.$(O) \ $(OUTDIR_SLASH)TTypeSpecNode.$(O) \ @@ -133,12 +136,11 @@ $(OUTDIR_SLASH)TSimpleTypeNode.$(O) \ $(OUTDIR_SLASH)TValueBinding.$(O) \ $(OUTDIR_SLASH)TBlockBinding.$(O) \ - $(OUTDIR_SLASH)TCodeGenerator.$(O) \ $(OUTDIR_SLASH)TConstantBinding.$(O) \ + $(OUTDIR_SLASH)TLLVMCodeGenerator.$(O) \ $(OUTDIR_SLASH)TMethodBinding.$(O) \ $(OUTDIR_SLASH)TSemanticAnalyser.$(O) \ $(OUTDIR_SLASH)TTypechecker.$(O) \ - $(OUTDIR_SLASH)TTypeseeder.$(O) \ $(OUTDIR_SLASH)TVariableBinding.$(O) \ $(OUTDIR_SLASH)TArgumentBinding.$(O) \ $(OUTDIR_SLASH)TLocalBinding.$(O) \ diff -r eec72263ed75 -r 569bf5707c7e compiler/TCodeGenerator.st --- a/compiler/TCodeGenerator.st Mon Sep 14 11:19:10 2015 +0100 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,223 +0,0 @@ -"{ Package: 'jv:tea/compiler' }" - -"{ NameSpace: Smalltalk }" - -TCompilerPass subclass:#TCodeGenerator - instanceVariableNames:'function asm' - classVariableNames:'SelectorSpecialCharMappingTable' - poolDictionaries:'' - category:'Languages-Tea-Compiler' -! - -!TCodeGenerator class methodsFor:'initialization'! - -initialize - "Invoked at system start or when the class is dynamically loaded." - - "/ please change as required (and remove this comment) - - SelectorSpecialCharMappingTable := Dictionary withKeysAndValues: - #($+ 'pl' - $- 'mi' - $* 'mu' - $/ 'di' - $, 'co' - $@ 'at' - $< 'le' - $> 'gr' - $= 'eq' - $~ 'ne' - $| 'pi' - $\ 'mo' - $& 'am'). - - "Modified: / 11-07-2015 / 09:24:06 / Jan Vrany " -! ! - -!TCodeGenerator class methodsFor:'utilities'! - -llvmFunctionNameForClass: class selector: selector - "For given class name and selector, returns the name - used by LLVM" - - ^ String streamContents:[ :s| - s nextPutAll: '__M_L_'. - s nextPutAll: (class theNonMetaclass name copyReplaceAll: $: with: $_). - class isMeta ifTrue:[ - s nextPutAll: '_class' - ]. - s nextPut: $_. - selector isBinarySelector ifTrue:[ - selector do:[:c | - s nextPutAll: (SelectorSpecialCharMappingTable at: c) - ]. - ] ifFalse:[ - selector do:[:c | - c isAlphaNumeric ifTrue:[ - s nextPut: c - ] ifFalse:[ - s nextPut: $_. - c == $: ifFalse:[ - c codePoint printOn: s. - ] - ]. - ] - ]. - ]. - - " - TLLVMIREmitPass llvmFunctionNameForClass: TLLVMIREmitPass class selector: #llvmFunctionNameForClass:selector: - TLLVMIREmitPass llvmFunctionNameForClass: SmallInteger selector: #+ - TLLVMIREmitPass llvmFunctionNameForClass: Object selector: #~= - - " - - "Created: / 30-08-2015 / 09:23:36 / Jan Vrany " - "Modified: / 31-08-2015 / 07:04:53 / Jan Vrany " -! ! - -!TCodeGenerator methodsFor:'visiting'! - -visitArgument: anRBVariableNode - | binding | - - binding := anRBVariableNode binding. - binding isArgumentBinding ifTrue:[ - (function parameterAt: binding index) name: anRBVariableNode name. - ] ifFalse:[ - self notYetImplemented. - ]. - - "Created: / 02-09-2015 / 08:43:00 / Jan Vrany " -! ! - -!TCodeGenerator methodsFor:'visitor-double dispatching'! - -acceptArrayNode: anArrayNode - self notYetImplemented - - "Created: / 31-08-2015 / 10:14:19 / Jan Vrany " -! - -acceptAssignmentNode: anAssignmentNode - self notYetImplemented - - "Created: / 31-08-2015 / 10:14:13 / Jan Vrany " -! - -acceptBlockNode: aBlockNode - self notYetImplemented - - "Created: / 31-08-2015 / 10:14:08 / Jan Vrany " -! - -acceptCascadeNode: aCascadeNode - self notYetImplemented - - "Created: / 31-08-2015 / 10:14:02 / Jan Vrany " -! - -acceptInlineAssemblyNode: aTInlineAssemblyNode - | emitMethodNode emitMethod| - - emitMethodNode := RBMethodNode new. - emitMethodNode arguments: (aTInlineAssemblyNode arguments collect:[ :e|e copy]) , { RBVariableNode named: 'zelf' } , (aTInlineAssemblyNode topNode arguments collect:[ :e|e copy]). - emitMethodNode body: aTInlineAssemblyNode body copy. - emitMethodNode variableNodesDo:[ :variableNode | - variableNode name = 'self' ifTrue:[ - variableNode name: 'zelf'. - ]. - ]. - emitMethodNode selector:(String streamContents: [ :s | emitMethodNode arguments size timesRepeat:[s nextPutAll:'_:'] ]). - emitMethod := Compiler compile: emitMethodNode formattedCode forClass: UndefinedObject install: false. - emitMethod - valueWithReceiver: nil - arguments: { asm } , ((1 to: function numArgs) collect: [ :i | function parameterAt: i ]) - - "Created: / 02-09-2015 / 06:53:43 / Jan Vrany " - "Modified: / 02-09-2015 / 10:30:22 / Jan Vrany " -! - -acceptLiteralNode: aLiteralNode - ^ aLiteralNode binding asLLVMValueInModule: context module. - - "Created: / 31-08-2015 / 10:13:55 / Jan Vrany " - "Modified: / 31-08-2015 / 12:20:52 / Jan Vrany " -! - -acceptMessageNode: aMessageNode - | receiver arguments methodName methodFunction | - - receiver := self visitNode: aMessageNode receiver. - receiver := self visitNode: aMessageNode receiver. - arguments := aMessageNode arguments collect: [:argument | self visitNode: argument ]. - - methodName := self class llvmFunctionNameForClass: aMessageNode binding mclass clazz selector: aMessageNode selector. - methodFunction := context module getFunctionNamed: methodName. - - ^ asm call: methodFunction _: { receiver } , arguments - - "Created: / 31-08-2015 / 10:13:51 / Jan Vrany " - "Modified: / 03-09-2015 / 07:13:04 / Jan Vrany " -! - -acceptMethodNode: aMethodNode - | 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)). - asm := function builder. - (function parameterAt: 1) name: 'self'. - super acceptMethodNode: aMethodNode - - "Created: / 31-08-2015 / 09:42:58 / Jan Vrany " - "Modified: / 02-09-2015 / 21:31:19 / Jan Vrany " -! - -acceptOptimizedNode: anOptimizedNode - self notYetImplemented - - "Created: / 31-08-2015 / 10:13:46 / Jan Vrany " -! - -acceptPragmaNode: aPragmaNode - self notYetImplemented - - "Created: / 31-08-2015 / 10:13:41 / Jan Vrany " -! - -acceptReturnNode: aReturnNode - | value | - - value := self visitNode: aReturnNode value. - asm ret: value. - - "Created: / 31-08-2015 / 10:13:36 / Jan Vrany " - "Modified: / 31-08-2015 / 12:17:53 / Jan Vrany " -! - -acceptSTXPrimitiveCCodeNode: aPrimitiveCCodeNode - self notYetImplemented - - "Created: / 31-08-2015 / 10:13:31 / Jan Vrany " -! - -acceptSTXPrimitiveValueCCodeNode: aPrimitiveValueCCodeNode - self notYetImplemented - - "Created: / 31-08-2015 / 10:13:27 / Jan Vrany " -! - -acceptVariableNode: aVariableNode - self notYetImplemented - - "Created: / 31-08-2015 / 10:13:08 / Jan Vrany " -! ! - - -TCodeGenerator initialize! diff -r eec72263ed75 -r 569bf5707c7e compiler/TCompiler.st --- a/compiler/TCompiler.st Mon Sep 14 11:19:10 2015 +0100 +++ b/compiler/TCompiler.st Mon Sep 14 15:03:03 2015 +0100 @@ -52,16 +52,16 @@ | unit | unit := context unit. - self assert:(unit isRingObject and:[ unit isCompilationUnit ] ). - unit classes do: [ :class | context environment addClass: class ]. - + self assert:(unit isRingObject and:[ unit isCompilationUnit ]). + unit classes do:[:class | + context environment addClass:class + ]. self runPass:TSemanticAnalyser. - self runPass:TTypeseeder. self runPass:TTypechecker. - self runPass:TCodeGenerator. + self runPass:TLLVMCodeGenerator. "Created: / 29-08-2015 / 14:22:41 / Jan Vrany " - "Modified: / 14-09-2015 / 10:33:47 / Jan Vrany " + "Modified: / 14-09-2015 / 13:10:37 / Jan Vrany " ! runPass: aClass diff -r eec72263ed75 -r 569bf5707c7e compiler/TCompilerContext.st --- a/compiler/TCompilerContext.st Mon Sep 14 11:19:10 2015 +0100 +++ b/compiler/TCompilerContext.st Mon Sep 14 15:03:03 2015 +0100 @@ -36,3 +36,12 @@ unit := aTCompilationUnit. ! ! +!TCompilerContext methodsFor:'error reporting'! + +reportTypeError: message + + TCompilerError raiseErrorString: message + + "Created: / 14-09-2015 / 14:20:03 / Jan Vrany " +! ! + diff -r eec72263ed75 -r 569bf5707c7e compiler/TCompilerError.st --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/compiler/TCompilerError.st Mon Sep 14 15:03:03 2015 +0100 @@ -0,0 +1,11 @@ +"{ Package: 'jv:tea/compiler' }" + +"{ NameSpace: Smalltalk }" + +Error subclass:#TCompilerError + instanceVariableNames:'' + classVariableNames:'' + poolDictionaries:'' + category:'Languages-Tea-Compiler-Exceptions' +! + diff -r eec72263ed75 -r 569bf5707c7e compiler/TCompilerExamples.st --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/compiler/TCompilerExamples.st Mon Sep 14 15:03:03 2015 +0100 @@ -0,0 +1,94 @@ +"{ Package: 'jv:tea/compiler' }" + +"{ NameSpace: Smalltalk }" + +TestCase subclass:#TCompilerExamples + instanceVariableNames:'' + classVariableNames:'' + poolDictionaries:'' + category:'Languages-Tea-Compiler-Examples' +! + +!TCompilerExamples class methodsFor:'asserting'! + +isTestSelector:aSelector + ^ (super isTestSelector:aSelector) or:[ aSelector startsWith: 'example' ] + + "Created: / 14-09-2015 / 11:56:04 / Jan Vrany " +! ! + +!TCompilerExamples methodsFor:'tests'! + +example_if + | environment unit compiler| + + environment := TNamespaceDefinition new. + unit := TSourceReader read:' +nil subclass: #tBoolean + category: ''tKernel-Builtins'' +!! + +nil subclass: #tSIntegerW + category: ''tKernel-Builtins'' +!! +!!tSIntegerW methodsFor:''testing''!! += another <^ tBoolean> + %[:asm | + asm ret: (asm add: self _: another) + %]. + "Following code is actually used only in hosted environment" + ^ self + another +!! !! + +!!tSIntegerW class methodsFor:''test''!! +threePlusFour <^ tSIntegerW> + ^ 3 + 4 + +!! !! + '. + + compiler := TCompiler new. + compiler compile: unit in: environment. + self halt. + " + compiler context module + " + + "Created: / 14-09-2015 / 12:14:27 / Jan Vrany " + "Modified: / 14-09-2015 / 14:27:35 / Jan Vrany " +! + +example_three_plus_four + | environment unit compiler| + + environment := TNamespaceDefinition new. + unit := TSourceReader read:' +nil subclass: #tSIntegerW + category: ''tKernel'' +!! +!!tSIntegerW methodsFor:''arithmetic''!! ++ another <^ tSIntegerW> + %[:asm | + asm ret: (asm add: self _: another) + %]. + "Following code is actually used only in hosted environment" + ^ self + another +!! !! + +!!tSIntegerW class methodsFor:''test''!! +threePlusFour <^ tSIntegerW> + ^ 3 + 4 + +!! !! + '. + + compiler := TCompiler new. + compiler compile: unit in: environment. + self halt. + " + compiler context module + " + + "Created: / 14-09-2015 / 11:56:57 / Jan Vrany " +! ! + diff -r eec72263ed75 -r 569bf5707c7e compiler/TCompilerPass.st --- a/compiler/TCompilerPass.st Mon Sep 14 11:19:10 2015 +0100 +++ b/compiler/TCompilerPass.st Mon Sep 14 15:03:03 2015 +0100 @@ -6,9 +6,29 @@ instanceVariableNames:'context currentClass currentMethod currentScope' classVariableNames:'' poolDictionaries:'' - category:'Languages-Tea-Compiler' + category:'Languages-Tea-Compiler-Internals' +! + +!TCompilerPass class methodsFor:'running'! + +runOn: anObject + ^ self new runOn: anObject + + "Created: / 14-09-2015 / 13:57:25 / Jan Vrany " ! +runOn: anObject inContext: aTCompilerContext + ^ self new runOn: anObject inContext: aTCompilerContext + + "Created: / 14-09-2015 / 13:57:45 / Jan Vrany " +! + +runOn: anObject inEnvironment: aTEnvironment + ^ self new runOn: anObject inEnvironment: aTEnvironment + + "Created: / 14-09-2015 / 13:57:59 / Jan Vrany " +! ! + !TCompilerPass methodsFor:'accessing'! context @@ -22,17 +42,41 @@ !TCompilerPass methodsFor:'running'! run - self run: context unit + self runOn: context unit "Created: / 31-08-2015 / 11:52:38 / Jan Vrany " + "Modified: / 14-09-2015 / 13:54:20 / Jan Vrany " ! -run: anObject +runOn: anObject + context isNil ifTrue:[ + context := TCompilerContext new. + context environment: TEnvironment new. + context unit: anObject. + ]. anObject isRingObject ifTrue:[ self visitDefinition: anObject ] ifFalse:[ self visitNode: anObject ] - "Created: / 29-08-2015 / 21:45:51 / Jan Vrany " + "Created: / 14-09-2015 / 13:54:13 / Jan Vrany " +! + +runOn: anObject inContext: aTCompilerContext + self context: aTCompilerContext. + self runOn: anObject + + "Created: / 14-09-2015 / 13:55:29 / Jan Vrany " +! + +runOn: anObject inEnvironment: aTEnvironment + context isNil ifTrue:[ + context := TCompilerContext new. + context unit: anObject. + ]. + context environment: aTEnvironment. + self runOn: anObject + + "Created: / 14-09-2015 / 13:59:45 / Jan Vrany " ! ! !TCompilerPass methodsFor:'visiting'! @@ -73,6 +117,18 @@ "Created: / 14-09-2015 / 10:31:43 / Jan Vrany " ! +acceptIfTrueIfFalseNode: node + self acceptMessageNode: node + + "Created: / 14-09-2015 / 14:09:10 / Jan Vrany " +! + +acceptIfTrueNode: node + self acceptMessageNode: node + + "Created: / 14-09-2015 / 14:09:07 / Jan Vrany " +! + acceptInlineAssemblyNode: aMethodNode "Created: / 02-09-2015 / 07:03:06 / Jan Vrany " @@ -112,5 +168,26 @@ ]. "Created: / 02-09-2015 / 07:16:37 / Jan Vrany " +! + +acceptSpecialFormNode:aTSpecialFormNode + aTSpecialFormNode selector = #ifTrue: ifTrue:[ + ^ self acceptIfTrueNode:aTSpecialFormNode. + ]. + aTSpecialFormNode selector = #ifTrue:ifFalse: ifTrue:[ + ^ self acceptIfTrueIfFalseNode:aTSpecialFormNode. + ]. + aTSpecialFormNode selector = #whileTrue: ifTrue:[ + ^ self acceptWhileTrueNode:aTSpecialFormNode. + ]. + ^ self error:'Unsupported special form: #' , aTSpecialFormNode selector + + "Created: / 14-09-2015 / 14:09:12 / Jan Vrany " +! + +acceptWhileTrueNode: node + self acceptMessageNode: node + + "Created: / 14-09-2015 / 14:09:12 / Jan Vrany " ! ! diff -r eec72263ed75 -r 569bf5707c7e compiler/TCompilerTests.st --- a/compiler/TCompilerTests.st Mon Sep 14 11:19:10 2015 +0100 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,94 +0,0 @@ -"{ Package: 'jv:tea/compiler' }" - -"{ NameSpace: Smalltalk }" - -TestCase subclass:#TCompilerTests - instanceVariableNames:'' - classVariableNames:'' - poolDictionaries:'' - category:'Languages-Tea-Compiler-Tests' -! - -!TCompilerTests methodsFor:'tests'! - -test_01 - | class method compiler | - - class := TClassDefinition newClass. - class name: 'tSmallInteger'. - - method := TMethodDefinition class: class theMetaclass. - method source: 'one <^ tSmallInteger> ^ 1'. - class addMethod: method. - - compiler := TCompiler new. - compiler compile: class in: nil. - self halt. - " - compiler context module - " - - "Created: / 29-08-2015 / 21:15:51 / Jan Vrany " - "Modified: / 01-09-2015 / 21:55:46 / Jan Vrany " -! - -test_02 - | class method compiler | - - class := TClassDefinition newClass. - class name: 'tSmallInteger'. - - method := TMethodDefinition class: class. - method source: '+ another <^ tSmallInteger> - %[:asm | - asm ret: (asm add: self _: another) - %]. - ^ self + another - '. - class addMethod: method. - - compiler := TCompiler new. - compiler compile: class in: nil. - self halt. - " - compiler context module - " - - "Created: / 02-09-2015 / 07:00:01 / Jan Vrany " -! - -test_three_plus_four - | environment unit compiler| - - environment := TNamespaceDefinition new. - unit := TSourceReader read:' -nil subclass: #tSmallInteger - category: ''tKernel'' -!! -!!tSmallInteger methodsFor:''arithmetic''!! -+ another <^ tSmallInteger> - %[:asm | - asm ret: (asm add: self _: another) - %]. - "Following code is actually used only in hosted environment" - ^ self + another -!! !! - -!!tSmallInteger methodsFor:''test''!! -threePlusFour <^ tSmallInteger> - ^ 3 + 4 - -!! !! - '. - - compiler := TCompiler new. - compiler compile: unit in: environment. - self halt. - " - compiler context module - " - - "Created: / 02-09-2015 / 10:25:18 / Jan Vrany " - "Modified: / 14-09-2015 / 11:08:00 / Jan Vrany " -! ! - diff -r eec72263ed75 -r 569bf5707c7e compiler/TFormatter.st --- a/compiler/TFormatter.st Mon Sep 14 11:19:10 2015 +0100 +++ b/compiler/TFormatter.st Mon Sep 14 15:03:03 2015 +0100 @@ -117,6 +117,12 @@ "Created: / 21-08-2015 / 22:20:26 / Jan Vrany " ! +acceptSpecialFormNode: aTSpecialFormNode + self acceptMessageNode: aTSpecialFormNode + + "Created: / 14-09-2015 / 12:10:11 / Jan Vrany " +! + acceptTypeSpecNode: aTTypeSpecNode aTTypeSpecNode type notNil ifTrue:[ codeStream nextPut:$<; space. diff -r eec72263ed75 -r 569bf5707c7e compiler/TLLVMCodeGenerator.st --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/compiler/TLLVMCodeGenerator.st Mon Sep 14 15:03:03 2015 +0100 @@ -0,0 +1,223 @@ +"{ Package: 'jv:tea/compiler' }" + +"{ NameSpace: Smalltalk }" + +TCompilerPass subclass:#TLLVMCodeGenerator + instanceVariableNames:'function asm' + classVariableNames:'SelectorSpecialCharMappingTable' + poolDictionaries:'' + category:'Languages-Tea-Compiler-Internals' +! + +!TLLVMCodeGenerator class methodsFor:'initialization'! + +initialize + "Invoked at system start or when the class is dynamically loaded." + + "/ please change as required (and remove this comment) + + SelectorSpecialCharMappingTable := Dictionary withKeysAndValues: + #($+ 'pl' + $- 'mi' + $* 'mu' + $/ 'di' + $, 'co' + $@ 'at' + $< 'le' + $> 'gr' + $= 'eq' + $~ 'ne' + $| 'pi' + $\ 'mo' + $& 'am'). + + "Modified: / 11-07-2015 / 09:24:06 / Jan Vrany " +! ! + +!TLLVMCodeGenerator class methodsFor:'utilities'! + +llvmFunctionNameForClass: class selector: selector + "For given class name and selector, returns the name + used by LLVM" + + ^ String streamContents:[ :s| + s nextPutAll: '__M_L_'. + s nextPutAll: (class theNonMetaclass name copyReplaceAll: $: with: $_). + class isMeta ifTrue:[ + s nextPutAll: '_class' + ]. + s nextPut: $_. + selector isBinarySelector ifTrue:[ + selector do:[:c | + s nextPutAll: (SelectorSpecialCharMappingTable at: c) + ]. + ] ifFalse:[ + selector do:[:c | + c isAlphaNumeric ifTrue:[ + s nextPut: c + ] ifFalse:[ + s nextPut: $_. + c == $: ifFalse:[ + c codePoint printOn: s. + ] + ]. + ] + ]. + ]. + + " + TLLVMIREmitPass llvmFunctionNameForClass: TLLVMIREmitPass class selector: #llvmFunctionNameForClass:selector: + TLLVMIREmitPass llvmFunctionNameForClass: SmallInteger selector: #+ + TLLVMIREmitPass llvmFunctionNameForClass: Object selector: #~= + + " + + "Created: / 30-08-2015 / 09:23:36 / Jan Vrany " + "Modified: / 31-08-2015 / 07:04:53 / Jan Vrany " +! ! + +!TLLVMCodeGenerator methodsFor:'visiting'! + +visitArgument: anRBVariableNode + | binding | + + binding := anRBVariableNode binding. + binding isArgumentBinding ifTrue:[ + (function parameterAt: binding index) name: anRBVariableNode name. + ] ifFalse:[ + self notYetImplemented. + ]. + + "Created: / 02-09-2015 / 08:43:00 / Jan Vrany " +! ! + +!TLLVMCodeGenerator methodsFor:'visitor-double dispatching'! + +acceptArrayNode: anArrayNode + self notYetImplemented + + "Created: / 31-08-2015 / 10:14:19 / Jan Vrany " +! + +acceptAssignmentNode: anAssignmentNode + self notYetImplemented + + "Created: / 31-08-2015 / 10:14:13 / Jan Vrany " +! + +acceptBlockNode: aBlockNode + self notYetImplemented + + "Created: / 31-08-2015 / 10:14:08 / Jan Vrany " +! + +acceptCascadeNode: aCascadeNode + self notYetImplemented + + "Created: / 31-08-2015 / 10:14:02 / Jan Vrany " +! + +acceptInlineAssemblyNode: aTInlineAssemblyNode + | emitMethodNode emitMethod| + + emitMethodNode := RBMethodNode new. + emitMethodNode arguments: (aTInlineAssemblyNode arguments collect:[ :e|e copy]) , { RBVariableNode named: 'zelf' } , (aTInlineAssemblyNode topNode arguments collect:[ :e|e copy]). + emitMethodNode body: aTInlineAssemblyNode body copy. + emitMethodNode variableNodesDo:[ :variableNode | + variableNode name = 'self' ifTrue:[ + variableNode name: 'zelf'. + ]. + ]. + emitMethodNode selector:(String streamContents: [ :s | emitMethodNode arguments size timesRepeat:[s nextPutAll:'_:'] ]). + emitMethod := Compiler compile: emitMethodNode formattedCode forClass: UndefinedObject install: false. + emitMethod + valueWithReceiver: nil + arguments: { asm } , ((1 to: function numArgs) collect: [ :i | function parameterAt: i ]) + + "Created: / 02-09-2015 / 06:53:43 / Jan Vrany " + "Modified: / 02-09-2015 / 10:30:22 / Jan Vrany " +! + +acceptLiteralNode: aLiteralNode + ^ aLiteralNode binding asLLVMValueInModule: context module. + + "Created: / 31-08-2015 / 10:13:55 / Jan Vrany " + "Modified: / 31-08-2015 / 12:20:52 / Jan Vrany " +! + +acceptMessageNode: aMessageNode + | receiver arguments methodName methodFunction | + + receiver := self visitNode: aMessageNode receiver. + receiver := self visitNode: aMessageNode receiver. + arguments := aMessageNode arguments collect: [:argument | self visitNode: argument ]. + + methodName := self class llvmFunctionNameForClass: aMessageNode binding mclass clazz selector: aMessageNode selector. + methodFunction := context module getFunctionNamed: methodName. + + ^ asm call: methodFunction _: { receiver } , arguments + + "Created: / 31-08-2015 / 10:13:51 / Jan Vrany " + "Modified: / 03-09-2015 / 07:13:04 / Jan Vrany " +! + +acceptMethodNode: aMethodNode + | 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)). + asm := function builder. + (function parameterAt: 1) name: 'self'. + super acceptMethodNode: aMethodNode + + "Created: / 31-08-2015 / 09:42:58 / Jan Vrany " + "Modified: / 02-09-2015 / 21:31:19 / Jan Vrany " +! + +acceptOptimizedNode: anOptimizedNode + self notYetImplemented + + "Created: / 31-08-2015 / 10:13:46 / Jan Vrany " +! + +acceptPragmaNode: aPragmaNode + self notYetImplemented + + "Created: / 31-08-2015 / 10:13:41 / Jan Vrany " +! + +acceptReturnNode: aReturnNode + | value | + + value := self visitNode: aReturnNode value. + asm ret: value. + + "Created: / 31-08-2015 / 10:13:36 / Jan Vrany " + "Modified: / 31-08-2015 / 12:17:53 / Jan Vrany " +! + +acceptSTXPrimitiveCCodeNode: aPrimitiveCCodeNode + self notYetImplemented + + "Created: / 31-08-2015 / 10:13:31 / Jan Vrany " +! + +acceptSTXPrimitiveValueCCodeNode: aPrimitiveValueCCodeNode + self notYetImplemented + + "Created: / 31-08-2015 / 10:13:27 / Jan Vrany " +! + +acceptVariableNode: aVariableNode + self notYetImplemented + + "Created: / 31-08-2015 / 10:13:08 / Jan Vrany " +! ! + + +TLLVMCodeGenerator initialize! diff -r eec72263ed75 -r 569bf5707c7e compiler/TNamespaceBinding.st --- a/compiler/TNamespaceBinding.st Mon Sep 14 11:19:10 2015 +0100 +++ b/compiler/TNamespaceBinding.st Mon Sep 14 15:03:03 2015 +0100 @@ -24,6 +24,14 @@ ^ self basicNew initialize. ! ! +!TNamespaceBinding methodsFor:'accessing'! + +type + ^ self shouldNotImplement + + "Created: / 14-09-2015 / 14:13:00 / Jan Vrany " +! ! + !TNamespaceBinding methodsFor:'initialization'! initializeWithNamespace: aTNamespaceDefinition @@ -36,6 +44,12 @@ !TNamespaceBinding methodsFor:'lookup'! +lookupClassBoolean + ^ self lookupClassNamed: 'tBoolean' + + "Created: / 14-09-2015 / 14:13:22 / Jan Vrany " +! + lookupClassNamed: name | class | @@ -47,6 +61,24 @@ "Created: / 02-09-2015 / 11:09:33 / Jan Vrany " "Modified (format): / 02-09-2015 / 16:00:49 / Jan Vrany " +! + +lookupClassPointer + ^ self lookupClassNamed: 'tPointer' + + "Created: / 14-09-2015 / 14:14:04 / Jan Vrany " +! + +lookupClassSIntegerW + ^ self lookupClassNamed: 'tSIntegerW' + + "Created: / 14-09-2015 / 14:13:46 / Jan Vrany " +! + +lookupClassUIntegerW + ^ self lookupClassNamed: 'tUIntegerW' + + "Created: / 14-09-2015 / 14:13:54 / Jan Vrany " ! ! !TNamespaceBinding class methodsFor:'documentation'! diff -r eec72263ed75 -r 569bf5707c7e compiler/TParser.st --- a/compiler/TParser.st Mon Sep 14 11:19:10 2015 +0100 +++ b/compiler/TParser.st Mon Sep 14 15:03:03 2015 +0100 @@ -77,6 +77,52 @@ "Created: / 21-08-2015 / 22:55:43 / Jan Vrany " ! +parseBlockArgsInto: node + | verticalBar args colons | + args := OrderedCollection new: 2. + colons := OrderedCollection new: 2. + verticalBar := false. + [currentToken isSpecial and: [currentToken value == $:]] whileTrue: [ + colons add: currentToken start. + self step. ":" + verticalBar := true. + args add: self parseArgOrLocal + ]. + (currentToken isBinary and:[ currentToken value == #< ]) ifTrue:[ + "Return type spec" + node returnTypeSpec: (self parseTypeSpec: true). + verticalBar := true. + ]. + verticalBar ifTrue:[ + currentToken isBinary ifTrue: [ + node bar: currentToken start. + currentToken value == #| ifTrue: [ + self step + ] ifFalse: [ + currentToken value == #'||' ifTrue:[ + "Hack the current token to be the start + of temps bar" + currentToken + value: #|; + start: currentToken start + 1 + ] ifFalse: [ + self parserError: '''|'' expected' + ] + ] + ] ifFalse: [ + (currentToken isSpecial and: [currentToken value == $]]) ifFalse: [ + self parserError: '''|'' expected' + ] + ]. + ]. + node + arguments: args; + colons: colons. + ^node + + "Created: / 14-09-2015 / 14:35:49 / Jan Vrany " +! + parseInlineAssembly | position blockNode firstLine prevScope| @@ -113,6 +159,22 @@ "Created: / 02-09-2015 / 06:25:54 / Jan Vrany " ! +parseKeywordMessageWith: node + | message | + message := super parseKeywordMessageWith: node. + message ~~ node ifTrue:[ + "/ Check for special forms here... + (TSpecialFormNode specialSelectors includes: message selector) ifTrue:[ + message := TSpecialFormNode receiver: message receiver + selectorParts: message selectorParts + arguments: message arguments. + ]. + ]. + ^ message + + "Created: / 14-09-2015 / 12:24:28 / Jan Vrany " +! + parseKeywordPattern | method | diff -r eec72263ed75 -r 569bf5707c7e compiler/TParserTests.st --- a/compiler/TParserTests.st Mon Sep 14 11:19:10 2015 +0100 +++ b/compiler/TParserTests.st Mon Sep 14 15:03:03 2015 +0100 @@ -14,10 +14,26 @@ test_blockargs | method | - method := TParser parseMethod: 'foo <^ Float> self select:[ :e | e = NaN ]' + method := TParser parseMethod: 'foo <^ Float> [ :e | e = NaN ]'. + + self assert: method body statements first arguments size == 1. + self assert: method body statements first arguments first typeSpec type name = 'Float'. + self assert: method body statements first returnTypeSpec isNil. + + method := TParser parseMethod: 'foo <^ Float> [ :e <^ Boolean> | e = NaN ]'. + + self assert: method body statements first arguments size == 1. + self assert: method body statements first arguments first typeSpec type name = 'Float'. + self assert: method body statements first returnTypeSpec notNil. + self assert: method body statements first returnTypeSpec type name = 'Boolean'. + + + method := TParser parseMethod: 'foo <^ Float> [ <^ Float> | e = NaN ]'. + self assert: method body statements first returnTypeSpec notNil. + self assert: method body statements first returnTypeSpec type name = 'Float'. "Created: / 21-08-2015 / 07:10:06 / Jan Vrany " - "Modified: / 21-08-2015 / 23:04:37 / Jan Vrany " + "Modified: / 14-09-2015 / 14:54:00 / Jan Vrany " ! test_inline_assembly @@ -26,20 +42,20 @@ method := TParser parseMethod: 'foo < ^ Integer > %[ :asm | asm ret: 1 %].'. self assert: method body statements size == 1. self assert: method body statements first isInlineAssembly. - self halt. "Created: / 02-09-2015 / 06:31:15 / Jan Vrany " + "Modified: / 14-09-2015 / 12:15:23 / Jan Vrany " ! test_locals | method | - method := TParser parseMethod: 'foo <^ Float> | local1 local2 | ^ local1'. + method := TParser parseMethod: 'foo <^ Float> | local1 local2 | ^ local1'. - method := TParser parseMethod: 'foo <^ Float> self something ifTrue:[ | local1 | local + instvar ]'. + method := TParser parseMethod: 'foo <^ Float> self something ifTrue:[ | local1 | local + instvar ]'. "Created: / 21-08-2015 / 07:06:21 / Jan Vrany " - "Modified: / 21-08-2015 / 23:05:55 / Jan Vrany " + "Modified: / 14-09-2015 / 12:15:50 / Jan Vrany " ! test_method_pattern_01 @@ -71,5 +87,23 @@ "Created: / 20-08-2015 / 17:01:48 / Jan Vrany " "Modified: / 21-08-2015 / 23:00:59 / Jan Vrany " +! + +test_special_form + | method | + + method := TParser parseMethod: 'foo < ^ Integer > true ifTrue:[]'. + self assert: method body statements size = 1. + self assert: method body statements first isSpecialFormNode. + + method := TParser parseMethod: 'foo < ^ Integer > true ifTrue:[] ifFalse:[]'. + self assert: method body statements size = 1. + self assert: method body statements first isSpecialFormNode. + + method := TParser parseMethod: 'foo < ^ Integer > [] whileTrue:[]'. + self assert: method body statements size = 1. + self assert: method body statements first isSpecialFormNode. + + "Created: / 14-09-2015 / 12:18:33 / Jan Vrany " ! ! diff -r eec72263ed75 -r 569bf5707c7e compiler/TProgramNodeVisitor.st --- a/compiler/TProgramNodeVisitor.st Mon Sep 14 11:19:10 2015 +0100 +++ b/compiler/TProgramNodeVisitor.st Mon Sep 14 15:03:03 2015 +0100 @@ -44,6 +44,12 @@ "Modified: / 25-08-2015 / 19:54:21 / Jan Vrany " ! +acceptSpecialFormNode: aTSpecialFormNode + self acceptMessageNode: aTSpecialFormNode + + "Created: / 14-09-2015 / 12:10:35 / Jan Vrany " +! + acceptTypeSpecNode: aTTypeSpecNode self visitNode: aTTypeSpecNode type. diff -r eec72263ed75 -r 569bf5707c7e compiler/TSemanticAnalyser.st --- a/compiler/TSemanticAnalyser.st Mon Sep 14 11:19:10 2015 +0100 +++ b/compiler/TSemanticAnalyser.st Mon Sep 14 15:03:03 2015 +0100 @@ -6,15 +6,18 @@ instanceVariableNames:'' classVariableNames:'' poolDictionaries:'' - category:'Languages-Tea-Compiler' + category:'Languages-Tea-Compiler-Internals' ! !TSemanticAnalyser class methodsFor:'documentation'! documentation " - This pass analyzes the tree, creates scopes and - initializes variable bindings. + This is the very first pass on the code. Its responsibility is: + * initialize bindings including types (except for message sends as those + depends on type analysis) + * initialize scopes (i.e, assign scopes and populate them + with variables) [author:] Jan Vrany @@ -28,46 +31,7 @@ " ! ! -!TSemanticAnalyser methodsFor:'visitor-double dispatching'! - -acceptBlockNode: aBlockNode - aBlockNode scope: (currentScope subScope: aBlockNode). - super acceptBlockNode: aBlockNode - - "Created: / 25-08-2015 / 22:30:21 / Jan Vrany " - "Modified: / 02-09-2015 / 07:20:39 / Jan Vrany " -! - -acceptLiteralNode: aRBLiteralNode - super acceptLiteralNode: aRBLiteralNode. - aRBLiteralNode binding: (TConstantBinding value: aRBLiteralNode value). - - "Created: / 25-08-2015 / 23:17:30 / Jan Vrany " - "Modified: / 02-09-2015 / 10:34:50 / Jan Vrany " -! - -acceptMethodNode: aMethodNode - | scope bindingSelf | - - scope := TScope node: aMethodNode. - bindingSelf := TArgumentBinding name:'self'. - bindingSelf index: self. - scope addVariable: bindingSelf. - - aMethodNode scope: scope. - - super acceptMethodNode: aMethodNode - - "Created: / 25-08-2015 / 22:29:21 / Jan Vrany " - "Modified: / 13-09-2015 / 09:30:28 / Jan Vrany " -! - -acceptVariableNode: aVariableNode - aVariableNode binding: (aVariableNode scope lookupVariable: aVariableNode name). - super acceptVariableNode: aVariableNode - - "Created: / 25-08-2015 / 23:00:34 / Jan Vrany " -! +!TSemanticAnalyser methodsFor:'visiting'! visitArgument: anRBVariableNode | binding | @@ -86,6 +50,53 @@ "Modified: / 02-09-2015 / 08:58:32 / Jan Vrany " ! ! +!TSemanticAnalyser methodsFor:'visitor-double dispatching'! + +acceptBlockNode: aBlockNode + | scope | + aBlockNode parent isSpecialFormNode ifTrue:[ + scope := currentScope subScope: aBlockNode. + ] ifFalse:[ + scope := TScope new. + ]. + aBlockNode scope: scope. + super acceptBlockNode: aBlockNode + + "Created: / 25-08-2015 / 22:30:21 / Jan Vrany " + "Modified: / 14-09-2015 / 14:04:06 / Jan Vrany " +! + +acceptLiteralNode: aRBLiteralNode + super acceptLiteralNode: aRBLiteralNode. + aRBLiteralNode binding: (TConstantBinding value: aRBLiteralNode value). + + "Created: / 25-08-2015 / 23:17:30 / Jan Vrany " + "Modified: / 02-09-2015 / 10:34:50 / Jan Vrany " +! + +acceptMethodNode: aMethodNode + | scope bindingForSelf | + + scope := TScope node: aMethodNode. + bindingForSelf := TArgumentBinding name:'self'. + bindingForSelf index: self. + scope addVariable: bindingForSelf. + + aMethodNode scope: scope. + + super acceptMethodNode: aMethodNode + + "Created: / 25-08-2015 / 22:29:21 / Jan Vrany " + "Modified: / 13-09-2015 / 09:30:28 / Jan Vrany " +! + +acceptVariableNode: aVariableNode + aVariableNode binding: (aVariableNode scope lookupVariable: aVariableNode name). + super acceptVariableNode: aVariableNode + + "Created: / 25-08-2015 / 23:00:34 / Jan Vrany " +! ! + !TSemanticAnalyser class methodsFor:'documentation'! version diff -r eec72263ed75 -r 569bf5707c7e compiler/TSemanticAnalyserTests.st --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/compiler/TSemanticAnalyserTests.st Mon Sep 14 15:03:03 2015 +0100 @@ -0,0 +1,23 @@ +"{ Package: 'jv:tea/compiler' }" + +"{ NameSpace: Smalltalk }" + +TestCase subclass:#TSemanticAnalyserTests + instanceVariableNames:'' + classVariableNames:'' + poolDictionaries:'' + category:'Languages-Tea-Compiler-Internals-Tests' +! + +!TSemanticAnalyserTests methodsFor:'tests'! + +test_01 + + "Created: / 29-08-2015 / 14:11:42 / Jan Vrany " +! + +test_special_form_01 + + "Created: / 14-09-2015 / 12:54:06 / Jan Vrany " +! ! + diff -r eec72263ed75 -r 569bf5707c7e compiler/TSemanticAnalysisPassTests.st --- a/compiler/TSemanticAnalysisPassTests.st Mon Sep 14 11:19:10 2015 +0100 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,18 +0,0 @@ -"{ Package: 'jv:tea/compiler' }" - -"{ NameSpace: Smalltalk }" - -TestCase subclass:#TSemanticAnalysisPassTests - instanceVariableNames:'' - classVariableNames:'' - poolDictionaries:'' - category:'Languages-Tea-Compiler-Tests' -! - -!TSemanticAnalysisPassTests methodsFor:'tests'! - -test_01 - - "Created: / 29-08-2015 / 14:11:42 / Jan Vrany " -! ! - diff -r eec72263ed75 -r 569bf5707c7e compiler/TSimpleType.st --- a/compiler/TSimpleType.st Mon Sep 14 11:19:10 2015 +0100 +++ b/compiler/TSimpleType.st Mon Sep 14 15:03:03 2015 +0100 @@ -42,29 +42,22 @@ asLLVMTypeInModule: aLLVMModule "Return the type as LLVMType" - "/ Q&D hack for builtin types, sigh... - name = 'i1' ifTrue:[ - ^ LLVMType int1 - ]. - name = 'i8' ifTrue:[ - ^ LLVMType int1 + name = 'tUIntegerW' ifTrue:[ + ^ LLVMType intptr ]. - name = 'i32' ifTrue:[ - ^ LLVMType int32 - ]. - name = 'i64' ifTrue:[ - ^ LLVMType int64 - ]. - name = 'iptr' ifTrue:[ + name = 'tSIntegerW' ifTrue:[ ^ LLVMType intptr ]. - name = 'tSmallInteger' ifTrue:[ - ^ LLVMType intptr - ]. - ^ LLVMType void pointer + name = 'tPointer' ifTrue:[ + ^ LLVMType void pointer + ]. + name = 'tBoolean' ifTrue:[ + ^ LLVMType int1 + ]. + ^ self notYetImplemented "Created: / 31-08-2015 / 09:06:45 / Jan Vrany " - "Modified: / 03-09-2015 / 16:31:46 / Jan Vrany " + "Modified: / 14-09-2015 / 11:43:00 / Jan Vrany " ! ! !TSimpleType methodsFor:'initialization'! diff -r eec72263ed75 -r 569bf5707c7e compiler/TSpecialFormNode.st --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/compiler/TSpecialFormNode.st Mon Sep 14 15:03:03 2015 +0100 @@ -0,0 +1,64 @@ +"{ Package: 'jv:tea/compiler' }" + +"{ NameSpace: Smalltalk }" + +RBMessageNode subclass:#TSpecialFormNode + instanceVariableNames:'' + classVariableNames:'' + poolDictionaries:'' + category:'Languages-Tea-Compiler-AST' +! + +!TSpecialFormNode class methodsFor:'documentation'! + +documentation +" + TSpecialNode + + [author:] + Jan Vrany + + [instance variables:] + + [class variables:] + + [see also:] + +" +! ! + +!TSpecialFormNode class methodsFor:'instance creation'! + +receiver: receiver selectorParts: keywordTokens arguments: arguments + ^self new + receiver: receiver + selectorParts: keywordTokens + arguments: arguments + + "Created: / 14-09-2015 / 12:27:53 / Jan Vrany " +! ! + +!TSpecialFormNode class methodsFor:'accessing'! + +specialSelectors + ^ #( ifTrue: ifTrue:ifFalse: whileTrue: ) + + "Created: / 14-09-2015 / 12:22:35 / Jan Vrany " +! ! + +!TSpecialFormNode methodsFor:'testing'! + +isSpecialFormNode + ^ true + + "Created: / 14-09-2015 / 12:16:25 / Jan Vrany " +! ! + +!TSpecialFormNode methodsFor:'visiting'! + +acceptVisitor: aProgramNodeVisitor + ^aProgramNodeVisitor acceptSpecialFormNode: self + + "Created: / 14-09-2015 / 12:09:26 / Jan Vrany " +! ! + diff -r eec72263ed75 -r 569bf5707c7e compiler/TTypechecker.st --- a/compiler/TTypechecker.st Mon Sep 14 11:19:10 2015 +0100 +++ b/compiler/TTypechecker.st Mon Sep 14 15:03:03 2015 +0100 @@ -6,11 +6,37 @@ instanceVariableNames:'' classVariableNames:'' poolDictionaries:'' - category:'Languages-Tea-Compiler' + category:'Languages-Tea-Compiler-Internals' ! !TTypechecker methodsFor:'visitor-double dispatching'! +acceptIfTrueIfFalseNode: node + | receiverType booleanType | + + receiverType := node binding type. + booleanType := context environment binding lookupClassBoolean. + + receiverType = booleanType ifFalse:[ + context reportTypeError: 'receiver of ifTrue:ifFalse: special form must be of type tBoolean (is ' , receiverType printString. + ]. + + "Created: / 14-09-2015 / 14:24:50 / Jan Vrany " +! + +acceptIfTrueNode: node + | receiverType booleanType | + + receiverType := node binding type. + booleanType := context environment binding lookupClassBoolean. + + receiverType = booleanType ifFalse:[ + context reportTypeError: 'receiver of ifTrue: special form must be of type tBoolean (is ' , receiverType printString. + ]. + + "Created: / 14-09-2015 / 14:18:28 / Jan Vrany " +! + acceptMessageNode: aMessageNode | receiverType receiverBinding methodBinding | @@ -24,7 +50,7 @@ actualParamType := (aMessageNode arguments at: paramIdx) binding type. formalParamType := methodBinding parameterTypes at: paramIdx. (actualParamType isSubtypeOf: formalParamType) ifFalse:[ - self error: 'Type mismatch'. + context reportTypeError: ('Type mismatch for parameter %1 (expected %2, got %3)' bindWith: paramIdx with: formalParamType with: actualParamType). ^ self. ]. ]. @@ -34,6 +60,6 @@ self notYetImplemented "Created: / 02-09-2015 / 10:34:08 / Jan Vrany " - "Modified: / 02-09-2015 / 17:11:11 / Jan Vrany " + "Modified: / 14-09-2015 / 14:22:41 / Jan Vrany " ! ! diff -r eec72263ed75 -r 569bf5707c7e compiler/TTypecheckerTests.st --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/compiler/TTypecheckerTests.st Mon Sep 14 15:03:03 2015 +0100 @@ -0,0 +1,32 @@ +"{ Package: 'jv:tea/compiler' }" + +"{ NameSpace: Smalltalk }" + +TestCase subclass:#TTypecheckerTests + instanceVariableNames:'' + classVariableNames:'' + poolDictionaries:'' + category:'Languages-Tea-Compiler-Internals-Tests' +! + +!TTypecheckerTests methodsFor:'tests - bindings'! + +test_binding_01 + | unit | + + unit := TSourceReader read: ' + nil subclass: tObject + category: ''tKernel'' + !! + !!tObject methodsFor: ''tests''!! + foo <^ tObject> + ^ self + !! !! + '. + TSemanticAnalyser runOn: unit. + + self halt: 'Unfinished' + + "Created: / 14-09-2015 / 13:52:42 / Jan Vrany " +! ! + diff -r eec72263ed75 -r 569bf5707c7e compiler/TTypeseeder.st --- a/compiler/TTypeseeder.st Mon Sep 14 11:19:10 2015 +0100 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,32 +0,0 @@ -"{ Package: 'jv:tea/compiler' }" - -"{ NameSpace: Smalltalk }" - -TCompilerPass subclass:#TTypeseeder - instanceVariableNames:'' - classVariableNames:'' - poolDictionaries:'' - category:'Languages-Tea-Compiler' -! - -!TTypeseeder methodsFor:'visiting'! - -visitArgument: anRBVariableNode - super visitArgument: anRBVariableNode. - anRBVariableNode binding type: anRBVariableNode typeSpec asType - - "Created: / 31-08-2015 / 11:51:44 / Jan Vrany " -! ! - -!TTypeseeder methodsFor:'visitor-double dispatching'! - -acceptMethodNode: aMethodNode - super acceptMethodNode: aMethodNode. - aMethodNode binding - returnType: aMethodNode returnTypeSpec asType; - parameterTypes: (aMethodNode arguments collect: [ :arg | arg binding type ]) - - "Created: / 31-08-2015 / 12:13:15 / Jan Vrany " - "Modified: / 02-09-2015 / 17:05:08 / Jan Vrany " -! ! - diff -r eec72263ed75 -r 569bf5707c7e compiler/abbrev.stc --- a/compiler/abbrev.stc Mon Sep 14 11:19:10 2015 +0100 +++ b/compiler/abbrev.stc Mon Sep 14 15:03:03 2015 +0100 @@ -6,7 +6,8 @@ TCompilationUnitDefinition TCompilationUnitDefinition jv:tea/compiler 'Languages-Tea-Compiler-Model' 0 TCompiler TCompiler jv:tea/compiler 'Languages-Tea-Compiler' 0 TCompilerContext TCompilerContext jv:tea/compiler 'Languages-Tea-Compiler' 0 -TCompilerTests TCompilerTests jv:tea/compiler 'Languages-Tea-Compiler-Tests' 1 +TCompilerError TCompilerError jv:tea/compiler 'Languages-Tea-Compiler-Exceptions' 1 +TCompilerExamples TCompilerExamples jv:tea/compiler 'Languages-Tea-Compiler-Examples' 1 TEnvironmentProvider TEnvironmentProvider jv:tea/compiler 'Languages-Tea-Compiler-Model-Provider' 0 TFormatter TFormatter jv:tea/compiler 'Languages-Tea-Compiler-AST' 0 TInlineAssemblyBeginToken TInlineAssemblyBeginToken jv:tea/compiler 'Languages-Tea-Compiler-AST' 0 @@ -21,16 +22,18 @@ TProgramNodeVisitor TProgramNodeVisitor jv:tea/compiler 'Languages-Tea-Compiler-AST' 0 TScanner TScanner jv:tea/compiler 'Languages-Tea-Compiler-AST' 0 TScope TScope jv:tea/compiler 'Languages-Tea-Compiler-Bindings' 0 -TSemanticAnalysisPassTests TSemanticAnalysisPassTests jv:tea/compiler 'Languages-Tea-Compiler-Tests' 1 +TSemanticAnalyserTests TSemanticAnalyserTests jv:tea/compiler 'Languages-Tea-Compiler-Internals-Tests' 1 TSourceReader TSourceReader jv:tea/compiler 'Languages-Tea-Compiler-Model' 0 TSourceReaderTests TSourceReaderTests jv:tea/compiler 'Languages-Tea-Compiler-Model-Tests' 1 +TSpecialFormNode TSpecialFormNode jv:tea/compiler 'Languages-Tea-Compiler-AST' 0 TType TType jv:tea/compiler 'Languages-Tea-Compiler-Types' 0 TTypeNode TTypeNode jv:tea/compiler 'Languages-Tea-Compiler-AST' 0 TTypeSpecNode TTypeSpecNode jv:tea/compiler 'Languages-Tea-Compiler-AST' 0 +TTypecheckerTests TTypecheckerTests jv:tea/compiler 'Languages-Tea-Compiler-Internals-Tests' 1 jv_tea_compiler jv_tea_compiler jv:tea/compiler '* Projects & Packages *' 3 TBlockType TBlockType jv:tea/compiler 'Languages-Tea-Compiler-Types' 0 TClassBinding TClassBinding jv:tea/compiler 'Languages-Tea-Compiler-Bindings' 0 -TCompilerPass TCompilerPass jv:tea/compiler 'Languages-Tea-Compiler' 0 +TCompilerPass TCompilerPass jv:tea/compiler 'Languages-Tea-Compiler-Internals' 0 TDirectoryProvider TDirectoryProvider jv:tea/compiler 'Languages-Tea-Compiler-Model-Provider' 0 TEnvironment TEnvironment jv:tea/compiler 'Languages-Tea-Compiler-Model' 0 TFilesystemProvider TFilesystemProvider jv:tea/compiler 'Languages-Tea-Compiler-Model-Provider' 0 @@ -40,12 +43,11 @@ TSimpleTypeNode TSimpleTypeNode jv:tea/compiler 'Languages-Tea-Compiler-AST' 0 TValueBinding TValueBinding jv:tea/compiler 'Languages-Tea-Compiler-Bindings' 0 TBlockBinding TBlockBinding jv:tea/compiler 'Languages-Tea-Compiler-Bindings' 0 -TCodeGenerator TCodeGenerator jv:tea/compiler 'Languages-Tea-Compiler' 0 TConstantBinding TConstantBinding jv:tea/compiler 'Languages-Tea-Compiler-Bindings' 0 +TLLVMCodeGenerator TLLVMCodeGenerator jv:tea/compiler 'Languages-Tea-Compiler-Internals' 0 TMethodBinding TMethodBinding jv:tea/compiler 'Languages-Tea-Compiler-Bindings' 0 -TSemanticAnalyser TSemanticAnalyser jv:tea/compiler 'Languages-Tea-Compiler' 0 -TTypechecker TTypechecker jv:tea/compiler 'Languages-Tea-Compiler' 0 -TTypeseeder TTypeseeder jv:tea/compiler 'Languages-Tea-Compiler' 0 +TSemanticAnalyser TSemanticAnalyser jv:tea/compiler 'Languages-Tea-Compiler-Internals' 0 +TTypechecker TTypechecker jv:tea/compiler 'Languages-Tea-Compiler-Internals' 0 TVariableBinding TVariableBinding jv:tea/compiler 'Languages-Tea-Compiler-Bindings' 0 TArgumentBinding TArgumentBinding jv:tea/compiler 'Languages-Tea-Compiler-Bindings' 0 TLocalBinding TLocalBinding jv:tea/compiler 'Languages-Tea-Compiler-Bindings' 0 diff -r eec72263ed75 -r 569bf5707c7e compiler/bc.mak --- a/compiler/bc.mak Mon Sep 14 11:19:10 2015 +0100 +++ b/compiler/bc.mak Mon Sep 14 15:03:03 2015 +0100 @@ -79,6 +79,7 @@ $(OUTDIR)TCompilationUnitDefinition.$(O) TCompilationUnitDefinition.$(H): TCompilationUnitDefinition.st $(INCLUDE_TOP)\stx\goodies\ring\RGAbstractContainer.$(H) $(INCLUDE_TOP)\stx\goodies\ring\RGDefinition.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR) $(OUTDIR)TCompiler.$(O) TCompiler.$(H): TCompiler.st $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR) $(OUTDIR)TCompilerContext.$(O) TCompilerContext.$(H): TCompilerContext.st $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR) +$(OUTDIR)TCompilerError.$(O) TCompilerError.$(H): TCompilerError.st $(INCLUDE_TOP)\stx\libbasic\Error.$(H) $(INCLUDE_TOP)\stx\libbasic\Exception.$(H) $(INCLUDE_TOP)\stx\libbasic\GenericException.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR) $(OUTDIR)TEnvironmentProvider.$(O) TEnvironmentProvider.$(H): TEnvironmentProvider.st $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR) $(OUTDIR)TFormatter.$(O) TFormatter.$(H): TFormatter.st $(INCLUDE_TOP)\stx\goodies\refactoryBrowser\parser\RBFormatter.$(H) $(INCLUDE_TOP)\stx\goodies\refactoryBrowser\parser\RBProgramNodeVisitor.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR) $(OUTDIR)TInlineAssemblyBeginToken.$(O) TInlineAssemblyBeginToken.$(H): TInlineAssemblyBeginToken.st $(INCLUDE_TOP)\stx\goodies\refactoryBrowser\parser\RBToken.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR) @@ -92,6 +93,7 @@ $(OUTDIR)TScanner.$(O) TScanner.$(H): TScanner.st $(INCLUDE_TOP)\stx\goodies\refactoryBrowser\parser\RBScanner.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(INCLUDE_TOP)\stx\libbasic\Stream.$(H) $(STCHDR) $(OUTDIR)TScope.$(O) TScope.$(H): TScope.st $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR) $(OUTDIR)TSourceReader.$(O) TSourceReader.$(H): TSourceReader.st $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR) +$(OUTDIR)TSpecialFormNode.$(O) TSpecialFormNode.$(H): TSpecialFormNode.st $(INCLUDE_TOP)\stx\goodies\refactoryBrowser\parser\RBMessageNode.$(H) $(INCLUDE_TOP)\stx\goodies\refactoryBrowser\parser\RBProgramNode.$(H) $(INCLUDE_TOP)\stx\goodies\refactoryBrowser\parser\RBStatementNode.$(H) $(INCLUDE_TOP)\stx\goodies\refactoryBrowser\parser\RBValueNode.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR) $(OUTDIR)TType.$(O) TType.$(H): TType.st $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR) $(OUTDIR)TTypeNode.$(O) TTypeNode.$(H): TTypeNode.st $(INCLUDE_TOP)\stx\goodies\refactoryBrowser\parser\RBProgramNode.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR) $(OUTDIR)TTypeSpecNode.$(O) TTypeSpecNode.$(H): TTypeSpecNode.st $(INCLUDE_TOP)\stx\goodies\refactoryBrowser\parser\RBProgramNode.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR) @@ -108,12 +110,11 @@ $(OUTDIR)TSimpleTypeNode.$(O) TSimpleTypeNode.$(H): TSimpleTypeNode.st $(INCLUDE_TOP)\jv\tea\compiler\TTypeNode.$(H) $(INCLUDE_TOP)\stx\goodies\refactoryBrowser\parser\RBProgramNode.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR) $(OUTDIR)TValueBinding.$(O) TValueBinding.$(H): TValueBinding.st $(INCLUDE_TOP)\jv\tea\compiler\TBinding.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR) $(OUTDIR)TBlockBinding.$(O) TBlockBinding.$(H): TBlockBinding.st $(INCLUDE_TOP)\jv\tea\compiler\TBinding.$(H) $(INCLUDE_TOP)\jv\tea\compiler\TFunctionBinding.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR) -$(OUTDIR)TCodeGenerator.$(O) TCodeGenerator.$(H): TCodeGenerator.st $(INCLUDE_TOP)\jv\tea\compiler\TCompilerPass.$(H) $(INCLUDE_TOP)\jv\tea\compiler\TProgramNodeVisitor.$(H) $(INCLUDE_TOP)\stx\goodies\refactoryBrowser\parser\RBProgramNodeVisitor.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR) $(OUTDIR)TConstantBinding.$(O) TConstantBinding.$(H): TConstantBinding.st $(INCLUDE_TOP)\jv\tea\compiler\TBinding.$(H) $(INCLUDE_TOP)\jv\tea\compiler\TValueBinding.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR) +$(OUTDIR)TLLVMCodeGenerator.$(O) TLLVMCodeGenerator.$(H): TLLVMCodeGenerator.st $(INCLUDE_TOP)\jv\tea\compiler\TCompilerPass.$(H) $(INCLUDE_TOP)\jv\tea\compiler\TProgramNodeVisitor.$(H) $(INCLUDE_TOP)\stx\goodies\refactoryBrowser\parser\RBProgramNodeVisitor.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR) $(OUTDIR)TMethodBinding.$(O) TMethodBinding.$(H): TMethodBinding.st $(INCLUDE_TOP)\jv\tea\compiler\TBinding.$(H) $(INCLUDE_TOP)\jv\tea\compiler\TFunctionBinding.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR) $(OUTDIR)TSemanticAnalyser.$(O) TSemanticAnalyser.$(H): TSemanticAnalyser.st $(INCLUDE_TOP)\jv\tea\compiler\TCompilerPass.$(H) $(INCLUDE_TOP)\jv\tea\compiler\TProgramNodeVisitor.$(H) $(INCLUDE_TOP)\stx\goodies\refactoryBrowser\parser\RBProgramNodeVisitor.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR) $(OUTDIR)TTypechecker.$(O) TTypechecker.$(H): TTypechecker.st $(INCLUDE_TOP)\jv\tea\compiler\TCompilerPass.$(H) $(INCLUDE_TOP)\jv\tea\compiler\TProgramNodeVisitor.$(H) $(INCLUDE_TOP)\stx\goodies\refactoryBrowser\parser\RBProgramNodeVisitor.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR) -$(OUTDIR)TTypeseeder.$(O) TTypeseeder.$(H): TTypeseeder.st $(INCLUDE_TOP)\jv\tea\compiler\TCompilerPass.$(H) $(INCLUDE_TOP)\jv\tea\compiler\TProgramNodeVisitor.$(H) $(INCLUDE_TOP)\stx\goodies\refactoryBrowser\parser\RBProgramNodeVisitor.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR) $(OUTDIR)TVariableBinding.$(O) TVariableBinding.$(H): TVariableBinding.st $(INCLUDE_TOP)\jv\tea\compiler\TBinding.$(H) $(INCLUDE_TOP)\jv\tea\compiler\TValueBinding.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR) $(OUTDIR)TArgumentBinding.$(O) TArgumentBinding.$(H): TArgumentBinding.st $(INCLUDE_TOP)\jv\tea\compiler\TBinding.$(H) $(INCLUDE_TOP)\jv\tea\compiler\TValueBinding.$(H) $(INCLUDE_TOP)\jv\tea\compiler\TVariableBinding.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR) $(OUTDIR)TLocalBinding.$(O) TLocalBinding.$(H): TLocalBinding.st $(INCLUDE_TOP)\jv\tea\compiler\TBinding.$(H) $(INCLUDE_TOP)\jv\tea\compiler\TValueBinding.$(H) $(INCLUDE_TOP)\jv\tea\compiler\TVariableBinding.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR) diff -r eec72263ed75 -r 569bf5707c7e compiler/extensions.st --- a/compiler/extensions.st Mon Sep 14 11:19:10 2015 +0100 +++ b/compiler/extensions.st Mon Sep 14 15:03:03 2015 +0100 @@ -98,6 +98,14 @@ "Created: / 02-09-2015 / 06:30:30 / Jan Vrany " ! ! +!RBProgramNode methodsFor:'testing'! + +isSpecialFormNode + "return false here; to be redefined in subclass(es)" + + ^ false +! ! + !RBProgramNode methodsFor:'accessing'! scope diff -r eec72263ed75 -r 569bf5707c7e compiler/jv_tea_compiler.st --- a/compiler/jv_tea_compiler.st Mon Sep 14 11:19:10 2015 +0100 +++ b/compiler/jv_tea_compiler.st Mon Sep 14 15:03:03 2015 +0100 @@ -32,8 +32,8 @@ ^ #( #'stx:goodies/refactoryBrowser/parser' "RBBlockNode - extended" #'stx:goodies/ring' "RGAbstractContainer - superclass of TCompilationUnitDefinition" - #'stx:goodies/sunit' "TestAsserter - superclass of TCompilerTests" - #'stx:libbasic' "LibraryDefinition - superclass of jv_tea_compiler" + #'stx:goodies/sunit' "TestAsserter - superclass of TCompilerExamples" + #'stx:libbasic' "Error - superclass of TCompilerError" ) ! @@ -78,7 +78,8 @@ TCompilationUnitDefinition TCompiler TCompilerContext - (TCompilerTests autoload) + TCompilerError + (TCompilerExamples autoload) TEnvironmentProvider TFormatter TInlineAssemblyBeginToken @@ -93,12 +94,14 @@ TProgramNodeVisitor TScanner TScope - (TSemanticAnalysisPassTests autoload) + (TSemanticAnalyserTests autoload) TSourceReader (TSourceReaderTests autoload) + TSpecialFormNode TType TTypeNode TTypeSpecNode + (TTypecheckerTests autoload) #'jv_tea_compiler' TBlockType TClassBinding @@ -112,12 +115,11 @@ TSimpleTypeNode TValueBinding TBlockBinding - TCodeGenerator TConstantBinding + TLLVMCodeGenerator TMethodBinding TSemanticAnalyser TTypechecker - TTypeseeder TVariableBinding TArgumentBinding TLocalBinding @@ -151,6 +153,7 @@ RBToken isTInlineAssemblyBegin RBToken isTInlineAssemblyEnd RGDefinition isCompilationUnit + RBProgramNode isSpecialFormNode ) ! ! diff -r eec72263ed75 -r 569bf5707c7e compiler/libInit.cc --- a/compiler/libInit.cc Mon Sep 14 11:19:10 2015 +0100 +++ b/compiler/libInit.cc Mon Sep 14 15:03:03 2015 +0100 @@ -32,6 +32,7 @@ _TCompilationUnitDefinition_Init(pass,__pRT__,snd); _TCompiler_Init(pass,__pRT__,snd); _TCompilerContext_Init(pass,__pRT__,snd); +_TCompilerError_Init(pass,__pRT__,snd); _TEnvironmentProvider_Init(pass,__pRT__,snd); _TFormatter_Init(pass,__pRT__,snd); _TInlineAssemblyBeginToken_Init(pass,__pRT__,snd); @@ -45,6 +46,7 @@ _TScanner_Init(pass,__pRT__,snd); _TScope_Init(pass,__pRT__,snd); _TSourceReader_Init(pass,__pRT__,snd); +_TSpecialFormNode_Init(pass,__pRT__,snd); _TType_Init(pass,__pRT__,snd); _TTypeNode_Init(pass,__pRT__,snd); _TTypeSpecNode_Init(pass,__pRT__,snd); @@ -61,12 +63,11 @@ _TSimpleTypeNode_Init(pass,__pRT__,snd); _TValueBinding_Init(pass,__pRT__,snd); _TBlockBinding_Init(pass,__pRT__,snd); -_TCodeGenerator_Init(pass,__pRT__,snd); _TConstantBinding_Init(pass,__pRT__,snd); +_TLLVMCodeGenerator_Init(pass,__pRT__,snd); _TMethodBinding_Init(pass,__pRT__,snd); _TSemanticAnalyser_Init(pass,__pRT__,snd); _TTypechecker_Init(pass,__pRT__,snd); -_TTypeseeder_Init(pass,__pRT__,snd); _TVariableBinding_Init(pass,__pRT__,snd); _TArgumentBinding_Init(pass,__pRT__,snd); _TLocalBinding_Init(pass,__pRT__,snd);