Fixes/refactoring of scopes and bindings.
authorJan Vrany <jan.vrany@fit.cvut.cz>
Sun, 20 Sep 2015 12:01:42 +0100
changeset 1397090c2baa33
parent 12 d716a8181fc1
child 14 fa42d3f1a578
Fixes/refactoring of scopes and bindings.

Fixed initialization of scopes and bindings. Make
typechecker to seed types.
compiler/TArgumentBinding.st
compiler/TCompilerContext.st
compiler/TCompilerExamples.st
compiler/TConstantBinding.st
compiler/TScope.st
compiler/TSemanticAnalyser.st
compiler/TSemanticAnalyserTests.st
compiler/TTypechecker.st
compiler/TVariableBinding.st
     1.1 --- a/compiler/TArgumentBinding.st	Fri Sep 18 06:20:53 2015 +0100
     1.2 +++ b/compiler/TArgumentBinding.st	Sun Sep 20 12:01:42 2015 +0100
     1.3 @@ -3,7 +3,7 @@
     1.4  "{ NameSpace: Smalltalk }"
     1.5  
     1.6  TVariableBinding subclass:#TArgumentBinding
     1.7 -	instanceVariableNames:'index'
     1.8 +	instanceVariableNames:''
     1.9  	classVariableNames:''
    1.10  	poolDictionaries:''
    1.11  	category:'Languages-Tea-Compiler-Bindings'
    1.12 @@ -18,8 +18,8 @@
    1.13  
    1.14  !TArgumentBinding methodsFor:'initialization'!
    1.15  
    1.16 -index:something
    1.17 -    index := something.
    1.18 +index:anInteger
    1.19 +    index := anInteger.
    1.20  ! !
    1.21  
    1.22  !TArgumentBinding methodsFor:'printing & storing'!
     2.1 --- a/compiler/TCompilerContext.st	Fri Sep 18 06:20:53 2015 +0100
     2.2 +++ b/compiler/TCompilerContext.st	Sun Sep 20 12:01:42 2015 +0100
     2.3 @@ -38,6 +38,13 @@
     2.4  
     2.5  !TCompilerContext methodsFor:'error reporting'!
     2.6  
     2.7 +reportSemanticError: message
     2.8 +
     2.9 +    TCompilerError raiseErrorString: message
    2.10 +
    2.11 +    "Created: / 20-09-2015 / 06:13:42 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    2.12 +!
    2.13 +
    2.14  reportTypeError: message
    2.15  
    2.16      TCompilerError raiseErrorString: message
     3.1 --- a/compiler/TCompilerExamples.st	Fri Sep 18 06:20:53 2015 +0100
     3.2 +++ b/compiler/TCompilerExamples.st	Sun Sep 20 12:01:42 2015 +0100
     3.3 @@ -19,6 +19,40 @@
     3.4  
     3.5  !TCompilerExamples methodsFor:'tests'!
     3.6  
     3.7 +example_factorialI
     3.8 +    | environment unit compiler|
     3.9 +
    3.10 +    environment := TEnvironment new.
    3.11 +    unit := TSourceReader read:'
    3.12 +nil subclass: #FactorialI
    3.13 +    category: ''t-Examples''
    3.14 +!!
    3.15 +!!FactorialI class methodsFor:''examples''!!
    3.16 +factorialI:v <tSIntegerW> <^ tSIntegerW>
    3.17 +    | result <tSIntegerW> 
    3.18 +      i <tSIntegerW> |
    3.19 +
    3.20 +    result := 0.
    3.21 +    i := v.
    3.22 +
    3.23 +    [ i > 1 ] whileTrue:[ 
    3.24 +        result := result * i.
    3.25 +        i := i - 1
    3.26 +    ].
    3.27 +    ^ result
    3.28 +!! !!
    3.29 +    '.
    3.30 +
    3.31 +    compiler := TCompiler new.
    3.32 +    compiler compile: unit in: environment.
    3.33 +    self halt.
    3.34 +    "
    3.35 +    compiler context module
    3.36 +    "
    3.37 +
    3.38 +    "Created: / 19-09-2015 / 18:29:15 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    3.39 +!
    3.40 +
    3.41  example_if
    3.42      | environment unit compiler|
    3.43  
     4.1 --- a/compiler/TConstantBinding.st	Fri Sep 18 06:20:53 2015 +0100
     4.2 +++ b/compiler/TConstantBinding.st	Sun Sep 20 12:01:42 2015 +0100
     4.3 @@ -12,10 +12,10 @@
     4.4  
     4.5  !TConstantBinding class methodsFor:'instance creation'!
     4.6  
     4.7 -value: anObject type: aTType
     4.8 -    ^ self new initializeWithValue: anObject type: aTType
     4.9 +value: anObject
    4.10 +    ^ self new initializeWithValue: anObject
    4.11  
    4.12 -    "Created: / 15-09-2015 / 08:19:32 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    4.13 +    "Created: / 20-09-2015 / 07:11:25 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    4.14  ! !
    4.15  
    4.16  !TConstantBinding methodsFor:'accessing'!
    4.17 @@ -37,11 +37,10 @@
    4.18  
    4.19  !TConstantBinding methodsFor:'initialization'!
    4.20  
    4.21 -initializeWithValue: anObject type: aTType
    4.22 +initializeWithValue: anObject
    4.23      value := anObject.
    4.24 -    type := aTType.
    4.25  
    4.26 -    "Created: / 15-09-2015 / 08:19:13 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    4.27 +    "Created: / 20-09-2015 / 07:11:37 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    4.28  ! !
    4.29  
    4.30  !TConstantBinding methodsFor:'testing'!
     5.1 --- a/compiler/TScope.st	Fri Sep 18 06:20:53 2015 +0100
     5.2 +++ b/compiler/TScope.st	Sun Sep 20 12:01:42 2015 +0100
     5.3 @@ -37,29 +37,24 @@
     5.4  
     5.5  parent
     5.6      ^ parent
     5.7 +!
     5.8 +
     5.9 +variables
    5.10 +    ^ variables ? #()
    5.11 +
    5.12 +    "Modified: / 19-09-2015 / 05:56:30 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    5.13  ! !
    5.14  
    5.15 -!TScope methodsFor:'initialization'!
    5.16 +!TScope methodsFor:'adding & removing'!
    5.17  
    5.18 -initializeWithNode: n parent: p
    5.19 -    node := n.
    5.20 -    parent := p.
    5.21 -
    5.22 -    "Created: / 25-08-2015 / 22:25:12 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    5.23 -! !
    5.24 -
    5.25 -!TScope methodsFor:'instance creation'!
    5.26 -
    5.27 -subScope: methodOrBlockNode
    5.28 +addSubScope: aTScope
    5.29      children isNil ifTrue:[ 
    5.30          children := OrderedCollection new: 5.
    5.31      ].
    5.32 -    ^ children add: (self class node: methodOrBlockNode parent: self)
    5.33 +    children add: aTScope
    5.34  
    5.35 -    "Created: / 25-08-2015 / 22:28:02 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    5.36 -! !
    5.37 -
    5.38 -!TScope methodsFor:'lookup'!
    5.39 +    "Created: / 19-09-2015 / 06:05:50 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    5.40 +!
    5.41  
    5.42  addVariable: aTVariableBinding
    5.43      variables isNil ifTrue:[ 
    5.44 @@ -68,14 +63,36 @@
    5.45      variables add: aTVariableBinding
    5.46  
    5.47      "Created: / 25-08-2015 / 22:42:29 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    5.48 -!
    5.49 +! !
    5.50 +
    5.51 +!TScope methodsFor:'initialization'!
    5.52 +
    5.53 +initializeWithNode: n parent: p
    5.54 +    node := n.
    5.55 +    parent := p.
    5.56 +    parent notNil ifTrue:[ 
    5.57 +        parent addSubScope: self.  
    5.58 +    ].
    5.59 +
    5.60 +    "Created: / 25-08-2015 / 22:25:12 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    5.61 +    "Modified: / 19-09-2015 / 06:06:27 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    5.62 +! !
    5.63 +
    5.64 +!TScope methodsFor:'lookup'!
    5.65  
    5.66  lookupVariable: name
    5.67 -    ^ variables 
    5.68 -        detect:[:binding |  binding name = name ] 
    5.69 -        ifNone:[ parent notNil ifTrue:[ parent lookupVariable: name ] ifFalse:[ self error:'variable not found' ] ]
    5.70 +    "Return binding for variable with given name or nil if not found"
    5.71 +    | variable |
    5.72 +    variables notNil ifTrue:[ 
    5.73 +        variable := variables detect:[:binding |  binding name = name ] ifNone:[ nil ].
    5.74 +    ].
    5.75 +    (variable isNil and:[parent notNil]) ifTrue:[
    5.76 +        variable := parent lookupVariable: name.  
    5.77 +    ].
    5.78 +    ^ variable
    5.79  
    5.80      "Created: / 25-08-2015 / 22:58:18 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    5.81 +    "Modified: / 20-09-2015 / 06:11:23 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    5.82  ! !
    5.83  
    5.84  !TScope methodsFor:'testing'!
     6.1 --- a/compiler/TSemanticAnalyser.st	Fri Sep 18 06:20:53 2015 +0100
     6.2 +++ b/compiler/TSemanticAnalyser.st	Sun Sep 20 12:01:42 2015 +0100
     6.3 @@ -14,10 +14,9 @@
     6.4  documentation
     6.5  "
     6.6      This is the very first pass on the code. Its responsibility is:
     6.7 -    * initialize bindings including types (except for message sends as those
     6.8 -      depends on type analysis)
     6.9 +    * initialize bindings 
    6.10      * initialize scopes (i.e, assign scopes and populate them
    6.11 -      with variables)
    6.12 +      with variable bindings)
    6.13  
    6.14      [author:]
    6.15          Jan Vrany <jan.vrany@fit.cvut.cz>
    6.16 @@ -41,13 +40,13 @@
    6.17      ] ifFalse:[ 
    6.18          binding := TArgumentBinding name:anRBVariableNode name.
    6.19          binding index: (anRBVariableNode parent arguments indexOf: anRBVariableNode)                                
    6.20 -                       + (currentScope isMethodScope ifTrue:[1] ifFalse:[0])     
    6.21 +                       + (anRBVariableNode parent scope isMethodScope ifTrue:[1] ifFalse:[0])     
    6.22      ].
    6.23      anRBVariableNode parent scope addVariable: binding.
    6.24      super visitArgument: anRBVariableNode.
    6.25  
    6.26      "Created: / 25-08-2015 / 22:51:40 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    6.27 -    "Modified: / 02-09-2015 / 08:58:32 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    6.28 +    "Modified: / 19-09-2015 / 06:17:50 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    6.29  ! !
    6.30  
    6.31  !TSemanticAnalyser methodsFor:'visitor-double dispatching'!
    6.32 @@ -55,15 +54,15 @@
    6.33  acceptBlockNode: aBlockNode
    6.34      | scope |
    6.35      aBlockNode parent isSpecialFormNode ifTrue:[ 
    6.36 -        scope := currentScope subScope: aBlockNode.
    6.37 +        scope := TScope node: aBlockNode parent: aBlockNode parent scope
    6.38      ] ifFalse:[ 
    6.39 -        scope := TScope new.
    6.40 +        scope := TScope node: aBlockNode
    6.41      ].
    6.42      aBlockNode scope: scope.
    6.43      super acceptBlockNode: aBlockNode
    6.44  
    6.45      "Created: / 25-08-2015 / 22:30:21 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    6.46 -    "Modified: / 14-09-2015 / 14:04:06 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    6.47 +    "Modified: / 19-09-2015 / 06:16:41 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    6.48  !
    6.49  
    6.50  acceptLiteralNode: aRBLiteralNode
    6.51 @@ -72,7 +71,7 @@
    6.52      super acceptLiteralNode: aRBLiteralNode.
    6.53      value := aRBLiteralNode value.
    6.54      value isInteger ifTrue:[ 
    6.55 -        aRBLiteralNode binding: (TConstantBinding value: value type: (context environment binding lookupClassSIntegerW) type).
    6.56 +        aRBLiteralNode binding: (TConstantBinding value: value).
    6.57          ^ self.
    6.58      ].
    6.59      value isBoolean ifTrue:[ 
    6.60 @@ -82,7 +81,7 @@
    6.61      self erorr: 'Unsupported constant'.
    6.62  
    6.63      "Created: / 25-08-2015 / 23:17:30 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    6.64 -    "Modified: / 15-09-2015 / 08:27:47 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    6.65 +    "Modified: / 20-09-2015 / 07:12:23 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    6.66  !
    6.67  
    6.68  acceptMethodNode: aMethodNode
    6.69 @@ -102,10 +101,18 @@
    6.70  !
    6.71  
    6.72  acceptVariableNode: aVariableNode
    6.73 -    aVariableNode binding: (aVariableNode scope lookupVariable: aVariableNode name).
    6.74 +    | binding |
    6.75 +
    6.76 +    binding := aVariableNode scope lookupVariable: aVariableNode name.      
    6.77 +    binding isNil ifTrue:[ 
    6.78 +        context reportSemanticError: ('Undeclared variable %1' bindWith: aVariableNode name).
    6.79 +        ^ self.
    6.80 +    ].
    6.81 +    aVariableNode binding: binding.
    6.82      super acceptVariableNode: aVariableNode
    6.83  
    6.84      "Created: / 25-08-2015 / 23:00:34 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    6.85 +    "Modified: / 20-09-2015 / 06:14:37 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    6.86  ! !
    6.87  
    6.88  !TSemanticAnalyser class methodsFor:'documentation'!
     7.1 --- a/compiler/TSemanticAnalyserTests.st	Fri Sep 18 06:20:53 2015 +0100
     7.2 +++ b/compiler/TSemanticAnalyserTests.st	Sun Sep 20 12:01:42 2015 +0100
     7.3 @@ -3,21 +3,107 @@
     7.4  "{ NameSpace: Smalltalk }"
     7.5  
     7.6  TestCase subclass:#TSemanticAnalyserTests
     7.7 -	instanceVariableNames:''
     7.8 +	instanceVariableNames:'environment'
     7.9  	classVariableNames:''
    7.10  	poolDictionaries:''
    7.11  	category:'Languages-Tea-Compiler-Internals-Tests'
    7.12  !
    7.13  
    7.14 +
    7.15 +!TSemanticAnalyserTests methodsFor:'running'!
    7.16 +
    7.17 +setUp
    7.18 +    super setUp.
    7.19 +    environment := TEnvironment new
    7.20 +
    7.21 +    "Modified: / 19-09-2015 / 05:54:33 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    7.22 +!
    7.23 +
    7.24 +tearDown
    7.25 +    environment := nil.
    7.26 +    super tearDown.
    7.27 +
    7.28 +    "Modified: / 19-09-2015 / 05:54:47 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    7.29 +! !
    7.30 +
    7.31  !TSemanticAnalyserTests methodsFor:'tests'!
    7.32  
    7.33 -test_01
    7.34 +test_bindings_01
    7.35 +    | class method tree |
    7.36  
    7.37 -    "Created: / 29-08-2015 / 14:11:42 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    7.38 +    class := TClassDefinition newClass name: 'tSIntegerW'.
    7.39 +    method := TMethodDefinition class: class selector: 'foo'.
    7.40 +    method source: 'foo <^ tSIntegerW> | a <tSIntegerW> | ^ a + 1'.
    7.41 +    tree := method parseTree.
    7.42 +
    7.43 +    TSemanticAnalyser runOn: tree inEnvironment: environment.
    7.44 +
    7.45 +    self assert: tree body temporaries first binding isLocalBinding.
    7.46 +    self assert: tree body statements first"^ node" value receiver"a node" binding == tree body temporaries first binding.
    7.47 +    self assert: tree body statements first"^ node" value arguments first"1 node" binding isConstantBinding.
    7.48 +
    7.49 +    "Created: / 19-09-2015 / 06:33:29 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    7.50 +    "Modified: / 19-09-2015 / 18:14:34 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    7.51  !
    7.52  
    7.53 -test_special_form_01
    7.54 +test_scopes_01
    7.55 +    | class method tree |
    7.56  
    7.57 -    "Created: / 14-09-2015 / 12:54:06 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    7.58 +    class := TClassDefinition newClass name: 'TestClass'.
    7.59 +    method := TMethodDefinition class: class selector: 'foo'.
    7.60 +    method source: 'foo <^ TestClass> self do:[ :each <tSIntegerW> | each ]'.
    7.61 +    tree := method parseTree.
    7.62 +
    7.63 +    TSemanticAnalyser runOn: tree inEnvironment: environment.
    7.64 +
    7.65 +    self assert: tree scope parent isNil.
    7.66 +    self assert: tree scope node == tree.
    7.67 +    self assert: tree scope children isEmptyOrNil.
    7.68 +    self assert: tree scope variables size == 1"self".
    7.69 +    self assert: tree body scope == tree scope.
    7.70 +
    7.71 +    self assert: tree body statements first arguments first scope parent isNil. "Not an inlined block"
    7.72 +    self assert: tree body statements first arguments first scope node == tree body statements first arguments first.
    7.73 +    self assert: tree body statements first arguments first scope children isEmptyOrNil.
    7.74 +    self assert: tree body statements first arguments first scope variables size == 1"each".
    7.75 +    self assert: tree body statements first arguments first scope variables anElement name = 'each'.
    7.76 +
    7.77 +    "Created: / 19-09-2015 / 05:53:56 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    7.78 +!
    7.79 +
    7.80 +test_scopes_02
    7.81 +    | class method tree |
    7.82 +
    7.83 +    class := TClassDefinition newClass name: 'TestClass'.
    7.84 +    method := TMethodDefinition class: class selector: 'foo'.
    7.85 +    method source: 'foo <^ TestClass> true ifTrue:[ false ifTrue:[ ] ]'.
    7.86 +    tree := method parseTree.
    7.87 +
    7.88 +    TSemanticAnalyser runOn: tree inEnvironment: environment.
    7.89 +
    7.90 +    self assert: tree scope parent isNil.
    7.91 +    self assert: tree scope node == tree.
    7.92 +    self assert: tree scope children size == 1"ifTrue: scope".
    7.93 +    self assert: tree scope variables size == 1"self".
    7.94 +    self assert: tree body scope == tree scope.
    7.95 +
    7.96 +    self assert: tree body statements first arguments first scope parent == tree scope. 
    7.97 +    self assert: tree body statements first arguments first scope node == tree body statements first arguments first.
    7.98 +    self assert: tree body statements first arguments first scope children size == 1.
    7.99 +    self assert: tree body statements first arguments first scope variables isEmpty.
   7.100 +
   7.101 +    self assert: tree body statements first arguments first "outer block"
   7.102 +                      body statements first arguments first "inner block" scope parent 
   7.103 +                 ==
   7.104 +                 tree body statements first arguments first"outer block" scope.
   7.105 +
   7.106 +    "Created: / 19-09-2015 / 06:11:21 / Jan Vrany <jan.vrany@fit.cvut.cz>"
   7.107  ! !
   7.108  
   7.109 +!TSemanticAnalyserTests class methodsFor:'documentation'!
   7.110 +
   7.111 +version_HG
   7.112 +
   7.113 +    ^ '$Changeset: <not expanded> $'
   7.114 +! !
   7.115 +
     8.1 --- a/compiler/TTypechecker.st	Fri Sep 18 06:20:53 2015 +0100
     8.2 +++ b/compiler/TTypechecker.st	Sun Sep 20 12:01:42 2015 +0100
     8.3 @@ -9,6 +9,19 @@
     8.4  	category:'Languages-Tea-Compiler-Internals'
     8.5  !
     8.6  
     8.7 +!TTypechecker methodsFor:'visiting'!
     8.8 +
     8.9 +visitArgument: anRBVariableNode
    8.10 +    | binding |
    8.11 +
    8.12 +
    8.13 +    super visitArgument: anRBVariableNode.
    8.14 +    binding := anRBVariableNode binding.
    8.15 +    binding type: (anRBVariableNode typeSpec asType)
    8.16 +
    8.17 +    "Created: / 20-09-2015 / 07:19:27 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    8.18 +! !
    8.19 +
    8.20  !TTypechecker methodsFor:'visitor-double dispatching'!
    8.21  
    8.22  acceptIfTrueIfFalseNode: node
    8.23 @@ -38,6 +51,24 @@
    8.24      "Created: / 14-09-2015 / 14:18:28 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    8.25  !
    8.26  
    8.27 +acceptLiteralNode: aLiteralNode
    8.28 +    | binding value |
    8.29 +
    8.30 +    binding := aLiteralNode binding.
    8.31 +    value := binding value.
    8.32 +    value isInteger ifTrue:[ 
    8.33 +        binding type: (context environment binding lookupClassSIntegerW) type.
    8.34 +        ^ self
    8.35 +    ].
    8.36 +    value isBoolean ifTrue:[ 
    8.37 +        binding type: (context environment binding lookupClassBoolean) type.
    8.38 +        ^ self.
    8.39 +    ].
    8.40 +    context reportTypeError: 'Unsupported constant type'.
    8.41 +
    8.42 +    "Created: / 20-09-2015 / 07:13:45 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    8.43 +!
    8.44 +
    8.45  acceptMessageNode: aMessageNode 
    8.46      | receiverType receiverBinding methodBinding |
    8.47  
     9.1 --- a/compiler/TVariableBinding.st	Fri Sep 18 06:20:53 2015 +0100
     9.2 +++ b/compiler/TVariableBinding.st	Sun Sep 20 12:01:42 2015 +0100
     9.3 @@ -3,7 +3,7 @@
     9.4  "{ NameSpace: Smalltalk }"
     9.5  
     9.6  TValueBinding subclass:#TVariableBinding
     9.7 -	instanceVariableNames:'name'
     9.8 +	instanceVariableNames:'name index'
     9.9  	classVariableNames:''
    9.10  	poolDictionaries:''
    9.11  	category:'Languages-Tea-Compiler-Bindings'