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)! ! !RBProgramNode methodsFor: '*ast-semantic-accessing' stamp: 'lr 4/27/2010 13:31'! lexicalScope ^ self propertyAt: #lexicalScope ifAbsent: [ self parent ifFalse: [ self parent lexicalScope ] ]! ! 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 ]! !