SystemOrganization addCategory: #'AST-Semantic'! SystemOrganization addCategory: #'AST-Semantic-Scope'! SystemOrganization addCategory: #'AST-Semantic-Binding'! !RBProgramNode methodsFor: '*ast-semantic-actions' stamp: 'lr 6/7/2010 14:59'! annotateInClass: aBehavior self annotateInScope: (RBVariableScope owner: (RBLiteralScope owner: RBRootScope new class: aBehavior) class: aBehavior)! ! !RBProgramNode methodsFor: '*ast-semantic-actions' stamp: 'lr 5/29/2010 20:32'! annotateInScope: aScope self semanticAnnotatorClass new start: self scope: aScope! ! !RBProgramNode methodsFor: '*ast-semantic-accessing' stamp: 'lr 5/11/2010 22:23'! lexicalScope ^ self propertyAt: #lexicalScope ifAbsent: [ self parent isNil ifFalse: [ self parent lexicalScope ] ifTrue: [ self semanticAnnotationMissing ] ]! ! !RBProgramNode methodsFor: '*ast-semantic-private' stamp: 'lr 5/29/2010 21:01'! semanticAnnotationMissing self error: 'Semantic annotation missing, please use #annotateInClass: to annotate the AST'! ! !RBProgramNode methodsFor: '*ast-semantic-private' stamp: 'lr 5/29/2010 20:24'! semanticAnnotatorClass ^ RBSemanticAnnotator! ! 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 6/7/2010 14:27'! acceptVariableNode: aNode | binding | binding := scope lookup: aNode name ifAbsent: [ self undeclaredVariable: aNode ]. aNode propertyAt: #variableBinding put: binding. binding addAccessor: aNode. aNode isUsed ifTrue: [ binding addReader: aNode ]. aNode isWrite ifTrue: [ binding addWriter: aNode ]! ! !RBSemanticAnnotator methodsFor: 'private' stamp: 'lr 6/7/2010 14:59'! scope: aNode with: aClass during: aBlock scope := aClass owner: scope node: aNode. ^ aBlock ensure: [ scope := scope owner ]! ! !RBSemanticAnnotator methodsFor: 'visiting' stamp: 'lr 5/11/2010 22:25'! start: aProgramNode self visitNode: aProgramNode methodNode! ! !RBSemanticAnnotator methodsFor: 'deprecated' stamp: 'lr 5/29/2010 20:57'! start: aProgramNode class: aBehavior ^ aProgramNode annotateInClass: aBehavior! ! !RBSemanticAnnotator methodsFor: 'visiting' stamp: 'lr 5/29/2010 20:27'! start: aProgramNode scope: aLexicalScope scope := aLexicalScope. self start: aProgramNode! ! !RBSemanticAnnotator methodsFor: 'private' stamp: 'lr 6/7/2010 14:44'! undeclaredVariable: aNode ^ aNode lexicalScope add: (RBUndeclaredNotification node: aNode)! ! !RBSemanticAnnotator methodsFor: 'visiting' stamp: 'lr 4/27/2010 15:34'! visitArgument: aNode scope add: (RBArgumentBinding node: aNode)! ! !RBVariableNode methodsFor: '*ast-semantic-accessing' stamp: 'lr 5/11/2010 22:23'! variableBinding ^ self propertyAt: #variableBinding ifAbsent: [ self semanticAnnotationMissing ]! ! 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: 'testing' stamp: 'lr 5/11/2010 19:11'! isBlockScope ^ false! ! !RBLexicalScope methodsFor: 'testing' stamp: 'lr 5/11/2010 19:11'! isLiteralScope ^ false! ! !RBLexicalScope methodsFor: 'testing' stamp: 'lr 5/11/2010 19:11'! isMethodScope ^ false! ! !RBLexicalScope methodsFor: 'testing' stamp: 'lr 5/11/2010 19:11'! isRootScope ^ false! ! !RBLexicalScope methodsFor: 'testing' stamp: 'lr 5/11/2010 19:11'! isVariableScope ^ false! ! !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: 'owner' classVariableNames: '' poolDictionaries: '' category: 'AST-Semantic-Scope'! RBOwnedScope subclass: #RBClassScope instanceVariableNames: 'class' classVariableNames: '' poolDictionaries: '' category: 'AST-Semantic-Scope'! !RBClassScope class methodsFor: 'instance creation' stamp: 'lr 6/7/2010 14:58'! owner: aLexicalScope class: aBehavior ^ (self owner: 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 ]! ! !RBLiteralScope methodsFor: 'testing' stamp: 'lr 5/11/2010 19:12'! isLiteralScope ^ true! ! RBClassScope subclass: #RBVariableScope instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'AST-Semantic-Scope'! !RBVariableScope methodsFor: 'testing' stamp: 'lr 5/11/2010 19:12'! isVariableScope ^ true! ! !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'! !RBBlockScope methodsFor: 'testing' stamp: 'lr 5/11/2010 19:12'! isBlockScope ^ true! ! RBNodedScope subclass: #RBMethodScope instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'AST-Semantic-Scope'! !RBMethodScope methodsFor: 'testing' stamp: 'lr 5/11/2010 19:12'! isMethodScope ^ true! ! !RBNodedScope class methodsFor: 'instance creation' stamp: 'lr 6/7/2010 14:58'! owner: aLexicalScope node: aProgramNode ^ (self owner: 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 6/7/2010 14:58'! owner: aLexicalScope ^ self new setOwner: aLexicalScope! ! !RBOwnedScope methodsFor: 'querying' stamp: 'lr 6/7/2010 14:57'! lookup: aString ifAbsent: aBlock ^ (self bindingOf: aString) ifNil: [ owner lookup: aString ifAbsent: aBlock ]! ! !RBOwnedScope methodsFor: 'accessing' stamp: 'lr 6/7/2010 14:57'! owner "Answer the owning scope." ^ owner! ! !RBOwnedScope methodsFor: 'initialization' stamp: 'lr 6/7/2010 14:57'! setOwner: aLexicalScope owner := 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: 'testing' stamp: 'lr 5/11/2010 19:12'! isRootScope ^ true! ! !RBRootScope methodsFor: 'querying' stamp: 'lr 4/27/2010 14:10'! lookup: aString ifAbsent: aBlock ^ bindings at: aString ifAbsent: aBlock! ! Object subclass: #RBVariableBinding instanceVariableNames: 'scope accessors 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: 'accessing' stamp: 'lr 6/4/2010 15:03'! accessors "Answer the nodes that access the receiver." ^ accessors! ! !RBVariableBinding methodsFor: 'protected' stamp: 'lr 6/4/2010 14:59'! addAccessor: aProgramNode accessors := accessors copyWith: aProgramNode! ! !RBVariableBinding methodsFor: 'protected' stamp: 'lr 5/11/2010 22:28'! addReader: aProgramNode readers := readers copyWith: aProgramNode! ! !RBVariableBinding methodsFor: 'protected' stamp: 'lr 5/11/2010 22:28'! addWriter: aProgramNode writers := writers copyWith: aProgramNode! ! !RBVariableBinding methodsFor: 'initialization' stamp: 'lr 6/4/2010 14:59'! initialize accessors := readers := writers := #()! ! !RBVariableBinding methodsFor: 'testing' stamp: 'lr 6/4/2010 15:03'! isAccessed "Answer true if the receiving binding is accessed." ^ self accessors notEmpty! ! !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' stamp: 'lr 6/7/2010 15:09'! isShadowing "Answer true if the receiving shadows another variable in a parent scope." self scope isRootScope ifTrue: [ ^ false ]. self scope owner lookup: self name ifAbsent: [ ^ false ]. ^ true! ! !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 5/11/2010 22:17'! 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 5/11/2010 22:18'! writers "Answer the nodes that write to the receiver." ^ writers! ! Notification subclass: #RBUndeclaredNotification instanceVariableNames: 'node' classVariableNames: '' poolDictionaries: '' category: 'AST-Semantic'! !RBUndeclaredNotification class methodsFor: 'signalling' stamp: 'lr 6/7/2010 14:31'! node: aVariableNode ^ self new node: aVariableNode; signal: aVariableNode name , ' is undeclared'! ! !RBUndeclaredNotification methodsFor: 'configuration' stamp: 'lr 6/7/2010 14:30'! defaultAction ^ RBUndeclaredBinding node: self node! ! !RBUndeclaredNotification methodsFor: 'accessing' stamp: 'lr 6/7/2010 14:29'! node ^ node! ! !RBUndeclaredNotification methodsFor: 'accessing' stamp: 'lr 6/7/2010 14:29'! node: aNode node := aNode! !