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/28/2010 09:21'! scope: aNode with: aClass during: aBlock scope := aClass parent: scope node: aNode. ^ aBlock ensure: [ scope := scope parent ]! ! !RBSemanticAnnotator methodsFor: 'visiting' stamp: 'lr 4/28/2010 09:22'! start: aProgramNode class: aBehavior ^ self start: aProgramNode root: (RBVariableScope parent: (RBLiteralScope parent: 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)! ! !RBVariableNode methodsFor: '*ast-semantic-accessing' stamp: 'lr 4/27/2010 15:31'! variableBinding ^ self propertyAt: #variableBinding ifAbsent: [ nil ]! ! Object subclass: #RBLexicalScope instanceVariableNames: 'bindings' classVariableNames: '' poolDictionaries: '' category: 'AST-Semantic-Scope'! !RBLexicalScope class methodsFor: 'instance creation' stamp: 'lr 4/28/2010 09:16'! new ^ self basicNew initialize! ! !RBLexicalScope methodsFor: 'adding' stamp: 'lr 4/28/2010 09:25'! add: aVariableBinding "Add aVariableBinding to the receving scope." ^ 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/28/2010 09:25'! bindingOf: aString "Answer the local binding of aString or nil." ^ bindings at: aString ifAbsent: [ | binding | binding := (self basicBindingOf: aString) ifNil: [ ^ nil ]. self add: binding ]! ! !RBLexicalScope methodsFor: 'initialization' stamp: 'lr 4/28/2010 09:23'! initialize bindings := RBSmallDictionary new! ! !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/28/2010 09:19'! lookup: aString ifAbsent: aBlock "Lookup the variable aString in the receiving scope, evaluate aBlock if not found." self subclassResponsibility! ! RBLexicalScope subclass: #RBOwnedScope instanceVariableNames: 'parent' classVariableNames: '' poolDictionaries: '' category: 'AST-Semantic-Scope'! RBOwnedScope subclass: #RBClassScope instanceVariableNames: 'class' classVariableNames: '' poolDictionaries: '' category: 'AST-Semantic-Scope'! !RBClassScope class methodsFor: 'instance creation' stamp: 'lr 4/28/2010 09:22'! parent: aLexicalScope class: aBehavior ^ (self parent: aLexicalScope) 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) ]! ! RBOwnedScope subclass: #RBNodedScope instanceVariableNames: 'node' classVariableNames: '' poolDictionaries: '' category: 'AST-Semantic-Scope'! RBNodedScope subclass: #RBBlockScope instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'AST-Semantic-Scope'! RBNodedScope subclass: #RBMethodScope instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'AST-Semantic-Scope'! !RBNodedScope class methodsFor: 'instance creation' stamp: 'lr 4/28/2010 09:22'! parent: aLexicalScope node: aProgramNode ^ (self parent: aLexicalScope) setNode: aProgramNode! ! !RBNodedScope methodsFor: 'accessing' stamp: 'lr 4/27/2010 13:29'! node "Answer the program node that defines this scope." ^ node! ! !RBNodedScope methodsFor: 'initialization' stamp: 'lr 4/27/2010 15:19'! setNode: aProgramNode node := aProgramNode. node propertyAt: #lexicalScope put: self! ! !RBOwnedScope class methodsFor: 'instance creation' stamp: 'lr 4/28/2010 09:18'! parent: aLexicalScope ^ self new setParent: aLexicalScope! ! !RBOwnedScope methodsFor: 'querying' stamp: 'lr 4/28/2010 09:20'! lookup: aString ifAbsent: aBlock ^ (self bindingOf: aString) ifNil: [ parent lookup: aString ifAbsent: aBlock ]! ! !RBOwnedScope methodsFor: 'accessing' stamp: 'lr 4/28/2010 09:17'! parent "Answer the owning scope." ^ parent! ! !RBOwnedScope methodsFor: 'initialization' stamp: 'lr 4/28/2010 09:18'! setParent: aLexicalScope parent := aLexicalScope! ! 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: 'testing-type' stamp: 'lr 4/28/2010 09:36'! isInstanceBinding ^ true! ! !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: 'testing-type' stamp: 'lr 4/28/2010 09:36'! isLiteralBinding ^ true! ! !RBLiteralBinding methodsFor: 'accessing' stamp: 'lr 4/27/2010 14:57'! name ^ binding key asString! ! RBVariableBinding subclass: #RBLocalBinding instanceVariableNames: 'node' classVariableNames: '' poolDictionaries: '' category: 'AST-Semantic-Binding'! RBLocalBinding subclass: #RBArgumentBinding instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'AST-Semantic-Binding'! !RBArgumentBinding methodsFor: 'testing-type' stamp: 'lr 4/28/2010 09:36'! isArgumentBinding ^ true! ! !RBArgumentBinding methodsFor: 'testing' stamp: 'lr 4/27/2010 15:28'! isReadonly ^ true! ! !RBLocalBinding class methodsFor: 'instance creation' stamp: 'lr 4/27/2010 14:07'! node: aNode ^ self new setNode: aNode! ! !RBLocalBinding methodsFor: 'accessing' stamp: 'lr 4/27/2010 14:36'! name ^ node name! ! !RBLocalBinding methodsFor: 'accessing' stamp: 'lr 4/27/2010 13:59'! node "Answer the declaring or defining node." ^ node! ! !RBLocalBinding methodsFor: 'initialization' stamp: 'lr 4/27/2010 15:31'! setNode: aNode node := aNode. node propertyAt: #variableBinding put: self! ! RBLocalBinding subclass: #RBTemporaryBinding instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'AST-Semantic-Binding'! !RBTemporaryBinding methodsFor: 'testing-type' stamp: 'lr 4/28/2010 09:36'! isTemporaryBinding ^ true! ! RBLocalBinding subclass: #RBUndeclaredBinding instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'AST-Semantic-Binding'! !RBUndeclaredBinding methodsFor: 'testing-type' stamp: 'lr 4/28/2010 09:36'! isUndeclaredBinding ^ true! ! RBVariableBinding subclass: #RBSpecialBinding instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'AST-Semantic-Binding'! RBSpecialBinding subclass: #RBContextBinding instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'AST-Semantic-Binding'! !RBContextBinding methodsFor: 'testing-type' stamp: 'lr 4/28/2010 09:29'! isContextBinding ^ true! ! !RBContextBinding methodsFor: 'accessing' stamp: 'lr 4/27/2010 14:34'! name ^ 'thisContext'! ! RBSpecialBinding subclass: #RBSelfBinding instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'AST-Semantic-Binding'! !RBSelfBinding methodsFor: 'testing-type' stamp: 'lr 4/28/2010 09:29'! isSelfBinding ^ true! ! !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: 'testing-type' stamp: 'lr 4/28/2010 09:29'! isSuperBinding ^ true! ! !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-type' stamp: 'lr 4/28/2010 09:35'! isArgumentBinding ^ false! ! !RBVariableBinding methodsFor: 'testing-type' stamp: 'lr 4/28/2010 09:34'! isContextBinding ^ false! ! !RBVariableBinding methodsFor: 'testing-type' stamp: 'lr 4/28/2010 09:35'! isInstanceBinding ^ false! ! !RBVariableBinding methodsFor: 'testing-type' stamp: 'lr 4/28/2010 09:35'! isLiteralBinding ^ false! ! !RBVariableBinding methodsFor: 'testing' stamp: 'lr 4/28/2010 09:33'! isRead "Answer true if the receiving binding is read." ^ self readers notEmpty! ! !RBVariableBinding methodsFor: 'testing' stamp: 'lr 4/27/2010 14:35'! isReadonly "Answer if the receiving binding is readonly." ^ false! ! !RBVariableBinding methodsFor: 'testing-type' stamp: 'lr 4/28/2010 09:34'! isSelfBinding ^ false! ! !RBVariableBinding methodsFor: 'testing-type' stamp: 'lr 4/28/2010 09:34'! isSuperBinding ^ false! ! !RBVariableBinding methodsFor: 'testing-type' stamp: 'lr 4/28/2010 09:35'! isTemporaryBinding ^ false! ! !RBVariableBinding methodsFor: 'testing-type' stamp: 'lr 4/28/2010 09:35'! isUndeclaredBinding ^ false! ! !RBVariableBinding methodsFor: 'testing' stamp: 'lr 4/28/2010 09:33'! isWritten "Answer true if the receiving binding is written." ^ self writers notEmpty! ! !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! ! !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! !