# HG changeset patch # User Jan Vrany # Date 1442746902 -3600 # Node ID 97090c2baa33fc3f7a9b0995de2c9c6ba5059593 # Parent d716a8181fc1ecd8fc9de0daa3af78bc7673d786 Fixes/refactoring of scopes and bindings. Fixed initialization of scopes and bindings. Make typechecker to seed types. diff -r d716a8181fc1 -r 97090c2baa33 compiler/TArgumentBinding.st --- a/compiler/TArgumentBinding.st Fri Sep 18 06:20:53 2015 +0100 +++ b/compiler/TArgumentBinding.st Sun Sep 20 12:01:42 2015 +0100 @@ -3,7 +3,7 @@ "{ NameSpace: Smalltalk }" TVariableBinding subclass:#TArgumentBinding - instanceVariableNames:'index' + instanceVariableNames:'' classVariableNames:'' poolDictionaries:'' category:'Languages-Tea-Compiler-Bindings' @@ -18,8 +18,8 @@ !TArgumentBinding methodsFor:'initialization'! -index:something - index := something. +index:anInteger + index := anInteger. ! ! !TArgumentBinding methodsFor:'printing & storing'! diff -r d716a8181fc1 -r 97090c2baa33 compiler/TCompilerContext.st --- a/compiler/TCompilerContext.st Fri Sep 18 06:20:53 2015 +0100 +++ b/compiler/TCompilerContext.st Sun Sep 20 12:01:42 2015 +0100 @@ -38,6 +38,13 @@ !TCompilerContext methodsFor:'error reporting'! +reportSemanticError: message + + TCompilerError raiseErrorString: message + + "Created: / 20-09-2015 / 06:13:42 / Jan Vrany " +! + reportTypeError: message TCompilerError raiseErrorString: message diff -r d716a8181fc1 -r 97090c2baa33 compiler/TCompilerExamples.st --- a/compiler/TCompilerExamples.st Fri Sep 18 06:20:53 2015 +0100 +++ b/compiler/TCompilerExamples.st Sun Sep 20 12:01:42 2015 +0100 @@ -19,6 +19,40 @@ !TCompilerExamples methodsFor:'tests'! +example_factorialI + | environment unit compiler| + + environment := TEnvironment new. + unit := TSourceReader read:' +nil subclass: #FactorialI + category: ''t-Examples'' +!! +!!FactorialI class methodsFor:''examples''!! +factorialI:v <^ tSIntegerW> + | result + i | + + result := 0. + i := v. + + [ i > 1 ] whileTrue:[ + result := result * i. + i := i - 1 + ]. + ^ result +!! !! + '. + + compiler := TCompiler new. + compiler compile: unit in: environment. + self halt. + " + compiler context module + " + + "Created: / 19-09-2015 / 18:29:15 / Jan Vrany " +! + example_if | environment unit compiler| diff -r d716a8181fc1 -r 97090c2baa33 compiler/TConstantBinding.st --- a/compiler/TConstantBinding.st Fri Sep 18 06:20:53 2015 +0100 +++ b/compiler/TConstantBinding.st Sun Sep 20 12:01:42 2015 +0100 @@ -12,10 +12,10 @@ !TConstantBinding class methodsFor:'instance creation'! -value: anObject type: aTType - ^ self new initializeWithValue: anObject type: aTType +value: anObject + ^ self new initializeWithValue: anObject - "Created: / 15-09-2015 / 08:19:32 / Jan Vrany " + "Created: / 20-09-2015 / 07:11:25 / Jan Vrany " ! ! !TConstantBinding methodsFor:'accessing'! @@ -37,11 +37,10 @@ !TConstantBinding methodsFor:'initialization'! -initializeWithValue: anObject type: aTType +initializeWithValue: anObject value := anObject. - type := aTType. - "Created: / 15-09-2015 / 08:19:13 / Jan Vrany " + "Created: / 20-09-2015 / 07:11:37 / Jan Vrany " ! ! !TConstantBinding methodsFor:'testing'! diff -r d716a8181fc1 -r 97090c2baa33 compiler/TScope.st --- a/compiler/TScope.st Fri Sep 18 06:20:53 2015 +0100 +++ b/compiler/TScope.st Sun Sep 20 12:01:42 2015 +0100 @@ -37,29 +37,24 @@ parent ^ parent +! + +variables + ^ variables ? #() + + "Modified: / 19-09-2015 / 05:56:30 / Jan Vrany " ! ! -!TScope methodsFor:'initialization'! - -initializeWithNode: n parent: p - node := n. - parent := p. +!TScope methodsFor:'adding & removing'! - "Created: / 25-08-2015 / 22:25:12 / Jan Vrany " -! ! - -!TScope methodsFor:'instance creation'! - -subScope: methodOrBlockNode +addSubScope: aTScope children isNil ifTrue:[ children := OrderedCollection new: 5. ]. - ^ children add: (self class node: methodOrBlockNode parent: self) + children add: aTScope - "Created: / 25-08-2015 / 22:28:02 / Jan Vrany " -! ! - -!TScope methodsFor:'lookup'! + "Created: / 19-09-2015 / 06:05:50 / Jan Vrany " +! addVariable: aTVariableBinding variables isNil ifTrue:[ @@ -68,14 +63,36 @@ variables add: aTVariableBinding "Created: / 25-08-2015 / 22:42:29 / Jan Vrany " -! +! ! + +!TScope methodsFor:'initialization'! + +initializeWithNode: n parent: p + node := n. + parent := p. + parent notNil ifTrue:[ + parent addSubScope: self. + ]. + + "Created: / 25-08-2015 / 22:25:12 / Jan Vrany " + "Modified: / 19-09-2015 / 06:06:27 / Jan Vrany " +! ! + +!TScope methodsFor:'lookup'! lookupVariable: name - ^ variables - detect:[:binding | binding name = name ] - ifNone:[ parent notNil ifTrue:[ parent lookupVariable: name ] ifFalse:[ self error:'variable not found' ] ] + "Return binding for variable with given name or nil if not found" + | variable | + variables notNil ifTrue:[ + variable := variables detect:[:binding | binding name = name ] ifNone:[ nil ]. + ]. + (variable isNil and:[parent notNil]) ifTrue:[ + variable := parent lookupVariable: name. + ]. + ^ variable "Created: / 25-08-2015 / 22:58:18 / Jan Vrany " + "Modified: / 20-09-2015 / 06:11:23 / Jan Vrany " ! ! !TScope methodsFor:'testing'! diff -r d716a8181fc1 -r 97090c2baa33 compiler/TSemanticAnalyser.st --- a/compiler/TSemanticAnalyser.st Fri Sep 18 06:20:53 2015 +0100 +++ b/compiler/TSemanticAnalyser.st Sun Sep 20 12:01:42 2015 +0100 @@ -14,10 +14,9 @@ documentation " 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 bindings * initialize scopes (i.e, assign scopes and populate them - with variables) + with variable bindings) [author:] Jan Vrany @@ -41,13 +40,13 @@ ] ifFalse:[ binding := TArgumentBinding name:anRBVariableNode name. binding index: (anRBVariableNode parent arguments indexOf: anRBVariableNode) - + (currentScope isMethodScope ifTrue:[1] ifFalse:[0]) + + (anRBVariableNode parent scope isMethodScope ifTrue:[1] ifFalse:[0]) ]. anRBVariableNode parent scope addVariable: binding. super visitArgument: anRBVariableNode. "Created: / 25-08-2015 / 22:51:40 / Jan Vrany " - "Modified: / 02-09-2015 / 08:58:32 / Jan Vrany " + "Modified: / 19-09-2015 / 06:17:50 / Jan Vrany " ! ! !TSemanticAnalyser methodsFor:'visitor-double dispatching'! @@ -55,15 +54,15 @@ acceptBlockNode: aBlockNode | scope | aBlockNode parent isSpecialFormNode ifTrue:[ - scope := currentScope subScope: aBlockNode. + scope := TScope node: aBlockNode parent: aBlockNode parent scope ] ifFalse:[ - scope := TScope new. + scope := TScope node: aBlockNode ]. aBlockNode scope: scope. super acceptBlockNode: aBlockNode "Created: / 25-08-2015 / 22:30:21 / Jan Vrany " - "Modified: / 14-09-2015 / 14:04:06 / Jan Vrany " + "Modified: / 19-09-2015 / 06:16:41 / Jan Vrany " ! acceptLiteralNode: aRBLiteralNode @@ -72,7 +71,7 @@ super acceptLiteralNode: aRBLiteralNode. value := aRBLiteralNode value. value isInteger ifTrue:[ - aRBLiteralNode binding: (TConstantBinding value: value type: (context environment binding lookupClassSIntegerW) type). + aRBLiteralNode binding: (TConstantBinding value: value). ^ self. ]. value isBoolean ifTrue:[ @@ -82,7 +81,7 @@ self erorr: 'Unsupported constant'. "Created: / 25-08-2015 / 23:17:30 / Jan Vrany " - "Modified: / 15-09-2015 / 08:27:47 / Jan Vrany " + "Modified: / 20-09-2015 / 07:12:23 / Jan Vrany " ! acceptMethodNode: aMethodNode @@ -102,10 +101,18 @@ ! acceptVariableNode: aVariableNode - aVariableNode binding: (aVariableNode scope lookupVariable: aVariableNode name). + | binding | + + binding := aVariableNode scope lookupVariable: aVariableNode name. + binding isNil ifTrue:[ + context reportSemanticError: ('Undeclared variable %1' bindWith: aVariableNode name). + ^ self. + ]. + aVariableNode binding: binding. super acceptVariableNode: aVariableNode "Created: / 25-08-2015 / 23:00:34 / Jan Vrany " + "Modified: / 20-09-2015 / 06:14:37 / Jan Vrany " ! ! !TSemanticAnalyser class methodsFor:'documentation'! diff -r d716a8181fc1 -r 97090c2baa33 compiler/TSemanticAnalyserTests.st --- a/compiler/TSemanticAnalyserTests.st Fri Sep 18 06:20:53 2015 +0100 +++ b/compiler/TSemanticAnalyserTests.st Sun Sep 20 12:01:42 2015 +0100 @@ -3,21 +3,107 @@ "{ NameSpace: Smalltalk }" TestCase subclass:#TSemanticAnalyserTests - instanceVariableNames:'' + instanceVariableNames:'environment' classVariableNames:'' poolDictionaries:'' category:'Languages-Tea-Compiler-Internals-Tests' ! + +!TSemanticAnalyserTests methodsFor:'running'! + +setUp + super setUp. + environment := TEnvironment new + + "Modified: / 19-09-2015 / 05:54:33 / Jan Vrany " +! + +tearDown + environment := nil. + super tearDown. + + "Modified: / 19-09-2015 / 05:54:47 / Jan Vrany " +! ! + !TSemanticAnalyserTests methodsFor:'tests'! -test_01 +test_bindings_01 + | class method tree | + + class := TClassDefinition newClass name: 'tSIntegerW'. + method := TMethodDefinition class: class selector: 'foo'. + method source: 'foo <^ tSIntegerW> | a | ^ a + 1'. + tree := method parseTree. - "Created: / 29-08-2015 / 14:11:42 / Jan Vrany " + TSemanticAnalyser runOn: tree inEnvironment: environment. + + self assert: tree body temporaries first binding isLocalBinding. + self assert: tree body statements first"^ node" value receiver"a node" binding == tree body temporaries first binding. + self assert: tree body statements first"^ node" value arguments first"1 node" binding isConstantBinding. + + "Created: / 19-09-2015 / 06:33:29 / Jan Vrany " + "Modified: / 19-09-2015 / 18:14:34 / Jan Vrany " ! -test_special_form_01 +test_scopes_01 + | class method tree | + + class := TClassDefinition newClass name: 'TestClass'. + method := TMethodDefinition class: class selector: 'foo'. + method source: 'foo <^ TestClass> self do:[ :each | each ]'. + tree := method parseTree. + + TSemanticAnalyser runOn: tree inEnvironment: environment. + + self assert: tree scope parent isNil. + self assert: tree scope node == tree. + self assert: tree scope children isEmptyOrNil. + self assert: tree scope variables size == 1"self". + self assert: tree body scope == tree scope. + + self assert: tree body statements first arguments first scope parent isNil. "Not an inlined block" + self assert: tree body statements first arguments first scope node == tree body statements first arguments first. + self assert: tree body statements first arguments first scope children isEmptyOrNil. + self assert: tree body statements first arguments first scope variables size == 1"each". + self assert: tree body statements first arguments first scope variables anElement name = 'each'. + + "Created: / 19-09-2015 / 05:53:56 / Jan Vrany " +! - "Created: / 14-09-2015 / 12:54:06 / Jan Vrany " +test_scopes_02 + | class method tree | + + class := TClassDefinition newClass name: 'TestClass'. + method := TMethodDefinition class: class selector: 'foo'. + method source: 'foo <^ TestClass> true ifTrue:[ false ifTrue:[ ] ]'. + tree := method parseTree. + + TSemanticAnalyser runOn: tree inEnvironment: environment. + + self assert: tree scope parent isNil. + self assert: tree scope node == tree. + self assert: tree scope children size == 1"ifTrue: scope". + self assert: tree scope variables size == 1"self". + self assert: tree body scope == tree scope. + + self assert: tree body statements first arguments first scope parent == tree scope. + self assert: tree body statements first arguments first scope node == tree body statements first arguments first. + self assert: tree body statements first arguments first scope children size == 1. + self assert: tree body statements first arguments first scope variables isEmpty. + + self assert: tree body statements first arguments first "outer block" + body statements first arguments first "inner block" scope parent + == + tree body statements first arguments first"outer block" scope. + + "Created: / 19-09-2015 / 06:11:21 / Jan Vrany " ! ! +!TSemanticAnalyserTests class methodsFor:'documentation'! + +version_HG + + ^ '$Changeset: $' +! ! + diff -r d716a8181fc1 -r 97090c2baa33 compiler/TTypechecker.st --- a/compiler/TTypechecker.st Fri Sep 18 06:20:53 2015 +0100 +++ b/compiler/TTypechecker.st Sun Sep 20 12:01:42 2015 +0100 @@ -9,6 +9,19 @@ category:'Languages-Tea-Compiler-Internals' ! +!TTypechecker methodsFor:'visiting'! + +visitArgument: anRBVariableNode + | binding | + + + super visitArgument: anRBVariableNode. + binding := anRBVariableNode binding. + binding type: (anRBVariableNode typeSpec asType) + + "Created: / 20-09-2015 / 07:19:27 / Jan Vrany " +! ! + !TTypechecker methodsFor:'visitor-double dispatching'! acceptIfTrueIfFalseNode: node @@ -38,6 +51,24 @@ "Created: / 14-09-2015 / 14:18:28 / Jan Vrany " ! +acceptLiteralNode: aLiteralNode + | binding value | + + binding := aLiteralNode binding. + value := binding value. + value isInteger ifTrue:[ + binding type: (context environment binding lookupClassSIntegerW) type. + ^ self + ]. + value isBoolean ifTrue:[ + binding type: (context environment binding lookupClassBoolean) type. + ^ self. + ]. + context reportTypeError: 'Unsupported constant type'. + + "Created: / 20-09-2015 / 07:13:45 / Jan Vrany " +! + acceptMessageNode: aMessageNode | receiverType receiverBinding methodBinding | diff -r d716a8181fc1 -r 97090c2baa33 compiler/TVariableBinding.st --- a/compiler/TVariableBinding.st Fri Sep 18 06:20:53 2015 +0100 +++ b/compiler/TVariableBinding.st Sun Sep 20 12:01:42 2015 +0100 @@ -3,7 +3,7 @@ "{ NameSpace: Smalltalk }" TValueBinding subclass:#TVariableBinding - instanceVariableNames:'name' + instanceVariableNames:'name index' classVariableNames:'' poolDictionaries:'' category:'Languages-Tea-Compiler-Bindings'