SystemOrganization addCategory: #'AST-Semantic'! SystemOrganization addCategory: #'AST-Semantic-Scope'! SystemOrganization addCategory: #'AST-Semantic-Binding'! SystemOrganization addCategory: #'AST-Semantic-Tests'! RBProgramNodeVisitor subclass: #RBSemanticAnnotator instanceVariableNames: 'scope' classVariableNames: '' poolDictionaries: '' category: 'AST-Semantic'! !RBSemanticAnnotator methodsFor: 'visitor-dispatching' stamp: 'lr 4/27/2010 15:29'! acceptBlockNode: aNode self scope: aNode with: RBBlockScope during: [ super acceptBlockNode: aNode ]! ! !RBSemanticAnnotator methodsFor: 'visitor-dispatching' stamp: 'lr 4/27/2010 15:27'! acceptMethodNode: aNode self scope: aNode with: RBMethodScope during: [ super acceptMethodNode: aNode ]! ! !RBSemanticAnnotator methodsFor: 'visitor-dispatching' stamp: 'lr 4/27/2010 15:40'! acceptSequenceNode: aNode aNode temporaries do: [ :each | scope add: (RBTemporaryBinding node: each) ]. aNode statements do: [ :each | self visitNode: each ]! ! !RBSemanticAnnotator methodsFor: 'visitor-dispatching' stamp: 'lr 4/27/2010 15:39'! acceptVariableNode: aNode | binding | binding := scope lookup: aNode name ifAbsent: [ RBUndeclaredBinding node: aNode ]. (aNode parent notNil and: [ aNode parent isAssignment and: [ aNode parent variable == aNode ] ]) ifTrue: [ binding addWriter: aNode ] ifFalse: [ binding addReader: aNode ]! ! !RBSemanticAnnotator methodsFor: 'private' stamp: 'lr 4/27/2010 15:10'! scope: aNode with: aClass during: aBlock scope := aClass owner: scope node: aNode. ^ aBlock ensure: [ scope := scope owner ]! ! !RBSemanticAnnotator methodsFor: 'visiting' stamp: 'lr 4/27/2010 15:10'! start: aProgramNode class: aBehavior ^ self start: aProgramNode root: (RBVariableScope owner: (RBLiteralScope owner: RBRootScope new class: aBehavior) class: aBehavior)! ! !RBSemanticAnnotator methodsFor: 'visiting' stamp: 'lr 4/27/2010 15:10'! start: aProgramNode root: aLexicalScope scope := aLexicalScope. self visitNode: aProgramNode. ^ aProgramNode! ! !RBSemanticAnnotator methodsFor: 'visiting' stamp: 'lr 4/27/2010 15:34'! visitArgument: aNode scope add: (RBArgumentBinding node: aNode)! ! Object subclass: #RBLexicalScope instanceVariableNames: 'owner bindings' classVariableNames: '' poolDictionaries: '' category: 'AST-Semantic-Scope'! RBLexicalScope subclass: #RBClassScope instanceVariableNames: 'class' classVariableNames: '' poolDictionaries: '' category: 'AST-Semantic-Scope'! !RBClassScope class methodsFor: 'instance creation' stamp: 'lr 4/27/2010 13:48'! owner: anOwner class: aBehavior ^ (self owner: anOwner) setClass: aBehavior! ! !RBClassScope methodsFor: 'initialization' stamp: 'lr 4/27/2010 13:48'! setClass: aBehavior class := aBehavior! ! !RBClassScope methodsFor: 'accessing' stamp: 'lr 4/27/2010 13:48'! theClass ^ class! ! RBClassScope subclass: #RBLiteralScope instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'AST-Semantic-Scope'! !RBLiteralScope methodsFor: 'private' stamp: 'lr 4/27/2010 15:41'! basicBindingOf: aString ^ (class bindingOf: aString) ifNotNil: [ :binding | RBLiteralBinding binding: binding ]! ! RBClassScope subclass: #RBVariableScope instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'AST-Semantic-Scope'! !RBVariableScope methodsFor: 'initialization' stamp: 'lr 4/27/2010 15:21'! setClass: aClass super setClass: aClass. aClass allInstVarNames keysAndValuesDo: [ :index :name | self add: (RBInstanceBinding name: name index: index) ]! ! !RBLexicalScope class methodsFor: 'instance creation' stamp: 'lr 4/27/2010 13:28'! owner: anOwner ^ self basicNew initializeOwner: anOwner! ! !RBLexicalScope methodsFor: 'adding' stamp: 'lr 4/27/2010 14:16'! add: aVariableBinding bindings at: aVariableBinding name put: (aVariableBinding setScope: self)! ! !RBLexicalScope methodsFor: 'private' stamp: 'lr 4/27/2010 15:15'! basicBindingOf: aString ^ nil! ! !RBLexicalScope methodsFor: 'querying' stamp: 'lr 4/27/2010 15:14'! bindingOf: aString "Answer the local binding of aString or nil." | binding | bindings at: aString ifPresent: [ :value | ^ value ]. binding := (self basicBindingOf: aString) ifNil: [ ^ nil ]. ^ bindings at: aString put: (binding setScope: self)! ! !RBLexicalScope methodsFor: 'initialization' stamp: 'lr 4/27/2010 14:05'! initialize bindings := Dictionary new! ! !RBLexicalScope methodsFor: 'initialization' stamp: 'lr 4/27/2010 14:04'! initializeOwner: anOwner self initialize. owner := anOwner! ! !RBLexicalScope methodsFor: 'querying' stamp: 'lr 4/27/2010 15:14'! lookup: aString "Lookup the variable aString in the receiving scope, throw an error if not found." ^ self lookup: aString ifAbsent: [ self error: 'No binding for ' , aString printString , ' found.' ]! ! !RBLexicalScope methodsFor: 'querying' stamp: 'lr 4/27/2010 15:15'! lookup: aString ifAbsent: aBlock "Lookup the variable aString in the receiving scope, evaluate aBlock if not found." | binding | ^ (binding := self bindingOf: aString) isNil ifFalse: [ binding ] ifTrue: [ owner isNil ifTrue: [ aBlock value ] ifFalse: [ owner lookup: aString ifAbsent: aBlock ] ]! ! !RBLexicalScope methodsFor: 'accessing' stamp: 'lr 4/27/2010 13:23'! owner "Answer the owning scope." ^ owner! ! RBLexicalScope subclass: #RBNodeScope instanceVariableNames: 'node' classVariableNames: '' poolDictionaries: '' category: 'AST-Semantic-Scope'! RBNodeScope subclass: #RBBlockScope instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'AST-Semantic-Scope'! RBNodeScope subclass: #RBMethodScope instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'AST-Semantic-Scope'! !RBNodeScope class methodsFor: 'instance creation' stamp: 'lr 4/27/2010 13:28'! owner: anOwner node: aProgramNode ^ (self owner: anOwner) setNode: aProgramNode! ! !RBNodeScope methodsFor: 'accessing' stamp: 'lr 4/27/2010 13:29'! node "Answer the program node that defines this scope." ^ node! ! !RBNodeScope methodsFor: 'initialization' stamp: 'lr 4/27/2010 15:19'! setNode: aProgramNode node := aProgramNode. node propertyAt: #lexicalScope put: self! ! RBLexicalScope subclass: #RBRootScope instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'AST-Semantic-Scope'! !RBRootScope methodsFor: 'initialization' stamp: 'lr 4/27/2010 14:35'! initialize super initialize. self add: RBSelfBinding new. self add: RBSuperBinding new. self add: RBContextBinding new! ! !RBRootScope methodsFor: 'querying' stamp: 'lr 4/27/2010 14:10'! lookup: aString ifAbsent: aBlock ^ bindings at: aString ifAbsent: aBlock! ! Object subclass: #RBVariableBinding instanceVariableNames: 'scope readers writers' classVariableNames: '' poolDictionaries: '' category: 'AST-Semantic-Binding'! RBVariableBinding subclass: #RBInstanceBinding instanceVariableNames: 'name index' classVariableNames: '' poolDictionaries: '' category: 'AST-Semantic-Binding'! !RBInstanceBinding class methodsFor: 'instance creation' stamp: 'lr 4/27/2010 14:29'! name: aString index: anInteger ^ self new initializeName: aString index: anInteger! ! !RBInstanceBinding methodsFor: 'accessing' stamp: 'lr 4/27/2010 14:14'! index ^ index! ! !RBInstanceBinding methodsFor: 'initialization' stamp: 'lr 4/27/2010 14:15'! initializeName: aString index: anInteger name := aString. index := anInteger! ! !RBInstanceBinding methodsFor: 'accessing' stamp: 'lr 4/27/2010 14:14'! name ^ name! ! RBVariableBinding subclass: #RBLiteralBinding instanceVariableNames: 'binding' classVariableNames: '' poolDictionaries: '' category: 'AST-Semantic-Binding'! !RBLiteralBinding class methodsFor: 'instance creation' stamp: 'lr 4/27/2010 14:58'! binding: aBinding ^ self new initializeBinding: aBinding! ! !RBLiteralBinding methodsFor: 'accessing' stamp: 'lr 4/27/2010 14:57'! binding ^ binding! ! !RBLiteralBinding methodsFor: 'initialization' stamp: 'lr 4/27/2010 14:58'! initializeBinding: aBinding binding := aBinding! ! !RBLiteralBinding methodsFor: 'accessing' stamp: 'lr 4/27/2010 14:57'! name ^ binding key asString! ! RBVariableBinding subclass: #RBNodeBinding instanceVariableNames: 'node' classVariableNames: '' poolDictionaries: '' category: 'AST-Semantic-Binding'! RBNodeBinding subclass: #RBArgumentBinding instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'AST-Semantic-Binding'! !RBArgumentBinding methodsFor: 'testing' stamp: 'lr 4/27/2010 15:28'! isReadonly ^ true! ! !RBNodeBinding class methodsFor: 'instance creation' stamp: 'lr 4/27/2010 14:07'! node: aNode ^ self new setNode: aNode! ! !RBNodeBinding methodsFor: 'accessing' stamp: 'lr 4/27/2010 14:36'! name ^ node name! ! !RBNodeBinding methodsFor: 'accessing' stamp: 'lr 4/27/2010 13:59'! node "Answer the declaring or defining node." ^ node! ! !RBNodeBinding methodsFor: 'initialization' stamp: 'lr 4/27/2010 15:31'! setNode: aNode node := aNode. node propertyAt: #variableBinding put: self! ! RBNodeBinding subclass: #RBTemporaryBinding instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'AST-Semantic-Binding'! RBNodeBinding subclass: #RBUndeclaredBinding instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'AST-Semantic-Binding'! RBVariableBinding subclass: #RBSpecialBinding instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'AST-Semantic-Binding'! RBSpecialBinding subclass: #RBContextBinding instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'AST-Semantic-Binding'! !RBContextBinding methodsFor: 'accessing' stamp: 'lr 4/27/2010 14:34'! name ^ 'thisContext'! ! RBSpecialBinding subclass: #RBSelfBinding instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'AST-Semantic-Binding'! !RBSelfBinding methodsFor: 'accessing' stamp: 'lr 4/27/2010 14:34'! name ^ 'self'! ! !RBSpecialBinding methodsFor: 'testing' stamp: 'lr 4/27/2010 14:35'! isReadonly ^ true! ! RBSpecialBinding subclass: #RBSuperBinding instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'AST-Semantic-Binding'! !RBSuperBinding methodsFor: 'accessing' stamp: 'lr 4/27/2010 14:34'! name ^ 'super'! ! !RBVariableBinding class methodsFor: 'instance creation' stamp: 'lr 4/27/2010 14:07'! new ^ self basicNew initialize! ! !RBVariableBinding methodsFor: 'adding' stamp: 'lr 4/27/2010 15:32'! addReader: aProgramNode readers := readers copyWith: aProgramNode. aProgramNode propertyAt: #variableBinding put: self! ! !RBVariableBinding methodsFor: 'adding' stamp: 'lr 4/27/2010 15:33'! addWriter: aProgramNode writers := writers copyWith: aProgramNode. aProgramNode propertyAt: #variableBinding put: self! ! !RBVariableBinding methodsFor: 'initialization' stamp: 'lr 4/27/2010 14:00'! initialize readers := writers := #()! ! !RBVariableBinding methodsFor: 'testing' stamp: 'lr 4/27/2010 14:35'! isReadonly "Answer if the receiving binding is readonly." ^ false! ! !RBVariableBinding methodsFor: 'accessing' stamp: 'lr 4/27/2010 14:30'! name "Answer the name of the variable." self subclassResponsibility! ! !RBVariableBinding methodsFor: 'printing' stamp: 'lr 4/27/2010 14:30'! printOn: aStream super printOn: aStream. aStream nextPutAll: ' name: '; print: self name! ! !RBVariableBinding methodsFor: 'accessing' stamp: 'lr 4/27/2010 14:00'! readers "Answer the nodes that read from the receiver." ^ readers! ! !RBVariableBinding methodsFor: 'accessing' stamp: 'lr 4/27/2010 14:06'! scope "Answer the owning scope." ^ scope! ! !RBVariableBinding methodsFor: 'initialization' stamp: 'lr 4/27/2010 14:06'! setScope: aLexicalScope scope := aLexicalScope! ! !RBVariableBinding methodsFor: 'accessing' stamp: 'lr 4/27/2010 14:00'! writers "Answer the nodes that write to the receiver." ^ writers! ! !RBVariableNode methodsFor: '*ast-semantic-accessing' stamp: 'lr 4/27/2010 15:31'! variableBinding ^ self propertyAt: #variableBinding ifAbsent: [ nil ]! ! !RBProgramNode methodsFor: '*ast-semantic-accessing' stamp: 'lr 4/27/2010 13:31'! lexicalScope ^ self propertyAt: #lexicalScope ifAbsent: [ self parent ifFalse: [ self parent lexicalScope ] ]! ! TestCase subclass: #RBSemanticTest instanceVariableNames: 'instVar' classVariableNames: 'ClassVar' poolDictionaries: '' category: 'AST-Semantic-Tests'! !RBSemanticTest class methodsFor: 'accessing' stamp: 'lr 4/27/2010 16:17'! packageNamesUnderTest ^ #('AST-Semantic')! ! !RBSemanticTest methodsFor: 'utilities' stamp: 'lr 4/27/2010 16:11'! parseExpression: aString ^ RBSemanticAnnotator new start: (RBParser parseExpression: aString) class: self class! ! !RBSemanticTest methodsFor: 'utilities' stamp: 'lr 4/27/2010 16:11'! parseMethod: aString ^ RBSemanticAnnotator new start: (RBParser parseMethod: aString) class: self class! ! !RBSemanticTest methodsFor: 'testing-bindings' stamp: 'lr 4/27/2010 16:34'! testBlockArgumentBinding | tree | tree := self parseExpression: '[ :arg | arg ]'. self assert: tree arguments first variableBinding class = RBArgumentBinding. self assert: tree arguments first variableBinding isReadonly. self assert: tree arguments first variableBinding name = 'arg'. self assert: tree arguments first variableBinding node == tree arguments first. self assert: tree arguments first variableBinding == tree body statements first variableBinding. self assert: tree arguments first variableBinding writers isEmpty. self assert: tree arguments first variableBinding readers size = 1. self assert: tree arguments first variableBinding readers first == tree body statements first. self assert: tree arguments first variableBinding scope == tree lexicalScope. self assert: tree arguments first variableBinding scope node == tree! ! !RBSemanticTest methodsFor: 'testing-bindings' stamp: 'lr 4/27/2010 16:36'! testClassVariableBinding | tree | tree := self parseExpression: 'ClassVar'. self assert: tree variableBinding class = RBLiteralBinding. self assert: tree variableBinding name = 'ClassVar'. self assert: tree variableBinding binding = (self class bindingOf: 'ClassVar'). self deny: tree variableBinding isReadonly. self assert: tree variableBinding writers isEmpty. self assert: tree variableBinding readers size = 1. self assert: tree variableBinding readers first == tree. self assert: tree variableBinding scope class = RBLiteralScope. self assert: tree variableBinding scope theClass = self class! ! !RBSemanticTest methodsFor: 'testing-bindings' stamp: 'lr 4/27/2010 16:30'! testContxtBinding | tree | tree := self parseExpression: 'thisContext'. self assert: tree variableBinding class = RBContextBinding. self assert: tree variableBinding name = 'thisContext'. self assert: tree variableBinding isReadonly. self assert: tree variableBinding writers isEmpty. self assert: tree variableBinding readers size = 1. self assert: tree variableBinding readers first == tree. self assert: tree variableBinding scope class = RBRootScope! ! !RBSemanticTest methodsFor: 'testing-bindings' stamp: 'lr 4/27/2010 16:36'! testGlobalVariableBinding | tree | tree := self parseExpression: self class name. self assert: tree variableBinding class = RBLiteralBinding. self assert: tree variableBinding name = self class name. self assert: tree variableBinding binding = self class binding. self deny: tree variableBinding isReadonly. self assert: tree variableBinding writers isEmpty. self assert: tree variableBinding readers size = 1. self assert: tree variableBinding readers first == tree. self assert: tree variableBinding scope class = RBLiteralScope. self assert: tree variableBinding scope theClass = self class! ! !RBSemanticTest methodsFor: 'testing-bindings' stamp: 'lr 4/27/2010 16:34'! testInstanceVariableBinding | tree | tree := self parseExpression: 'instVar'. self assert: tree variableBinding class = RBInstanceBinding. self assert: tree variableBinding name = 'instVar'. self assert: tree variableBinding index = 2. self deny: tree variableBinding isReadonly. self assert: tree variableBinding writers isEmpty. self assert: tree variableBinding readers size = 1. self assert: tree variableBinding readers first == tree. self assert: tree variableBinding scope class = RBVariableScope. self assert: tree variableBinding scope theClass = self class! ! !RBSemanticTest methodsFor: 'testing-bindings' stamp: 'lr 4/27/2010 16:34'! testMethodArgumentBinding | tree | tree := self parseMethod: 'foo: arg arg'. self assert: tree arguments first variableBinding class = RBArgumentBinding. self assert: tree arguments first variableBinding isReadonly. self assert: tree arguments first variableBinding name = 'arg'. self assert: tree arguments first variableBinding node == tree arguments first. self assert: tree arguments first variableBinding == tree body statements first variableBinding. self assert: tree arguments first variableBinding writers isEmpty. self assert: tree arguments first variableBinding readers size = 1. self assert: tree arguments first variableBinding readers first == tree body statements first. self assert: tree arguments first variableBinding scope == tree lexicalScope. self assert: tree arguments first variableBinding scope node == tree! ! !RBSemanticTest methodsFor: 'testing-bindings' stamp: 'lr 4/27/2010 16:30'! testSelfBinding | tree | tree := self parseExpression: 'self'. self assert: tree variableBinding class = RBSelfBinding. self assert: tree variableBinding name = 'self'. self assert: tree variableBinding isReadonly. self assert: tree variableBinding writers isEmpty. self assert: tree variableBinding readers size = 1. self assert: tree variableBinding readers first == tree. self assert: tree variableBinding scope class = RBRootScope! ! !RBSemanticTest methodsFor: 'testing-bindings' stamp: 'lr 4/27/2010 16:30'! testSuperBinding | tree | tree := self parseExpression: 'super'. self assert: tree variableBinding class = RBSuperBinding. self assert: tree variableBinding name = 'super'. self assert: tree variableBinding isReadonly. self assert: tree variableBinding writers isEmpty. self assert: tree variableBinding readers size = 1. self assert: tree variableBinding readers first == tree. self assert: tree variableBinding scope class = RBRootScope! !