'From Squeak3.8alpha of ''17 July 2004'' [latest update: #6212] on 23 September 2004 at 10:54:26 am'! "Change Set: RBAST-md Date: 22 September 2004 Author: Marcus Denker This changese adds a standalone version of the RB-AST"! !PrimitiveNode commentStamp: 'ajh 3/24/2003 21:35' prior: 0! I represent a primitive. I am more than just a number if I am a named primitive. Structure: num Primitive number. spec Stored in first literal when num is 117 or 120. ! Object subclass: #RBProgramNode instanceVariableNames: 'parent comments' classVariableNames: 'FormatterClass' poolDictionaries: '' category: 'Compiler-AST-Nodes'! RBProgramNode subclass: #RBArrayNode instanceVariableNames: 'leftBrace rightBrace statements' classVariableNames: '' poolDictionaries: '' category: 'Compiler-AST-Nodes'! RBProgramNode subclass: #RBMethodNode instanceVariableNames: 'selector selectorParts body source arguments tags' classVariableNames: '' poolDictionaries: '' category: 'Compiler-AST-Nodes'! RBMethodNode subclass: #RBPatternMethodNode instanceVariableNames: 'isList' classVariableNames: '' poolDictionaries: '' category: 'Compiler-AST-Nodes'! Object subclass: #RBProgramNodeVisitor instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Compiler-AST-Visitors'! RBProgramNodeVisitor subclass: #RBFormatter instanceVariableNames: 'codeStream lineStart firstLineLength tabs' classVariableNames: '' poolDictionaries: '' category: 'Compiler-AST-Visitors'! RBProgramNode subclass: #RBReturnNode instanceVariableNames: 'return value' classVariableNames: '' poolDictionaries: '' category: 'Compiler-AST-Nodes'! RBProgramNode subclass: #RBSequenceNode instanceVariableNames: 'leftBar rightBar statements periods temporaries' classVariableNames: '' poolDictionaries: '' category: 'Compiler-AST-Nodes'! Object subclass: #RBToken instanceVariableNames: 'sourcePointer' classVariableNames: '' poolDictionaries: '' category: 'Compiler-AST-Tokens'! RBToken subclass: #RBAssignmentToken instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Compiler-AST-Tokens'! RBToken subclass: #RBOptimizedToken instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Compiler-AST-Tokens'! RBAssignmentToken subclass: #RBShortAssignmentToken instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Compiler-AST-Tokens'! RBProgramNode subclass: #RBValueNode instanceVariableNames: 'parentheses' classVariableNames: '' poolDictionaries: '' category: 'Compiler-AST-Nodes'! RBValueNode subclass: #RBAssignmentNode instanceVariableNames: 'variable assignment value' classVariableNames: '' poolDictionaries: '' category: 'Compiler-AST-Nodes'! RBValueNode subclass: #RBBlockNode instanceVariableNames: 'left right colons body arguments bar' classVariableNames: '' poolDictionaries: '' category: 'Compiler-AST-Nodes'! RBValueNode subclass: #RBCascadeNode instanceVariableNames: 'messages semicolons' classVariableNames: '' poolDictionaries: '' category: 'Compiler-AST-Nodes'! RBValueNode subclass: #RBLiteralNode instanceVariableNames: 'token' classVariableNames: '' poolDictionaries: '' category: 'Compiler-AST-Nodes'! RBValueNode subclass: #RBMessageNode instanceVariableNames: 'receiver selector selectorParts arguments' classVariableNames: '' poolDictionaries: '' category: 'Compiler-AST-Nodes'! RBValueNode subclass: #RBOptimizedNode instanceVariableNames: 'left right body' classVariableNames: '' poolDictionaries: '' category: 'Compiler-AST-Nodes'! RBMessageNode subclass: #RBPatternMessageNode instanceVariableNames: 'isList isCascadeList' classVariableNames: '' poolDictionaries: '' category: 'Compiler-AST-Nodes'! RBToken subclass: #RBValueToken instanceVariableNames: 'value' classVariableNames: '' poolDictionaries: '' category: 'Compiler-AST-Tokens'! RBValueToken subclass: #RBBinarySelectorToken instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Compiler-AST-Tokens'! RBValueToken subclass: #RBIdentifierToken instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Compiler-AST-Tokens'! RBValueToken subclass: #RBKeywordToken instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Compiler-AST-Tokens'! RBValueToken subclass: #RBLiteralToken instanceVariableNames: 'stopPosition' classVariableNames: '' poolDictionaries: '' category: 'Compiler-AST-Tokens'! RBValueToken subclass: #RBPatternBlockToken instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Compiler-AST-Tokens'! RBValueToken subclass: #RBSpecialCharacterToken instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Compiler-AST-Tokens'! RBValueNode subclass: #RBVariableNode instanceVariableNames: 'token' classVariableNames: '' poolDictionaries: '' category: 'Compiler-AST-Nodes'! RBVariableNode subclass: #RBPatternVariableNode instanceVariableNames: 'recurseInto isList isLiteral isStatement isAnything' classVariableNames: '' poolDictionaries: '' category: 'Compiler-AST-Nodes'! !PrimitiveNode methodsFor: 'as yet unclassified' stamp: 'ajh 7/14/2001 12:37'! num ^ primitiveNum! ! !PrimitiveNode methodsFor: 'as yet unclassified' stamp: 'ajh 7/14/2001 12:23'! num: n primitiveNum _ n! ! !PrimitiveNode methodsFor: 'as yet unclassified' stamp: 'ajh 3/12/2003 12:26'! printOn: aStream aStream nextPutAll: 'primitive '; print: primitiveNum! ! !PrimitiveNode methodsFor: 'as yet unclassified' stamp: 'ajh 3/19/2003 22:06'! printPrimitiveOn: aStream "Print the primitive on aStream" | primIndex primDecl | primIndex _ primitiveNum. primIndex = 0 ifTrue: [^ self]. primIndex = 120 ifTrue: [ "External call spec" ^ aStream print: spec]. aStream nextPutAll: '. (primIndex ~= 117 and: [primIndex ~= 120]) ifTrue: [ Smalltalk at: #Interpreter ifPresent: [:cls | aStream nextPutAll: ' "', ((cls classPool at: #PrimitiveTable) at: primIndex + 1) , '" ' ]. ]. ! ! !PrimitiveNode methodsFor: 'as yet unclassified' stamp: 'ajh 3/19/2003 22:02'! sourceText ^ String streamContents: [:stream | self printPrimitiveOn: stream]! ! !PrimitiveNode methodsFor: 'as yet unclassified' stamp: 'ajh 7/14/2001 12:37'! spec ^ spec! ! !PrimitiveNode methodsFor: 'as yet unclassified' stamp: 'ajh 7/14/2001 12:30'! spec: literal spec _ literal! ! !PrimitiveNode class methodsFor: 'as yet unclassified' stamp: 'ajh 7/14/2001 12:47'! null ^ self new num: 0! ! !RBProgramNode methodsFor: 'accessing'! allArgumentVariables | children | children := self children. children isEmpty ifTrue: [^#()]. ^children inject: OrderedCollection new into: [:vars :each | vars addAll: each allArgumentVariables; yourself]! ! !RBProgramNode methodsFor: 'accessing'! allDefinedVariables | children | children := self children. children isEmpty ifTrue: [^#()]. ^children inject: OrderedCollection new into: [:vars :each | vars addAll: each allDefinedVariables; yourself]! ! !RBProgramNode methodsFor: 'accessing'! allTemporaryVariables | children | children := self children. children isEmpty ifTrue: [^#()]. ^children inject: OrderedCollection new into: [:vars :each | vars addAll: each allTemporaryVariables; yourself]! ! !RBProgramNode methodsFor: 'accessing'! asReturn "Change the current node to a return node." parent isNil ifTrue: [self error: 'Cannot change to a return without a parent node.']. parent isSequence ifFalse: [self error: 'Parent node must be a sequence node.']. (parent isLast: self) ifFalse: [self error: 'Return node must be last.']. ^parent addReturn! ! !RBProgramNode methodsFor: 'accessing'! blockVariables ^parent isNil ifTrue: [#()] ifFalse: [parent blockVariables]! ! !RBProgramNode methodsFor: 'accessing'! children ^#()! ! !RBProgramNode methodsFor: 'accessing'! comments ^comments isNil ifTrue: [#()] ifFalse: [comments]! ! !RBProgramNode methodsFor: 'accessing'! comments: aCollection comments := aCollection! ! !RBProgramNode methodsFor: 'accessing'! formattedCode ^self formatterClass new format: self! ! !RBProgramNode methodsFor: 'accessing'! formatterClass ^self class formatterClass! ! !RBProgramNode methodsFor: 'accessing'! parent ^parent! ! !RBProgramNode methodsFor: 'accessing'! parent: anObject parent := anObject! ! !RBProgramNode methodsFor: 'accessing'! precedence ^6! ! !RBProgramNode methodsFor: 'accessing'! sentMessages | messages | messages := Set new. self children do: [:each | messages addAll: each sentMessages]. ^messages! ! !RBProgramNode methodsFor: 'accessing'! source ^parent notNil ifTrue: [parent source] ifFalse: [nil]! ! !RBProgramNode methodsFor: 'accessing'! sourceInterval ^self start to: self stop! ! !RBProgramNode methodsFor: 'accessing'! start self subclassResponsibility! ! !RBProgramNode methodsFor: 'accessing'! stop self subclassResponsibility! ! !RBProgramNode methodsFor: 'accessing'! temporaryVariables ^parent isNil ifTrue: [#()] ifFalse: [parent temporaryVariables]! ! !RBProgramNode methodsFor: 'testing-matching'! canMatchMethod: aCompiledMethod self sentMessages do: [:each | ((self class optimizedSelectors includes: each) or: [aCompiledMethod refersToLiteral: each]) ifFalse: [^false]]. ^true! ! !RBProgramNode methodsFor: 'testing-matching'! isList ^false! ! !RBProgramNode methodsFor: 'testing-matching'! isPatternNode ^false! ! !RBProgramNode methodsFor: 'testing-matching'! recurseInto ^false! ! !RBProgramNode methodsFor: 'meta variable-accessing'! cascadeListCharacter ^$;! ! !RBProgramNode methodsFor: 'meta variable-accessing'! listCharacter ^$@! ! !RBProgramNode methodsFor: 'meta variable-accessing'! literalCharacter ^$#! ! !RBProgramNode methodsFor: 'meta variable-accessing'! recurseIntoCharacter ^$`! ! !RBProgramNode methodsFor: 'meta variable-accessing'! statementCharacter ^$.! ! !RBProgramNode methodsFor: 'testing'! assigns: aVariableName ^(self children detect: [:each | each assigns: aVariableName] ifNone: [nil]) notNil! ! !RBProgramNode methodsFor: 'testing'! containedBy: anInterval ^anInterval first <= self start and: [anInterval last >= self stop]! ! !RBProgramNode methodsFor: 'testing'! containsReturn ^(self children detect: [:each | each containsReturn] ifNone: [nil]) notNil! ! !RBProgramNode methodsFor: 'testing'! defines: aName ^false! ! !RBProgramNode methodsFor: 'testing'! directlyUses: aNode ^true! ! !RBProgramNode methodsFor: 'testing'! evaluatedFirst: aNode self children do: [:each | each == aNode ifTrue: [^true]. each isImmediate ifFalse: [^false]]. ^false! ! !RBProgramNode methodsFor: 'testing'! intersectsInterval: anInterval ^(anInterval first between: self start and: self stop) or: [self start between: anInterval first and: anInterval last]! ! !RBProgramNode methodsFor: 'testing'! isAssignment ^false! ! !RBProgramNode methodsFor: 'testing'! isBlock ^false! ! !RBProgramNode methodsFor: 'testing'! isCascade ^false! ! !RBProgramNode methodsFor: 'testing'! isDirectlyUsed "This node is directly used as an argument, receiver, or part of an assignment." ^parent isNil ifTrue: [false] ifFalse: [parent directlyUses: self]! ! !RBProgramNode methodsFor: 'testing'! isEvaluatedFirst "Return true if we are the first thing evaluated in this statement." ^parent isNil or: [parent isSequence or: [parent evaluatedFirst: self]]! ! !RBProgramNode methodsFor: 'testing'! isImmediate ^false! ! !RBProgramNode methodsFor: 'testing'! isLast: aNode | children | children := self children. ^children isEmpty not and: [children last == aNode]! ! !RBProgramNode methodsFor: 'testing'! isLiteral ^false! ! !RBProgramNode methodsFor: 'testing'! isMessage ^false! ! !RBProgramNode methodsFor: 'testing'! isMethod ^false! ! !RBProgramNode methodsFor: 'testing'! isReturn ^false! ! !RBProgramNode methodsFor: 'testing'! isSequence ^false! ! !RBProgramNode methodsFor: 'testing'! isUsed "Answer true if this node could be used as part of another expression. For example, you could use the result of this node as a receiver of a message, an argument, the right part of an assignment, or the return value of a block. This differs from isDirectlyUsed in that it is conservative since it also includes return values of blocks." ^parent isNil ifTrue: [false] ifFalse: [parent uses: self]! ! !RBProgramNode methodsFor: 'testing'! isValue ^false! ! !RBProgramNode methodsFor: 'testing'! isVariable ^false! ! !RBProgramNode methodsFor: 'testing'! lastIsReturn ^self isReturn! ! !RBProgramNode methodsFor: 'testing'! references: aVariableName ^(self children detect: [:each | each references: aVariableName] ifNone: [nil]) notNil! ! !RBProgramNode methodsFor: 'testing'! uses: aNode ^true! ! !RBProgramNode methodsFor: 'querying'! bestNodeFor: anInterval | selectedChildren | (self intersectsInterval: anInterval) ifFalse: [^nil]. (self containedBy: anInterval) ifTrue: [^self]. selectedChildren := self children select: [:each | each intersectsInterval: anInterval]. ^selectedChildren size == 1 ifTrue: [selectedChildren first bestNodeFor: anInterval] ifFalse: [self]! ! !RBProgramNode methodsFor: 'querying'! statementNode "Return your topmost node that is contained by a sequence node." (parent isNil or: [parent isSequence]) ifTrue: [^self]. ^parent statementNode! ! !RBProgramNode methodsFor: 'querying'! whichNodeIsContainedBy: anInterval | selectedChildren | (self intersectsInterval: anInterval) ifFalse: [^nil]. (self containedBy: anInterval) ifTrue: [^self]. selectedChildren := self children select: [:each | each intersectsInterval: anInterval]. ^selectedChildren size == 1 ifTrue: [selectedChildren first whichNodeIsContainedBy: anInterval] ifFalse: [nil]! ! !RBProgramNode methodsFor: 'querying'! whoDefines: aName ^(self defines: aName) ifTrue: [self] ifFalse: [parent notNil ifTrue: [parent whoDefines: aName] ifFalse: [nil]]! ! !RBProgramNode methodsFor: 'printing'! printOn: aStream aStream nextPutAll: self class name; nextPut: $(; nextPutAll: self formattedCode; nextPut: $)! ! !RBProgramNode methodsFor: 'copying'! copy "This is redefined for IBM Smalltalk which doesn't have postCopy." ^self shallowCopy postCopy! ! !RBProgramNode methodsFor: 'copying'! copyCommentsFrom: aNode "Add all comments from aNode to us. If we already have the comment, then don't add it." | newComments | newComments := OrderedCollection new. aNode nodesDo: [:each | newComments addAll: each comments]. self nodesDo: [:each | each comments do: [:comment | newComments remove: comment ifAbsent: []]]. newComments isEmpty ifTrue: [^self]. newComments := newComments asSortedCollection: [:a :b | a first < b first]. self comments: newComments! ! !RBProgramNode methodsFor: 'copying'! postCopy! ! !RBProgramNode methodsFor: 'matching'! copyInContext: aDictionary ^self copy! ! !RBProgramNode methodsFor: 'matching'! copyList: matchNodes inContext: aDictionary | newNodes | newNodes := OrderedCollection new. matchNodes do: [:each | | object | object := each copyInContext: aDictionary. newNodes addAll: object]. ^newNodes! ! !RBProgramNode methodsFor: 'matching'! match: aNode inContext: aDictionary ^self = aNode! ! !RBProgramNode methodsFor: 'matching'! matchList: matchNodes against: programNodes inContext: aDictionary ^self matchList: matchNodes index: 1 against: programNodes index: 1 inContext: aDictionary! ! !RBProgramNode methodsFor: 'matching'! matchList: matchNodes index: matchIndex against: programNodes index: programIndex inContext: aDictionary | node currentIndex currentDictionary nodes | matchNodes size < matchIndex ifTrue: [^programNodes size < programIndex]. node := matchNodes at: matchIndex. node isList ifTrue: [currentIndex := programIndex - 1. [currentDictionary := aDictionary copy. programNodes size < currentIndex or: [nodes := programNodes copyFrom: programIndex to: currentIndex. (currentDictionary at: node ifAbsentPut: [nodes]) = nodes and: [(self matchList: matchNodes index: matchIndex + 1 against: programNodes index: currentIndex + 1 inContext: currentDictionary) ifTrue: [currentDictionary keysAndValuesDo: [:key :value | aDictionary at: key put: value]. ^true]. false]]] whileFalse: [currentIndex := currentIndex + 1]. ^false]. programNodes size < programIndex ifTrue: [^false]. (node match: (programNodes at: programIndex) inContext: aDictionary) ifFalse: [^false]. ^self matchList: matchNodes index: matchIndex + 1 against: programNodes index: programIndex + 1 inContext: aDictionary! ! !RBProgramNode methodsFor: 'enumeration'! collect: aBlock "Hacked to fit collection protocols" ^aBlock value: self! ! !RBProgramNode methodsFor: 'enumeration'! do: aBlock "Hacked to fit collection protocols" aBlock value: self! ! !RBProgramNode methodsFor: 'enumeration'! size "Hacked to fit collection protocols" ^1! ! !RBProgramNode methodsFor: 'replacing'! removeDeadCode self children do: [:each | each removeDeadCode]! ! !RBProgramNode methodsFor: 'replacing'! replaceNode: aNode withNode: anotherNode self error: 'I don''t store other nodes'! ! !RBProgramNode methodsFor: 'replacing'! replaceWith: aNode parent isNil ifTrue: [self error: 'This node doesn''t have a parent']. parent replaceNode: self withNode: aNode! ! !RBProgramNode methodsFor: 'iterating' stamp: 'bh 3/13/2000 01:48'! allChildren ^self children inject:(OrderedCollection new addAll:self children; yourself) into:[:answer :child| answer addAll:child allChildren; yourself].! ! !RBProgramNode methodsFor: 'iterating'! nodesDo: aBlock aBlock value: self. self children do: [:each | each nodesDo: aBlock]! ! !RBProgramNode methodsFor: 'comparing'! equalTo: aNode exceptForVariables: variableNameCollection | dictionary | dictionary := Dictionary new. (self equalTo: aNode withMapping: dictionary) ifFalse: [^false]. dictionary keysAndValuesDo: [:key :value | (key = value or: [variableNameCollection includes: key]) ifFalse: [^false]]. ^true! ! !RBProgramNode methodsFor: 'comparing'! equalTo: aNode withMapping: aDictionary ^self = aNode! ! !RBProgramNode methodsFor: 'visitor' stamp: 'rr 4/10/2004 16:54'! acceptVisitor: aProgramNodeVisitor "self subclassResponsibility"! ! !RBArrayNode methodsFor: 'accessing' stamp: 'ls 1/24/2000 00:00'! children ^statements! ! !RBArrayNode methodsFor: 'accessing' stamp: 'ls 1/24/2000 00:02'! leftBrace: leftBrace0 leftBrace _ leftBrace0.! ! !RBArrayNode methodsFor: 'accessing' stamp: 'ls 1/24/2000 00:02'! periods: periods "ignored"! ! !RBArrayNode methodsFor: 'accessing' stamp: 'ls 1/24/2000 00:02'! rightBrace: rightBrace0 rightBrace _ rightBrace0.! ! !RBArrayNode methodsFor: 'accessing' stamp: 'ls 1/23/2000 23:58'! start ^leftBrace! ! !RBArrayNode methodsFor: 'accessing' stamp: 'ls 1/24/2000 00:32'! statements ^statements! ! !RBArrayNode methodsFor: 'accessing' stamp: 'dvf 11/12/2002 00:47'! statements: statements0 statements ifNotNil: [self error: 'double initialization']. statements _ statements0. statements do: [:statement | statement parent: self]! ! !RBArrayNode methodsFor: 'accessing' stamp: 'ls 1/23/2000 23:58'! stop ^rightBrace! ! !RBArrayNode methodsFor: 'comparing' stamp: 'bh 4/3/2000 12:46'! = anObject self == anObject ifTrue: [^true]. self class = anObject class ifFalse: [^false]. ^statements = anObject statements.! ! !RBArrayNode methodsFor: 'comparing' stamp: 'bh 4/3/2000 12:46'! hash ^statements hash.! ! !RBArrayNode methodsFor: 'testing' stamp: 'ls 1/24/2000 00:28'! lastIsReturn statements isEmpty ifTrue:[ ^false ]. ^statements last lastIsReturn! ! !RBArrayNode methodsFor: 'initialization' stamp: 'ls 1/23/2000 23:57'! leftBrace: leftBrace0 rightBrace: rightBrace0 statements: statements0 leftBrace _ leftBrace0. rightBrace _ rightBrace0. statements _ statements0.! ! !RBArrayNode methodsFor: 'visitor' stamp: 'ls 2/29/2004 13:01'! acceptVisitor: aProgramNodeVisitor ^aProgramNodeVisitor acceptArrayNode: self! ! !RBArrayNode methodsFor: 'copying' stamp: 'ls 1/24/2000 00:25'! postCopy statements _ statements collect: [ :statement | statement copy ]! ! !RBArrayNode methodsFor: 'replacing' stamp: 'ls 1/24/2000 00:27'! replaceNode: oldNode withNode: newNode statements _ statements collect: [ :statement | statement == oldNode ifTrue: [ newNode ] ifFalse: [ statement ] ]! ! !RBMethodNode methodsFor: 'accessing'! addNode: aNode ^body addNode: aNode! ! !RBMethodNode methodsFor: 'accessing'! addReturn body addReturn! ! !RBMethodNode methodsFor: 'accessing'! addSelfReturn ^body addSelfReturn! ! !RBMethodNode methodsFor: 'accessing'! allArgumentVariables ^(self argumentNames asOrderedCollection) addAll: super allArgumentVariables; yourself! ! !RBMethodNode methodsFor: 'accessing'! allDefinedVariables ^(self argumentNames asOrderedCollection) addAll: super allDefinedVariables; yourself! ! !RBMethodNode methodsFor: 'accessing'! argumentNames ^self arguments collect: [:each | each name]! ! !RBMethodNode methodsFor: 'accessing'! arguments ^arguments! ! !RBMethodNode methodsFor: 'accessing'! arguments: variableNodes arguments := variableNodes. arguments do: [:each | each parent: self]! ! !RBMethodNode methodsFor: 'accessing'! body ^body! ! !RBMethodNode methodsFor: 'accessing'! body: stmtsNode body := stmtsNode. body parent: self! ! !RBMethodNode methodsFor: 'accessing'! children ^self arguments copyWith: self body! ! !RBMethodNode methodsFor: 'accessing'! primitiveSources ^self tags collect: [:each | self source copyFrom: each first to: each last]! ! !RBMethodNode methodsFor: 'accessing'! selector ^selector isNil ifTrue: [selector := self buildSelector] ifFalse: [selector]! ! !RBMethodNode methodsFor: 'accessing'! selector: aSelector | keywords numArgs | keywords := aSelector keywords. numArgs := aSelector numArgs. numArgs == arguments size ifFalse: [self error: 'Attempting to assign selector with wrong number of arguments.']. selectorParts := numArgs == 0 ifTrue: [Array with: (RBIdentifierToken value: keywords first start: nil)] ifFalse: [keywords first last == $: ifTrue: [keywords collect: [:each | RBKeywordToken value: each start: nil]] ifFalse: [Array with: (RBBinarySelectorToken value: aSelector start: nil)]]. selector := aSelector! ! !RBMethodNode methodsFor: 'accessing'! source ^source! ! !RBMethodNode methodsFor: 'accessing'! source: anObject source := anObject! ! !RBMethodNode methodsFor: 'accessing'! start ^1! ! !RBMethodNode methodsFor: 'accessing'! stop ^source size! ! !RBMethodNode methodsFor: 'accessing'! tags ^tags isNil ifTrue: [#()] ifFalse: [tags]! ! !RBMethodNode methodsFor: 'accessing'! tags: aCollectionOfIntervals tags := aCollectionOfIntervals! ! !RBMethodNode methodsFor: 'testing'! defines: aName ^(arguments detect: [:each | each name = aName] ifNone: [nil]) notNil! ! !RBMethodNode methodsFor: 'testing'! isLast: aNode ^body isLast: aNode! ! !RBMethodNode methodsFor: 'testing'! isMethod ^true! ! !RBMethodNode methodsFor: 'testing'! isPrimitive ^tags notNil and: [tags isEmpty not and: [(self primitiveSources detect: [:each | '*primitive*' match: each] ifNone: [nil]) notNil]]! ! !RBMethodNode methodsFor: 'testing'! lastIsReturn ^body lastIsReturn! ! !RBMethodNode methodsFor: 'testing'! references: aVariableName ^body references: aVariableName! ! !RBMethodNode methodsFor: 'testing'! uses: aNode ^body == aNode and: [aNode lastIsReturn]! ! !RBMethodNode methodsFor: 'visitor'! acceptVisitor: aProgramNodeVisitor ^aProgramNodeVisitor acceptMethodNode: self! ! !RBMethodNode methodsFor: 'printing'! printOn: aStream aStream nextPutAll: self formattedCode! ! !RBMethodNode methodsFor: 'matching'! copyInContext: aDictionary ^(self class new) selectorParts: (selectorParts collect: [:each | each removePositions]); arguments: (arguments collect: [:each | each copyInContext: aDictionary]); body: (body copyInContext: aDictionary); source: (aDictionary at: '-source-'); yourself! ! !RBMethodNode methodsFor: 'matching'! match: aNode inContext: aDictionary self class == aNode class ifFalse: [^false]. aDictionary at: '-source-' put: aNode source. self selector == aNode selector ifFalse: [^false]. ^(self matchList: arguments against: aNode arguments inContext: aDictionary) and: [body match: aNode body inContext: aDictionary]! ! !RBMethodNode methodsFor: 'private'! buildSelector | selectorStream | selectorStream := WriteStream on: (String new: 50). selectorParts do: [:each | selectorStream nextPutAll: each value]. ^selectorStream contents asSymbol! ! !RBMethodNode methodsFor: 'private'! selectorParts ^selectorParts! ! !RBMethodNode methodsFor: 'private'! selectorParts: tokenCollection selectorParts := tokenCollection! ! !RBMethodNode methodsFor: 'comparing'! = anObject self == anObject ifTrue: [^true]. self class = anObject class ifFalse: [^false]. (self selector = anObject selector and: [self body = anObject body]) ifFalse: [^false]. 1 to: self arguments size do: [:i | (self arguments at: i) = (anObject arguments at: i) ifFalse: [^false]]. ^true! ! !RBMethodNode methodsFor: 'comparing'! equalTo: anObject withMapping: aDictionary self class = anObject class ifFalse: [^false]. (self selector = anObject selector and: [self body equalTo: anObject body withMapping: aDictionary]) ifFalse: [^false]. 1 to: self arguments size do: [:i | ((self arguments at: i) equalTo: (anObject arguments at: i) withMapping: aDictionary) ifFalse: [^false]. aDictionary removeKey: (self arguments at: i) name]. ^self primitiveSources = anObject primitiveSources! ! !RBMethodNode methodsFor: 'comparing'! hash ^(self selector hash bitXor: self body hash) bitXor: self arguments hash! ! !RBMethodNode methodsFor: 'replacing'! replaceNode: aNode withNode: anotherNode aNode == body ifTrue: [self body: anotherNode]. self arguments: (arguments collect: [:each | each == aNode ifTrue: [anotherNode] ifFalse: [each]])! ! !RBMethodNode methodsFor: 'initialize-release'! selectorParts: tokenCollection arguments: variableNodes selectorParts := tokenCollection. self arguments: variableNodes! ! !RBMethodNode methodsFor: 'copying'! postCopy super postCopy. body := body copy. arguments := arguments collect: [:each | each copy]! ! !RBPatternMethodNode methodsFor: 'matching'! copyInContext: aDictionary | selectors | selectors := self isSelectorList ifTrue: [(aDictionary at: selectorParts first value) keywords] ifFalse: [selectorParts collect: [:each | aDictionary at: each value]]. ^(RBMethodNode new) selectorParts: (selectors collect: [:each | (each last == $: ifTrue: [RBKeywordToken] ifFalse: [RBIdentifierToken]) value: each start: nil]); arguments: (self copyList: arguments inContext: aDictionary); body: (body copyInContext: aDictionary); source: (aDictionary at: '-source-'); yourself! ! !RBPatternMethodNode methodsFor: 'matching'! match: aNode inContext: aDictionary aNode class == self matchingClass ifFalse: [^false]. aDictionary at: '-source-' put: aNode source. self isSelectorList ifTrue: [^(aDictionary at: selectorParts first value ifAbsentPut: [aNode selector]) = aNode selector and: [(aDictionary at: arguments first ifAbsentPut: [aNode arguments]) = aNode arguments and: [body match: aNode body inContext: aDictionary]]]. ^(self matchArgumentsAgainst: aNode inContext: aDictionary) and: [body match: aNode body inContext: aDictionary]! ! !RBPatternMethodNode methodsFor: 'matching'! matchArgumentsAgainst: aNode inContext: aDictionary self arguments size == aNode arguments size ifFalse: [^false]. (self matchSelectorAgainst: aNode inContext: aDictionary) ifFalse: [^false]. 1 to: arguments size do: [:i | ((arguments at: i) match: (aNode arguments at: i) inContext: aDictionary) ifFalse: [^false]]. ^true! ! !RBPatternMethodNode methodsFor: 'matching'! matchSelectorAgainst: aNode inContext: aDictionary | keyword | 1 to: selectorParts size do: [:i | keyword := selectorParts at: i. (aDictionary at: keyword value ifAbsentPut: [keyword isPatternVariable ifTrue: [(aNode selectorParts at: i) value] ifFalse: [keyword value]]) = (aNode selectorParts at: i) value ifFalse: [^false]]. ^true! ! !RBPatternMethodNode methodsFor: 'testing'! isSelectorList ^isList! ! !RBPatternMethodNode methodsFor: 'testing-matching'! isPatternNode ^true! ! !RBPatternMethodNode methodsFor: 'private'! matchingClass ^RBMethodNode! ! !RBPatternMethodNode methodsFor: 'initialize-release'! selectorParts: tokenCollection arguments: variableNodes super selectorParts: tokenCollection arguments: variableNodes. isList := (tokenCollection first value at: 2) == self listCharacter! ! !RBProgramNode class methodsFor: 'accessing'! formatterClass ^FormatterClass isNil ifTrue: [RBFormatter] ifFalse: [FormatterClass]! ! !RBProgramNode class methodsFor: 'accessing'! formatterClass: aClass FormatterClass := aClass! ! !RBProgramNode class methodsFor: 'accessing'! optimizedSelectors ^#(#== #ifTrue: #ifTrue:ifFalse: #ifFalse: #ifFalse:ifTrue: #whileTrue: #whileTrue #whileFalse: #whileFalse #to:do: #yourself #and: #or:)! ! !RBArrayNode class methodsFor: 'instance creation' stamp: 'ls 1/23/2000 23:56'! leftBrace: leftBrace rightBrace: rightBrace statements: statements ^self new leftBrace: leftBrace rightBrace: rightBrace statements: statements! ! !RBMethodNode class methodsFor: 'instance creation'! selector: aSymbol arguments: variableNodes body: aSequenceNode ^(self new) arguments: variableNodes; selector: aSymbol; body: aSequenceNode; yourself! ! !RBMethodNode class methodsFor: 'instance creation'! selector: aSymbol body: aSequenceNode ^self selector: aSymbol arguments: #() body: aSequenceNode! ! !RBMethodNode class methodsFor: 'instance creation'! selectorParts: tokenCollection arguments: variableNodes ^((tokenCollection detect: [:each | each isPatternVariable] ifNone: [nil]) notNil ifTrue: [RBPatternMethodNode] ifFalse: [RBMethodNode]) new selectorParts: tokenCollection arguments: variableNodes! ! !RBProgramNodeVisitor methodsFor: 'visitor-double dispatching' stamp: 'ls 1/24/2000 00:31'! acceptArrayNode: anArrayNode anArrayNode children do: [:each | self visitNode: each]! ! !RBProgramNodeVisitor methodsFor: 'visitor-double dispatching'! acceptAssignmentNode: anAssignmentNode self visitNode: anAssignmentNode variable. self visitNode: anAssignmentNode value! ! !RBProgramNodeVisitor methodsFor: 'visitor-double dispatching'! acceptBlockNode: aBlockNode self visitArguments: aBlockNode arguments. self visitNode: aBlockNode body! ! !RBProgramNodeVisitor methodsFor: 'visitor-double dispatching'! acceptCascadeNode: aCascadeNode aCascadeNode messages do: [:each | self visitNode: each]! ! !RBProgramNodeVisitor methodsFor: 'visitor-double dispatching'! acceptLiteralNode: aLiteralNode! ! !RBProgramNodeVisitor methodsFor: 'visitor-double dispatching'! acceptMessageNode: aMessageNode (aMessageNode isCascaded not or: [aMessageNode isFirstCascaded]) ifTrue: [self visitNode: aMessageNode receiver]. aMessageNode arguments do: [:each | self visitNode: each]! ! !RBProgramNodeVisitor methodsFor: 'visitor-double dispatching'! acceptMethodNode: aMethodNode self visitArguments: aMethodNode arguments. self visitNode: aMethodNode body! ! !RBProgramNodeVisitor methodsFor: 'visitor-double dispatching'! acceptOptimizedNode: anOptimizedNode self visitNode: anOptimizedNode body! ! !RBProgramNodeVisitor methodsFor: 'visitor-double dispatching'! acceptReturnNode: aReturnNode self visitNode: aReturnNode value! ! !RBProgramNodeVisitor methodsFor: 'visitor-double dispatching'! acceptSequenceNode: aSequenceNode self visitArguments: aSequenceNode temporaries. aSequenceNode statements do: [:each | self visitNode: each]! ! !RBProgramNodeVisitor methodsFor: 'visitor-double dispatching'! acceptVariableNode: aVariableNode! ! !RBProgramNodeVisitor methodsFor: 'visiting'! visitArgument: each "Here to allow subclasses to detect arguments or temporaries." ^self visitNode: each! ! !RBProgramNodeVisitor methodsFor: 'visiting'! visitArguments: aNodeCollection ^aNodeCollection do: [:each | self visitArgument: each]! ! !RBProgramNodeVisitor methodsFor: 'visiting'! visitNode: aNode ^aNode acceptVisitor: self! ! !RBProgramNodeVisitor methodsFor: 'copying'! copy "Here since IBM doesn't do postCopy's" ^self shallowCopy postCopy! ! !RBProgramNodeVisitor methodsFor: 'copying'! postCopy! ! !RBProgramNodeVisitor methodsFor: 'initialize-release'! initialize! ! !RBFormatter methodsFor: 'visitor-double dispatching' stamp: 'ls 1/24/2000 00:37'! acceptArrayNode: anArrayNode codeStream nextPutAll: '{ '. self indent: 1 while: [ self indent. self formatStatementsFor: anArrayNode. ]. codeStream nextPutAll: '}'.! ! !RBFormatter methodsFor: 'visitor-double dispatching'! acceptAssignmentNode: anAssignmentNode self indent: 2 while: [self visitNode: anAssignmentNode variable. codeStream nextPutAll: ' := '. self visitNode: anAssignmentNode value]! ! !RBFormatter methodsFor: 'visitor-double dispatching'! acceptBlockNode: aBlockNode | seqNode multiline formattedBody formatter | seqNode := aBlockNode body. formatter := (self copy) lineStart: 0; yourself. formattedBody := formatter format: seqNode. multiline := self lineLength + formattedBody size > self maxLineSize or: [formatter isMultiLine]. multiline ifTrue: [self indent]. codeStream nextPut: $[. aBlockNode arguments do: [:each | codeStream nextPut: $:. self visitNode: each. codeStream nextPut: $ ]. aBlockNode arguments isEmpty ifFalse: [codeStream nextPutAll: '| '. multiline ifTrue: [self indent]]. codeStream nextPutAll: formattedBody; nextPut: $]! ! !RBFormatter methodsFor: 'visitor-double dispatching'! acceptCascadeNode: aCascadeNode | messages | messages := aCascadeNode messages. self visitNode: messages first receiver. self indentWhile: [self for: messages do: [:each | self indent; indentWhile: [self formatMessage: each cascade: true]] separatedBy: [codeStream nextPut: $;]]! ! !RBFormatter methodsFor: 'visitor-double dispatching'! acceptLiteralNode: aLiteralNode ^self formatLiteral: aLiteralNode value! ! !RBFormatter methodsFor: 'visitor-double dispatching'! acceptMessageNode: aMessageNode | newFormatter code | newFormatter := self copy. code := newFormatter format: aMessageNode receiver. codeStream nextPutAll: code. codeStream nextPut: $ . newFormatter isMultiLine ifTrue: [lineStart := codeStream position - newFormatter lastLineLength]. self indent: (newFormatter isMultiLine ifTrue: [2] ifFalse: [1]) while: [self formatMessage: aMessageNode cascade: false]! ! !RBFormatter methodsFor: 'visitor-double dispatching'! acceptMethodNode: aMethodNode self formatMethodPatternFor: aMethodNode. self indentWhile: [self formatMethodCommentFor: aMethodNode indentBefore: true. self indent. self tagBeforeTemporaries ifTrue: [self formatTagFor: aMethodNode]. aMethodNode body statements isEmpty ifFalse: [self visitNode: aMethodNode body]]! ! !RBFormatter methodsFor: 'visitor-double dispatching'! acceptOptimizedNode: anOptimizedNode codeStream nextPutAll: '##('. self visitNode: anOptimizedNode body. codeStream nextPut: $)! ! !RBFormatter methodsFor: 'visitor-double dispatching'! acceptReturnNode: aReturnNode codeStream nextPut: $^. self visitNode: aReturnNode value! ! !RBFormatter methodsFor: 'visitor-double dispatching'! acceptSequenceNode: aSequenceNode self formatMethodCommentFor: aSequenceNode indentBefore: false. self formatTemporariesFor: aSequenceNode. self tagBeforeTemporaries ifFalse: [| parent | parent := aSequenceNode parent. (parent notNil and: [parent isMethod]) ifTrue: [self formatTagFor: parent]]. self formatStatementsFor: aSequenceNode! ! !RBFormatter methodsFor: 'visitor-double dispatching'! acceptVariableNode: aVariableNode codeStream nextPutAll: aVariableNode name! ! !RBFormatter methodsFor: 'private'! for: aValue do: doBlock separatedBy: separatorBlock "This is implemented here since IBM Smalltalk doesn't implement a do:separatedBy: method" aValue isEmpty ifTrue: [^self]. 1 to: aValue size - 1 do: [:i | doBlock value: (aValue at: i). separatorBlock value]. doBlock value: aValue last! ! !RBFormatter methodsFor: 'private'! indent firstLineLength isNil ifTrue: [firstLineLength := codeStream position]. codeStream cr. tabs timesRepeat: [codeStream tab]. lineStart := codeStream position! ! !RBFormatter methodsFor: 'private'! indent: anInteger while: aBlock tabs := tabs + anInteger. aBlock value. tabs := tabs - anInteger! ! !RBFormatter methodsFor: 'private'! indentWhile: aBlock self indent: 1 while: aBlock! ! !RBFormatter methodsFor: 'private'! lineLength ^codeStream position - lineStart! ! !RBFormatter methodsFor: 'private'! lineStart: aPosition lineStart := aPosition! ! !RBFormatter methodsFor: 'private'! maxLineSize ^75! ! !RBFormatter methodsFor: 'private'! maximumArgumentsPerLine ^2! ! !RBFormatter methodsFor: 'private'! needsParenthesisFor: aNode | parent grandparent | aNode isValue ifFalse: [^false]. parent := aNode parent. parent isNil ifTrue: [^false]. (aNode isMessage and: [parent isMessage and: [parent receiver == aNode]]) ifTrue: [grandparent := parent parent. (grandparent notNil and: [grandparent isCascade]) ifTrue: [^true]]. aNode precedence < parent precedence ifTrue: [^false]. aNode isAssignment & parent isAssignment ifTrue: [^false]. aNode isAssignment | aNode isCascade ifTrue: [^true]. aNode precedence == 0 ifTrue: [^false]. aNode isMessage ifFalse: [^true]. aNode precedence = parent precedence ifFalse: [^true]. aNode isUnary ifTrue: [^false]. aNode isKeyword ifTrue: [^true]. parent receiver == aNode ifFalse: [^true]. ^self precedenceOf: parent selector greaterThan: aNode selector! ! !RBFormatter methodsFor: 'private'! precedenceOf: parentSelector greaterThan: childSelector "Put parenthesis around things that are preceived to have 'lower' precedence. For example, 'a + b * c' -> '(a + b) * c' but 'a * b + c' -> 'a * b + c'" | childIndex parentIndex operators | operators := #(#($| $& $?) #($= $~ $< $>) #($- $+) #($* $/ $% $\) #($@)). childIndex := 0. parentIndex := 0. 1 to: operators size do: [:i | ((operators at: i) includes: parentSelector first) ifTrue: [parentIndex := i]. ((operators at: i) includes: childSelector first) ifTrue: [childIndex := i]]. ^childIndex < parentIndex! ! !RBFormatter methodsFor: 'private'! selectorsToLeaveOnLine ^#(#to:do: #to:by: #to:by:do:)! ! !RBFormatter methodsFor: 'private'! selectorsToStartOnNewLine ^#(#ifTrue:ifFalse: #ifFalse:ifTrue: #ifTrue: #ifFalse:)! ! !RBFormatter methodsFor: 'private-formatting'! formatLiteral: aValue | isArray | (isArray := aValue class == Array) | (aValue class == ByteArray) ifTrue: [codeStream nextPutAll: (isArray ifTrue: ['#('] ifFalse: ['#[']). self for: aValue do: [:each | self formatLiteral: each] separatedBy: [codeStream nextPut: $ ]. codeStream nextPut: (isArray ifTrue: [$)] ifFalse: [$]]). ^self]. aValue isSymbol ifTrue: [self formatSymbol: aValue. ^self]. aValue class == Character ifTrue: [codeStream nextPut: $$; nextPut: aValue. ^self]. aValue storeOn: codeStream! ! !RBFormatter methodsFor: 'private-formatting'! formatMessage: aMessageNode cascade: cascadeBoolean | selectorParts arguments multiLine formattedArgs indentFirst firstArgLength length | selectorParts := aMessageNode selectorParts. arguments := aMessageNode arguments. formattedArgs := OrderedCollection new. multiLine := aMessageNode selector numArgs > self maximumArgumentsPerLine. length := aMessageNode selector size + arguments size + 1. firstArgLength := 0. self indentWhile: [1 to: arguments size do: [:i | | formatter string | formatter := (self copy) lineStart: (selectorParts at: i) length negated; yourself. string := formatter format: (arguments at: i). formattedArgs add: string. i == 1 ifTrue: [firstArgLength := formatter firstLineLength]. length := length + string size. multiLine := multiLine or: [formatter isMultiLine]]]. multiLine := multiLine or: [length + self lineLength > self maxLineSize]. indentFirst := cascadeBoolean not and: [multiLine and: [(self startMessageSendOnNewLine: aMessageNode) or: [self lineLength + selectorParts first length + 2 + firstArgLength > self maxLineSize]]]. indentFirst ifTrue: [self indent]. self formatMessageSelector: selectorParts withArguments: formattedArgs multiline: multiLine! ! !RBFormatter methodsFor: 'private-formatting'! formatMessageSelector: selectorParts withArguments: formattedArgs multiline: multiLine formattedArgs isEmpty ifTrue: [codeStream nextPutAll: selectorParts first value] ifFalse: [1 to: formattedArgs size do: [:i | i ~~ 1 & multiLine not ifTrue: [codeStream nextPut: $ ]. codeStream nextPutAll: (selectorParts at: i) value; nextPut: $ ; nextPutAll: (formattedArgs at: i). (multiLine and: [i < formattedArgs size]) ifTrue: [self indent]]]! ! !RBFormatter methodsFor: 'private-formatting'! formatMethodCommentFor: aNode indentBefore: aBoolean | source | source := aNode source. source isNil ifTrue: [^self]. aNode comments do: [:each | aBoolean ifTrue: [self indent]. codeStream nextPutAll: (aNode source copyFrom: each first to: each last); cr. aBoolean ifFalse: [self indent]]! ! !RBFormatter methodsFor: 'private-formatting'! formatMethodPatternFor: aMethodNode | selectorParts arguments | selectorParts := aMethodNode selectorParts. arguments := aMethodNode arguments. arguments isEmpty ifTrue: [codeStream nextPutAll: selectorParts first value] ifFalse: [selectorParts with: arguments do: [:selector :arg | codeStream nextPutAll: selector value; nextPut: $ . self visitArgument: arg. codeStream nextPut: $ ]]! ! !RBFormatter methodsFor: 'private-formatting'! formatStatementCommentFor: aNode | source | source := aNode source. source isNil ifTrue: [^self]. aNode comments do: [:each | | crs | crs := self newLinesFor: source startingAt: each first. (crs - 1 max: 0) timesRepeat: [codeStream cr]. crs == 0 ifTrue: [codeStream tab] ifFalse: [self indent]. codeStream nextPutAll: (source copyFrom: each first to: each last)]! ! !RBFormatter methodsFor: 'private-formatting'! formatStatementsFor: aSequenceNode | statements | statements := aSequenceNode statements. statements isEmpty ifTrue: [^self]. 1 to: statements size - 1 do: [:i | self visitNode: (statements at: i). codeStream nextPut: $.. self formatStatementCommentFor: (statements at: i). self indent]. self visitNode: statements last. self formatStatementCommentFor: statements last! ! !RBFormatter methodsFor: 'private-formatting' stamp: 'md 8/26/2004 18:34'! formatSymbol: aSymbol "Format the symbol, if its not a selector then we must put quotes around it. The and: case below, handles the VisualWorks problem of not accepting two bars as a symbol." codeStream nextPut: $#. ((Scanner isLiteralSymbol: aSymbol) and: [aSymbol ~~ #'||']) ifTrue: [codeStream nextPutAll: aSymbol] ifFalse: [aSymbol asString printOn: codeStream] " ((RBScanner isSelector: aSymbol) and: [aSymbol ~~ #'||']) ifTrue: [codeStream nextPutAll: aSymbol] ifFalse: [aSymbol asString printOn: codeStream]"! ! !RBFormatter methodsFor: 'private-formatting'! formatTagFor: aMethodNode | primitiveSources | primitiveSources := aMethodNode primitiveSources. primitiveSources do: [:each | codeStream nextPutAll: each. self indent]! ! !RBFormatter methodsFor: 'private-formatting'! formatTemporariesFor: aSequenceNode | temps | temps := aSequenceNode temporaries. temps isEmpty ifTrue: [^self]. codeStream nextPutAll: '| '. temps do: [:each | self visitArgument: each. codeStream nextPut: $ ]. codeStream nextPut: $|. self indent! ! !RBFormatter methodsFor: 'private-formatting'! newLinesFor: aString startingAt: anIndex | count cr lf index char | cr := Character value: 13. lf := Character value: 10. count := 0. index := anIndex - 1. [index > 0 and: [char := aString at: index. char isSeparator]] whileTrue: [char == lf ifTrue: [count := count + 1. (aString at: (index - 1 max: 1)) == cr ifTrue: [index := index - 1]]. char == cr ifTrue: [count := count + 1]. index := index - 1]. ^count! ! !RBFormatter methodsFor: 'accessing'! firstLineLength ^firstLineLength isNil ifTrue: [codeStream position] ifFalse: [firstLineLength]! ! !RBFormatter methodsFor: 'accessing'! format: aNode self visitNode: aNode. ^codeStream contents! ! !RBFormatter methodsFor: 'accessing'! isMultiLine ^firstLineLength notNil! ! !RBFormatter methodsFor: 'accessing'! lastLineLength ^codeStream position - (lineStart max: 0)! ! !RBFormatter methodsFor: 'initialize-release'! initialize super initialize. codeStream := WriteStream on: (String new: 60). tabs := 0. lineStart := 0! ! !RBFormatter methodsFor: 'testing'! startMessageSendOnNewLine: aMessageNode (self selectorsToStartOnNewLine includes: aMessageNode selector) ifTrue: [^true]. (self selectorsToLeaveOnLine includes: aMessageNode selector) ifTrue: [^false]. ^aMessageNode selector numArgs > self maximumArgumentsPerLine! ! !RBFormatter methodsFor: 'testing' stamp: 'md 8/26/2004 18:29'! tagBeforeTemporaries ^false "^RBParser isVisualWorks"! ! !RBFormatter methodsFor: 'visiting'! visitNode: aNode | parenthesis | parenthesis := self needsParenthesisFor: aNode. parenthesis ifTrue: [codeStream nextPut: $(]. aNode acceptVisitor: self. parenthesis ifTrue: [codeStream nextPut: $)]! ! !RBFormatter methodsFor: 'copying'! postCopy super postCopy. lineStart := self lineLength negated. codeStream := WriteStream on: (String new: 60). firstLineLength := nil! ! !RBProgramNodeVisitor class methodsFor: 'instance creation'! new ^super new initialize! ! !RBReturnNode methodsFor: 'matching'! copyInContext: aDictionary ^(self class new) value: (value copyInContext: aDictionary); yourself! ! !RBReturnNode methodsFor: 'matching'! match: aNode inContext: aDictionary aNode class == self class ifFalse: [^false]. ^value match: aNode value inContext: aDictionary! ! !RBReturnNode methodsFor: 'copying'! postCopy super postCopy. value := value copy! ! !RBReturnNode methodsFor: 'replacing'! replaceNode: aNode withNode: anotherNode value == aNode ifTrue: [self value: anotherNode]! ! !RBReturnNode methodsFor: 'accessing'! children ^Array with: value! ! !RBReturnNode methodsFor: 'accessing'! start ^return! ! !RBReturnNode methodsFor: 'accessing'! stop ^value stop! ! !RBReturnNode methodsFor: 'accessing'! value ^value! ! !RBReturnNode methodsFor: 'accessing'! value: valueNode value := valueNode. value parent: self! ! !RBReturnNode methodsFor: 'comparing'! = anObject self == anObject ifTrue: [^true]. self class = anObject class ifFalse: [^false]. ^self value = anObject value! ! !RBReturnNode methodsFor: 'comparing'! equalTo: anObject withMapping: aDictionary self class = anObject class ifFalse: [^false]. ^self value equalTo: anObject value withMapping: aDictionary! ! !RBReturnNode methodsFor: 'comparing'! hash ^self value hash! ! !RBReturnNode methodsFor: 'visitor'! acceptVisitor: aProgramNodeVisitor ^aProgramNodeVisitor acceptReturnNode: self! ! !RBReturnNode methodsFor: 'testing'! containsReturn ^true! ! !RBReturnNode methodsFor: 'testing'! isReturn ^true! ! !RBReturnNode methodsFor: 'initialize-release'! return: returnInteger value: aValueNode return := returnInteger. self value: aValueNode! ! !RBReturnNode class methodsFor: 'instance creation'! return: returnInteger value: aValueNode ^self new return: returnInteger value: aValueNode! ! !RBReturnNode class methodsFor: 'instance creation'! value: aNode ^self return: nil value: aNode! ! !RBSequenceNode methodsFor: 'querying'! bestNodeFor: anInterval | node | node := super bestNodeFor: anInterval. node == self ifTrue: [(temporaries isEmpty and: [statements size == 1]) ifTrue: [^statements first]]. ^node! ! !RBSequenceNode methodsFor: 'querying'! whichNodeIsContainedBy: anInterval | node | node := super whichNodeIsContainedBy: anInterval. node == self ifTrue: [(temporaries isEmpty and: [statements size == 1]) ifTrue: [^statements first]]. ^node! ! !RBSequenceNode methodsFor: 'matching'! copyInContext: aDictionary ^(self class new) temporaries: (self copyList: temporaries inContext: aDictionary); statements: (self copyList: statements inContext: aDictionary); yourself! ! !RBSequenceNode methodsFor: 'matching'! match: aNode inContext: aDictionary self class == aNode class ifFalse: [^false]. ^(self matchList: temporaries against: aNode temporaries inContext: aDictionary) and: [self matchList: statements against: aNode statements inContext: aDictionary]! ! !RBSequenceNode methodsFor: 'replacing'! removeDeadCode (self isUsed ifTrue: [statements size - 1] ifFalse: [statements size]) to: 1 by: -1 do: [:i | (statements at: i) isImmediate ifTrue: [statements removeAtIndex: i]]. super removeDeadCode! ! !RBSequenceNode methodsFor: 'replacing'! removeNode: aNode self replaceNode: aNode withNodes: #()! ! !RBSequenceNode methodsFor: 'replacing'! replaceNode: aNode withNode: anotherNode self statements: (statements collect: [:each | each == aNode ifTrue: [anotherNode] ifFalse: [each]]). self temporaries: (temporaries collect: [:each | each == aNode ifTrue: [anotherNode] ifFalse: [each]])! ! !RBSequenceNode methodsFor: 'replacing'! replaceNode: aNode withNodes: aCollection | index newStatements | index := self indexOfNode: aNode. newStatements := OrderedCollection new: statements size + aCollection size. 1 to: index - 1 do: [:i | newStatements add: (statements at: i)]. newStatements addAll: aCollection. index + 1 to: statements size do: [:i | newStatements add: (statements at: i)]. aCollection do: [:each | each parent: self]. statements := newStatements! ! !RBSequenceNode methodsFor: 'comparing'! = anObject "Can't send = to the temporaries and statements collection since they might change from arrays to OCs" self == anObject ifTrue: [^true]. self class = anObject class ifFalse: [^false]. self temporaries size = anObject temporaries size ifFalse: [^false]. 1 to: self temporaries size do: [:i | (self temporaries at: i) = (anObject temporaries at: i) ifFalse: [^false]]. self statements size = anObject statements size ifFalse: [^false]. 1 to: self statements size do: [:i | (self statements at: i) = (anObject statements at: i) ifFalse: [^false]]. ^true! ! !RBSequenceNode methodsFor: 'comparing'! equalTo: anObject withMapping: aDictionary self class = anObject class ifFalse: [^false]. self statements size == anObject statements size ifFalse: [^false]. 1 to: self statements size do: [:i | ((self statements at: i) equalTo: (anObject statements at: i) withMapping: aDictionary) ifFalse: [^false]]. aDictionary values asSet size = aDictionary size ifFalse: [^false]. "Not a one-to-one mapping" self temporaries do: [:each | aDictionary removeKey: each name ifAbsent: []]. ^true! ! !RBSequenceNode methodsFor: 'comparing'! hash ^self temporaries hash bitXor: (self statements isEmpty ifTrue: [0] ifFalse: [self statements first hash])! ! !RBSequenceNode methodsFor: 'adding nodes'! addNode: aNode aNode parent: self. (statements isEmpty not and: [statements last isReturn]) ifTrue: [self error: 'Cannot add statement after return node']. statements := statements asOrderedCollection add: aNode; yourself! ! !RBSequenceNode methodsFor: 'adding nodes'! addNode: aNode before: anotherNode | index | index := self indexOfNode: anotherNode. index = 0 ifTrue: [^self addNode: aNode]. statements := (statements asOrderedCollection) add: aNode beforeIndex: index; yourself. aNode parent: self! ! !RBSequenceNode methodsFor: 'adding nodes'! addNodeFirst: aNode aNode parent: self. statements := (statements asOrderedCollection) addFirst: aNode; yourself! ! !RBSequenceNode methodsFor: 'adding nodes'! addNodes: aCollection aCollection do: [:each | each parent: self]. (statements isEmpty not and: [statements last isReturn]) ifTrue: [self error: 'Cannot add statement after return node']. statements := (statements asOrderedCollection) addAll: aCollection; yourself! ! !RBSequenceNode methodsFor: 'adding nodes'! addNodes: aCollection before: anotherNode aCollection do: [:each | self addNode: each before: anotherNode]! ! !RBSequenceNode methodsFor: 'adding nodes'! addNodesFirst: aCollection aCollection do: [:each | each parent: self]. statements := (statements asOrderedCollection) addAllFirst: aCollection; yourself! ! !RBSequenceNode methodsFor: 'adding nodes'! addSelfReturn | node | self lastIsReturn ifTrue: [^self]. node := RBReturnNode value: (RBVariableNode named: 'self'). self addNode: node! ! !RBSequenceNode methodsFor: 'adding nodes'! addTemporariesNamed: aCollection aCollection do: [:each | self addTemporaryNamed: each]! ! !RBSequenceNode methodsFor: 'adding nodes'! addTemporaryNamed: aString | variableNode | variableNode := RBVariableNode named: aString. variableNode parent: self. temporaries := temporaries copyWith: variableNode! ! !RBSequenceNode methodsFor: 'accessing'! addReturn | node | statements isEmpty ifTrue: [^nil]. statements last isReturn ifTrue: [^statements last]. node := RBReturnNode value: statements last. statements at: statements size put: node. node parent: self. ^node! ! !RBSequenceNode methodsFor: 'accessing'! allDefinedVariables ^(self temporaryNames asOrderedCollection) addAll: super allDefinedVariables; yourself! ! !RBSequenceNode methodsFor: 'accessing'! allTemporaryVariables ^(self temporaryNames asOrderedCollection) addAll: super allTemporaryVariables; yourself! ! !RBSequenceNode methodsFor: 'accessing'! children ^(OrderedCollection new) addAll: self temporaries; addAll: self statements; yourself! ! !RBSequenceNode methodsFor: 'accessing'! periods: anObject periods := anObject! ! !RBSequenceNode methodsFor: 'accessing'! removeTemporaryNamed: aName temporaries := temporaries reject: [:each | each name = aName]! ! !RBSequenceNode methodsFor: 'accessing'! start ^leftBar isNil ifTrue: [statements isEmpty ifTrue: [1] ifFalse: [statements first start]] ifFalse: [leftBar]! ! !RBSequenceNode methodsFor: 'accessing'! statements ^statements! ! !RBSequenceNode methodsFor: 'accessing'! statements: stmtCollection statements := stmtCollection. statements do: [:each | each parent: self]! ! !RBSequenceNode methodsFor: 'accessing'! stop ^(periods isEmpty ifTrue: [0] ifFalse: [periods last]) max: (statements isEmpty ifTrue: [0] ifFalse: [statements last stop])! ! !RBSequenceNode methodsFor: 'accessing'! temporaries ^temporaries! ! !RBSequenceNode methodsFor: 'accessing'! temporaries: tempCollection temporaries := tempCollection. temporaries do: [:each | each parent: self]! ! !RBSequenceNode methodsFor: 'accessing'! temporaryNames ^temporaries collect: [:each | each name]! ! !RBSequenceNode methodsFor: 'accessing'! temporaryVariables ^(super temporaryVariables asOrderedCollection) addAll: self temporaryNames; yourself! ! !RBSequenceNode methodsFor: 'testing'! defines: aName ^(temporaries detect: [:each | each name = aName] ifNone: [nil]) notNil! ! !RBSequenceNode methodsFor: 'testing'! directlyUses: aNode ^false! ! !RBSequenceNode methodsFor: 'testing'! isLast: aNode | last | statements isEmpty ifTrue: [^false]. last := statements last. ^last == aNode or: [last isMessage and: [(#(#ifTrue:ifFalse: #ifFalse:ifTrue:) includes: last selector) and: [last arguments inject: false into: [:bool :each | bool or: [each isLast: aNode]]]]]! ! !RBSequenceNode methodsFor: 'testing'! isSequence ^true! ! !RBSequenceNode methodsFor: 'testing'! lastIsReturn ^statements isEmpty not and: [statements last lastIsReturn]! ! !RBSequenceNode methodsFor: 'testing'! references: aVariableName ^(statements detect: [:each | each references: aVariableName] ifNone: [nil]) notNil! ! !RBSequenceNode methodsFor: 'testing'! uses: aNode statements isEmpty ifTrue: [^false]. aNode == statements last ifFalse: [^false]. ^self isUsed! ! !RBSequenceNode methodsFor: 'initialize-release'! leftBar: leftInteger temporaries: variableNodes rightBar: rightInteger leftBar := leftInteger. self temporaries: variableNodes. rightBar := rightInteger! ! !RBSequenceNode methodsFor: 'private'! indexOfNode: aNode "Try to find the node by first looking for ==, and then for =" ^(1 to: statements size) detect: [:each | (statements at: each) == aNode] ifNone: [statements indexOf: aNode]! ! !RBSequenceNode methodsFor: 'visitor'! acceptVisitor: aProgramNodeVisitor ^aProgramNodeVisitor acceptSequenceNode: self! ! !RBSequenceNode methodsFor: 'copying'! postCopy super postCopy. temporaries := temporaries collect: [:each | each copy]. statements := statements collect: [:each | each copy]! ! !RBSequenceNode class methodsFor: 'instance creation'! leftBar: leftInteger temporaries: variableNodes rightBar: rightInteger ^self new leftBar: leftInteger temporaries: variableNodes rightBar: rightInteger! ! !RBSequenceNode class methodsFor: 'instance creation'! statements: statementNodes ^self temporaries: #() statements: statementNodes! ! !RBSequenceNode class methodsFor: 'instance creation'! temporaries: variableNodes statements: statementNodes ^(self new) temporaries: variableNodes; statements: statementNodes; yourself! ! !RBToken methodsFor: 'accessing'! length ^self subclassResponsibility! ! !RBToken methodsFor: 'accessing'! removePositions sourcePointer := nil! ! !RBToken methodsFor: 'accessing'! start ^sourcePointer! ! !RBToken methodsFor: 'accessing'! stop ^self start + self length - 1! ! !RBToken methodsFor: 'testing'! isAssignment ^false! ! !RBToken methodsFor: 'testing'! isBinary ^false! ! !RBToken methodsFor: 'testing'! isIdentifier ^false! ! !RBToken methodsFor: 'testing'! isKeyword ^false! ! !RBToken methodsFor: 'testing'! isLiteral ^false! ! !RBToken methodsFor: 'testing'! isOptimized ^false! ! !RBToken methodsFor: 'testing'! isPatternBlock ^false! ! !RBToken methodsFor: 'testing'! isPatternVariable ^false! ! !RBToken methodsFor: 'testing'! isSpecial ^false! ! !RBToken methodsFor: 'printing'! printOn: aStream aStream nextPut: $ ; nextPutAll: self class name! ! !RBToken methodsFor: 'initialize-release'! start: anInteger sourcePointer := anInteger! ! !RBAssignmentToken methodsFor: 'testing'! isAssignment ^true! ! !RBAssignmentToken methodsFor: 'private' stamp: 'ls 1/11/2000 07:00'! length ^2! ! !RBOptimizedToken methodsFor: 'testing' stamp: 'ls 1/11/2000 07:00'! isOptimized ^true! ! !RBOptimizedToken methodsFor: 'private'! length ^3! ! !RBShortAssignmentToken methodsFor: 'private' stamp: 'ls 1/11/2000 07:00'! length ^1! ! !RBToken class methodsFor: 'instance creation' stamp: 'ls 1/11/2000 07:00'! start: anInterval ^self new start: anInterval! ! !RBValueNode methodsFor: 'accessing'! addParenthesis: anInterval parentheses isNil ifTrue: [parentheses := OrderedCollection new: 1]. parentheses add: anInterval! ! !RBValueNode methodsFor: 'accessing'! parentheses ^parentheses isNil ifTrue: [#()] ifFalse: [parentheses]! ! !RBValueNode methodsFor: 'accessing'! start ^parentheses isNil ifTrue: [self startWithoutParentheses] ifFalse: [parentheses last first]! ! !RBValueNode methodsFor: 'accessing'! startWithoutParentheses ^self subclassResponsibility! ! !RBValueNode methodsFor: 'accessing'! stop ^parentheses isNil ifTrue: [self stopWithoutParentheses] ifFalse: [parentheses last last]! ! !RBValueNode methodsFor: 'accessing'! stopWithoutParentheses ^self subclassResponsibility! ! !RBValueNode methodsFor: 'testing'! containedBy: anInterval ^anInterval first <= self startWithoutParentheses and: [anInterval last >= self stopWithoutParentheses]! ! !RBValueNode methodsFor: 'testing'! hasParentheses ^self parentheses isEmpty not! ! !RBValueNode methodsFor: 'testing'! isValue ^true! ! !RBAssignmentNode methodsFor: 'comparing'! = anObject self == anObject ifTrue: [^true]. self class = anObject class ifFalse: [^false]. ^self variable = anObject variable and: [self value = anObject value]! ! !RBAssignmentNode methodsFor: 'comparing'! equalTo: anObject withMapping: aDictionary self class = anObject class ifFalse: [^false]. ^(self variable equalTo: anObject variable withMapping: aDictionary) and: [self value equalTo: anObject value withMapping: aDictionary]! ! !RBAssignmentNode methodsFor: 'comparing'! hash ^self variable hash bitXor: self value hash! ! !RBAssignmentNode methodsFor: 'accessing'! children ^Array with: value with: variable! ! !RBAssignmentNode methodsFor: 'accessing'! precedence ^5! ! !RBAssignmentNode methodsFor: 'accessing'! startWithoutParentheses ^variable start! ! !RBAssignmentNode methodsFor: 'accessing'! stopWithoutParentheses ^value stop! ! !RBAssignmentNode methodsFor: 'accessing'! value ^value! ! !RBAssignmentNode methodsFor: 'accessing'! value: aValueNode value := aValueNode. value parent: self! ! !RBAssignmentNode methodsFor: 'accessing'! variable ^variable! ! !RBAssignmentNode methodsFor: 'accessing'! variable: varNode variable := varNode. variable parent: self! ! !RBAssignmentNode methodsFor: 'testing'! assigns: aVariableName ^variable name = aVariableName or: [value assigns: aVariableName]! ! !RBAssignmentNode methodsFor: 'testing'! directlyUses: aNode ^aNode = value ifTrue: [true] ifFalse: [self isDirectlyUsed]! ! !RBAssignmentNode methodsFor: 'testing'! isAssignment ^true! ! !RBAssignmentNode methodsFor: 'testing'! uses: aNode ^aNode = value ifTrue: [true] ifFalse: [self isUsed]! ! !RBAssignmentNode methodsFor: 'matching'! copyInContext: aDictionary ^(self class new) variable: (variable copyInContext: aDictionary); value: (value copyInContext: aDictionary); yourself! ! !RBAssignmentNode methodsFor: 'matching'! match: aNode inContext: aDictionary aNode class == self class ifFalse: [^false]. ^(variable match: aNode variable inContext: aDictionary) and: [value match: aNode value inContext: aDictionary]! ! !RBAssignmentNode methodsFor: 'querying'! bestNodeFor: anInterval (self intersectsInterval: anInterval) ifFalse: [^nil]. (self containedBy: anInterval) ifTrue: [^self]. assignment isNil ifTrue: [^super bestNodeFor: anInterval]. ((anInterval first between: assignment and: assignment + 1) or: [assignment between: anInterval first and: anInterval last]) ifTrue: [^self]. self children do: [:each | | node | node := each bestNodeFor: anInterval. node notNil ifTrue: [^node]]! ! !RBAssignmentNode methodsFor: 'copying'! postCopy super postCopy. variable := variable postCopy. value := value postCopy! ! !RBAssignmentNode methodsFor: 'replacing'! replaceNode: aNode withNode: anotherNode value == aNode ifTrue: [self value: anotherNode]. variable == aNode ifTrue: [self variable: anotherNode]! ! !RBAssignmentNode methodsFor: 'visitor'! acceptVisitor: aProgramNodeVisitor ^aProgramNodeVisitor acceptAssignmentNode: self! ! !RBAssignmentNode methodsFor: 'initialize-release'! variable: aVariableNode value: aValueNode position: anInteger self variable: aVariableNode. self value: aValueNode. assignment := anInteger! ! !RBAssignmentNode class methodsFor: 'instance creation'! variable: aVariableNode value: aValueNode ^self variable: aVariableNode value: aValueNode position: nil! ! !RBAssignmentNode class methodsFor: 'instance creation'! variable: aVariableNode value: aValueNode position: anInteger ^self new variable: aVariableNode value: aValueNode position: anInteger! ! !RBBlockNode methodsFor: 'matching'! copyInContext: aDictionary ^(self class new) arguments: (self copyList: arguments inContext: aDictionary); body: (body copyInContext: aDictionary); yourself! ! !RBBlockNode methodsFor: 'matching'! match: aNode inContext: aDictionary aNode class == self class ifFalse: [^false]. ^(self matchList: arguments against: aNode arguments inContext: aDictionary) and: [body match: aNode body inContext: aDictionary]! ! !RBBlockNode methodsFor: 'testing'! defines: aName ^(arguments detect: [:each | each name = aName] ifNone: [nil]) notNil! ! !RBBlockNode methodsFor: 'testing'! directlyUses: aNode ^false! ! !RBBlockNode methodsFor: 'testing'! isBlock ^true! ! !RBBlockNode methodsFor: 'testing'! isImmediate ^true! ! !RBBlockNode methodsFor: 'testing'! isLast: aNode ^body isLast: aNode! ! !RBBlockNode methodsFor: 'testing'! references: aVariableName ^body references: aVariableName! ! !RBBlockNode methodsFor: 'testing'! uses: aNode aNode = body ifFalse: [^false]. ^parent isMessage ifTrue: [(#(#ifTrue:ifFalse: #ifTrue: #ifFalse: #ifFalse:ifTrue:) includes: parent selector) not or: [parent isUsed]] ifFalse: [self isUsed]! ! !RBBlockNode methodsFor: 'accessing'! allArgumentVariables ^(self argumentNames asOrderedCollection) addAll: super allArgumentVariables; yourself! ! !RBBlockNode methodsFor: 'accessing'! allDefinedVariables ^(self argumentNames asOrderedCollection) addAll: super allDefinedVariables; yourself! ! !RBBlockNode methodsFor: 'accessing'! argumentNames ^self arguments collect: [:each | each name]! ! !RBBlockNode methodsFor: 'accessing'! arguments ^arguments! ! !RBBlockNode methodsFor: 'accessing'! arguments: argCollection arguments := argCollection. arguments do: [:each | each parent: self]! ! !RBBlockNode methodsFor: 'accessing'! bar ^bar! ! !RBBlockNode methodsFor: 'accessing'! bar: anObject bar := anObject! ! !RBBlockNode methodsFor: 'accessing'! blockVariables | vars | vars := super blockVariables asOrderedCollection. vars addAll: self argumentNames. ^vars! ! !RBBlockNode methodsFor: 'accessing'! body ^body! ! !RBBlockNode methodsFor: 'accessing'! body: stmtsNode body := stmtsNode. body parent: self! ! !RBBlockNode methodsFor: 'accessing'! children ^self arguments copyWith: self body! ! !RBBlockNode methodsFor: 'accessing'! colons: anObject colons := anObject! ! !RBBlockNode methodsFor: 'accessing'! left ^left! ! !RBBlockNode methodsFor: 'accessing'! left: anObject left := anObject! ! !RBBlockNode methodsFor: 'accessing'! precedence ^0! ! !RBBlockNode methodsFor: 'accessing'! right ^right! ! !RBBlockNode methodsFor: 'accessing'! right: anObject right := anObject! ! !RBBlockNode methodsFor: 'accessing'! startWithoutParentheses ^left! ! !RBBlockNode methodsFor: 'accessing'! stopWithoutParentheses ^right! ! !RBBlockNode methodsFor: 'replacing'! replaceNode: aNode withNode: anotherNode body == aNode ifTrue: [self body: anotherNode]. self arguments: (arguments collect: [:each | each == aNode ifTrue: [anotherNode] ifFalse: [each]])! ! !RBBlockNode methodsFor: 'comparing'! = anObject self == anObject ifTrue: [^true]. self class = anObject class ifFalse: [^false]. self body = anObject body ifFalse: [^false]. self arguments size = anObject arguments size ifFalse: [^false]. 1 to: self arguments size do: [:i | (self arguments at: i) = (anObject arguments at: i) ifFalse: [^false]]. ^true! ! !RBBlockNode methodsFor: 'comparing'! equalTo: anObject withMapping: aDictionary self class = anObject class ifFalse: [^false]. self arguments size = anObject arguments size ifFalse: [^false]. 1 to: self arguments size do: [:i | ((self arguments at: i) equalTo: (anObject arguments at: i) withMapping: aDictionary) ifFalse: [^false]]. (self body equalTo: anObject body withMapping: aDictionary) ifFalse: [^false]. self arguments do: [:each | aDictionary removeKey: each name]. ^true! ! !RBBlockNode methodsFor: 'comparing'! hash ^self arguments hash bitXor: self body hash! ! !RBBlockNode methodsFor: 'copying'! postCopy super postCopy. arguments := arguments collect: [:each | each copy]. body := body copy! ! !RBBlockNode methodsFor: 'visitor'! acceptVisitor: aProgramNodeVisitor ^aProgramNodeVisitor acceptBlockNode: self! ! !RBBlockNode class methodsFor: 'instance creation'! arguments: argNodes body: sequenceNode ^(self new) arguments: argNodes; body: sequenceNode; yourself! ! !RBBlockNode class methodsFor: 'instance creation'! body: sequenceNode ^self arguments: #() body: sequenceNode! ! !RBCascadeNode methodsFor: 'testing'! directlyUses: aNode ^messages last = aNode and: [self isDirectlyUsed]! ! !RBCascadeNode methodsFor: 'testing'! isCascade ^true! ! !RBCascadeNode methodsFor: 'testing'! uses: aNode ^messages last = aNode and: [self isUsed]! ! !RBCascadeNode methodsFor: 'initialize-release'! messages: messageNodes semicolons: integerCollection self messages: messageNodes. semicolons := integerCollection! ! !RBCascadeNode methodsFor: 'replacing'! replaceNode: aNode withNode: anotherNode self messages: (messages collect: [:each | each == aNode ifTrue: [anotherNode] ifFalse: [each]])! ! !RBCascadeNode methodsFor: 'querying'! bestNodeFor: anInterval | selectedChildren | (self intersectsInterval: anInterval) ifFalse: [^nil]. (self containedBy: anInterval) ifTrue: [^self]. messages reverseDo: [:each | (each containedBy: anInterval) ifTrue: [^each]]. selectedChildren := (messages collect: [:each | each bestNodeFor: anInterval]) reject: [:each | each isNil]. ^selectedChildren detect: [:each | true] ifNone: [nil]! ! !RBCascadeNode methodsFor: 'querying'! whichNodeIsContainedBy: anInterval | selectedChildren | (self intersectsInterval: anInterval) ifFalse: [^nil]. (self containedBy: anInterval) ifTrue: [^self]. messages reverseDo: [:each | (each containedBy: anInterval) ifTrue: [^each]]. selectedChildren := (messages collect: [:each | each whichNodeIsContainedBy: anInterval]) reject: [:each | each isNil]. ^selectedChildren detect: [:each | true] ifNone: [nil]! ! !RBCascadeNode methodsFor: 'accessing'! children ^self messages! ! !RBCascadeNode methodsFor: 'accessing'! messages ^messages! ! !RBCascadeNode methodsFor: 'accessing'! messages: messageNodeCollection messages := messageNodeCollection. messages do: [:each | each parent: self]! ! !RBCascadeNode methodsFor: 'accessing'! precedence ^4! ! !RBCascadeNode methodsFor: 'accessing'! startWithoutParentheses ^messages first start! ! !RBCascadeNode methodsFor: 'accessing'! stopWithoutParentheses ^messages last stop! ! !RBCascadeNode methodsFor: 'comparing'! = anObject self == anObject ifTrue: [^true]. self class = anObject class ifFalse: [^false]. self messages size = anObject messages size ifFalse: [^false]. 1 to: self messages size do: [:i | (self messages at: i) = (anObject messages at: i) ifFalse: [^false]]. ^true! ! !RBCascadeNode methodsFor: 'comparing'! equalTo: anObject withMapping: aDictionary self class = anObject class ifFalse: [^false]. self messages size == anObject messages size ifFalse: [^false]. 1 to: self messages size do: [:i | ((self messages at: i) equalTo: (anObject messages at: i) withMapping: aDictionary) ifFalse: [^false]]. ^true! ! !RBCascadeNode methodsFor: 'comparing' stamp: 'bh 4/10/2001 15:59'! hash ^self messages asArray hash! ! !RBCascadeNode methodsFor: 'visitor'! acceptVisitor: aProgramNodeVisitor ^aProgramNodeVisitor acceptCascadeNode: self! ! !RBCascadeNode methodsFor: 'copying'! postCopy super postCopy. messages := messages collect: [:each | each copy]! ! !RBCascadeNode methodsFor: 'matching'! copyInContext: aDictionary ^(self class new) messages: (self copyList: messages inContext: aDictionary); yourself! ! !RBCascadeNode methodsFor: 'matching'! match: aNode inContext: aDictionary aNode class == self class ifFalse: [^false]. ^self matchList: messages against: aNode messages inContext: aDictionary! ! !RBCascadeNode class methodsFor: 'instance creation'! messages: messageNodes ^self new messages: messageNodes! ! !RBCascadeNode class methodsFor: 'instance creation'! messages: messageNodes semicolons: integerCollection ^self new messages: messageNodes semicolons: integerCollection! ! !RBLiteralNode methodsFor: 'accessing'! precedence ^0! ! !RBLiteralNode methodsFor: 'accessing'! startWithoutParentheses ^token start! ! !RBLiteralNode methodsFor: 'accessing'! stopWithoutParentheses ^token stop! ! !RBLiteralNode methodsFor: 'accessing'! token ^token! ! !RBLiteralNode methodsFor: 'accessing'! value ^token realValue! ! !RBLiteralNode methodsFor: 'initialize-release'! literalToken: aLiteralToken token := aLiteralToken! ! !RBLiteralNode methodsFor: 'testing'! isImmediate ^true! ! !RBLiteralNode methodsFor: 'testing'! isLiteral ^true! ! !RBLiteralNode methodsFor: 'matching'! copyInContext: aDictionary ^self class literalToken: token removePositions! ! !RBLiteralNode methodsFor: 'comparing'! = anObject self == anObject ifTrue: [^true]. self class == anObject class ifFalse: [^false]. self value class == anObject value class ifFalse: [^false]. ^self value = anObject value! ! !RBLiteralNode methodsFor: 'comparing'! hash ^self value hash! ! !RBLiteralNode methodsFor: 'visitor'! acceptVisitor: aProgramNodeVisitor ^aProgramNodeVisitor acceptLiteralNode: self! ! !RBLiteralNode class methodsFor: 'instance creation'! literalToken: aLiteralToken ^self new literalToken: aLiteralToken! ! !RBLiteralNode class methodsFor: 'instance creation'! value: aValue ^self literalToken: (RBLiteralToken value: aValue)! ! !RBMessageNode methodsFor: 'accessing'! arguments ^arguments isNil ifTrue: [#()] ifFalse: [arguments]! ! !RBMessageNode methodsFor: 'accessing'! arguments: argCollection arguments := argCollection. arguments do: [:each | each parent: self]! ! !RBMessageNode methodsFor: 'accessing'! children ^(OrderedCollection with: self receiver) addAll: self arguments; yourself! ! !RBMessageNode methodsFor: 'accessing'! precedence ^self isUnary ifTrue: [1] ifFalse: [self isKeyword ifTrue: [3] ifFalse: [2]]! ! !RBMessageNode methodsFor: 'accessing'! receiver ^receiver! ! !RBMessageNode methodsFor: 'accessing'! receiver: aValueNode receiver := aValueNode. receiver parent: self! ! !RBMessageNode methodsFor: 'accessing'! selector ^selector isNil ifTrue: [selector := self buildSelector] ifFalse: [selector]! ! !RBMessageNode methodsFor: 'accessing'! selector: aSelector | keywords numArgs | keywords := aSelector keywords. numArgs := aSelector numArgs. numArgs == arguments size ifFalse: [self error: 'Attempting to assign selector with wrong number of arguments.']. selectorParts := numArgs == 0 ifTrue: [Array with: (RBIdentifierToken value: keywords first start: nil)] ifFalse: [keywords first last == $: ifTrue: [keywords collect: [:each | RBKeywordToken value: each start: nil]] ifFalse: [Array with: (RBBinarySelectorToken value: aSelector start: nil)]]. selector := aSelector! ! !RBMessageNode methodsFor: 'accessing'! sentMessages ^(super sentMessages) add: self selector; yourself! ! !RBMessageNode methodsFor: 'accessing'! startWithoutParentheses ^receiver start! ! !RBMessageNode methodsFor: 'accessing'! stopWithoutParentheses ^arguments isEmpty ifTrue: [selectorParts first stop] ifFalse: [arguments last stop]! ! !RBMessageNode methodsFor: 'replacing'! replaceNode: aNode withNode: anotherNode "If we're inside a cascade node and are changing the receiver, change all the receivers" receiver == aNode ifTrue: [self receiver: anotherNode. (parent notNil and: [parent isCascade]) ifTrue: [parent messages do: [:each | each receiver: anotherNode]]]. self arguments: (arguments collect: [:each | each == aNode ifTrue: [anotherNode] ifFalse: [each]])! ! !RBMessageNode methodsFor: 'testing'! isBinary ^(self isUnary or: [self isKeyword]) not! ! !RBMessageNode methodsFor: 'testing'! isCascaded ^parent notNil and: [parent isCascade]! ! !RBMessageNode methodsFor: 'testing'! isFirstCascaded ^self isCascaded and: [parent messages first == self]! ! !RBMessageNode methodsFor: 'testing'! isKeyword ^selectorParts first value last == $:! ! !RBMessageNode methodsFor: 'testing'! isMessage ^true! ! !RBMessageNode methodsFor: 'testing'! isUnary ^arguments isEmpty! ! !RBMessageNode methodsFor: 'testing'! lastIsReturn ^(#(#ifTrue:ifFalse: #ifFalse:ifTrue:) includes: self selector) and: [arguments first isBlock and: [arguments first body lastIsReturn and: [arguments last isBlock and: [arguments last body lastIsReturn]]]]! ! !RBMessageNode methodsFor: 'private'! buildSelector | selectorStream | selectorStream := WriteStream on: (String new: 50). selectorParts do: [:each | selectorStream nextPutAll: each value]. ^selectorStream contents asSymbol! ! !RBMessageNode methodsFor: 'private'! selectorParts ^selectorParts! ! !RBMessageNode methodsFor: 'private'! selectorParts: tokenCollection selectorParts := tokenCollection! ! !RBMessageNode methodsFor: 'querying'! bestNodeFor: anInterval (self intersectsInterval: anInterval) ifFalse: [^nil]. (self containedBy: anInterval) ifTrue: [^self]. selectorParts do: [:each | ((anInterval first between: each start and: each stop) or: [each start between: anInterval first and: anInterval last]) ifTrue: [^self]]. self children do: [:each | | node | node := each bestNodeFor: anInterval. node notNil ifTrue: [^node]]! ! !RBMessageNode methodsFor: 'matching'! copyInContext: aDictionary ^(self class new) receiver: (receiver copyInContext: aDictionary); selectorParts: (selectorParts collect: [:each | each removePositions]); arguments: (arguments collect: [:each | each copyInContext: aDictionary]); yourself! ! !RBMessageNode methodsFor: 'matching'! match: aNode inContext: aDictionary aNode class == self class ifFalse: [^false]. self selector == aNode selector ifFalse: [^false]. (receiver match: aNode receiver inContext: aDictionary) ifFalse: [^false]. 1 to: arguments size do: [:i | ((arguments at: i) match: (aNode arguments at: i) inContext: aDictionary) ifFalse: [^false]]. ^true! ! !RBMessageNode methodsFor: 'comparing'! = anObject self == anObject ifTrue: [^true]. self class = anObject class ifFalse: [^false]. (self receiver = anObject receiver and: [self selector = anObject selector]) ifFalse: [^false]. 1 to: self arguments size do: [:i | (self arguments at: i) = (anObject arguments at: i) ifFalse: [^false]]. ^true! ! !RBMessageNode methodsFor: 'comparing'! equalTo: anObject withMapping: aDictionary self class = anObject class ifFalse: [^false]. ((self receiver equalTo: anObject receiver withMapping: aDictionary) and: [self selector = anObject selector]) ifFalse: [^false]. 1 to: self arguments size do: [:i | ((self arguments at: i) equalTo: (anObject arguments at: i) withMapping: aDictionary) ifFalse: [^false]]. ^true! ! !RBMessageNode methodsFor: 'comparing'! hash ^(self receiver hash bitXor: self selector hash) bitXor: (self arguments isEmpty ifTrue: [0] ifFalse: [self arguments first hash])! ! !RBMessageNode methodsFor: 'copying'! postCopy super postCopy. receiver := receiver copy. arguments := arguments collect: [:each | each copy]! ! !RBMessageNode methodsFor: 'visitor'! acceptVisitor: aProgramNodeVisitor ^aProgramNodeVisitor acceptMessageNode: self! ! !RBMessageNode methodsFor: 'initialize-release'! receiver: aValueNode selectorParts: keywordTokens arguments: valueNodes self receiver: aValueNode. selectorParts := keywordTokens. self arguments: valueNodes! ! !RBMessageNode class methodsFor: 'instance creation'! receiver: aValueNode selector: aSymbol ^self receiver: aValueNode selector: aSymbol arguments: #()! ! !RBMessageNode class methodsFor: 'instance creation'! receiver: aValueNode selector: aSymbol arguments: valueNodes ^(self new) receiver: aValueNode; arguments: valueNodes; selector: aSymbol; yourself! ! !RBMessageNode class methodsFor: 'instance creation'! receiver: aValueNode selectorParts: keywordTokens arguments: valueNodes ^((keywordTokens detect: [:each | each isPatternVariable] ifNone: [nil]) notNil ifTrue: [RBPatternMessageNode] ifFalse: [RBMessageNode]) new receiver: aValueNode selectorParts: keywordTokens arguments: valueNodes! ! !RBOptimizedNode methodsFor: 'matching'! copyInContext: aDictionary ^self class body: (body copyInContext: aDictionary)! ! !RBOptimizedNode methodsFor: 'matching'! match: aNode inContext: aDictionary aNode class == self class ifFalse: [^false]. ^body match: aNode body inContext: aDictionary! ! !RBOptimizedNode methodsFor: 'accessing'! body ^body! ! !RBOptimizedNode methodsFor: 'accessing'! body: stmtsNode body := stmtsNode. body parent: self! ! !RBOptimizedNode methodsFor: 'accessing'! children ^Array with: body! ! !RBOptimizedNode methodsFor: 'accessing'! precedence ^0! ! !RBOptimizedNode methodsFor: 'accessing'! startWithoutParentheses ^left! ! !RBOptimizedNode methodsFor: 'accessing'! stopWithoutParentheses ^right! ! !RBOptimizedNode methodsFor: 'comparing'! = anObject self == anObject ifTrue: [^true]. self class = anObject class ifFalse: [^false]. ^self body = anObject body! ! !RBOptimizedNode methodsFor: 'comparing'! equalTo: anObject withMapping: aDictionary self class = anObject class ifFalse: [^false]. ^self body equalTo: anObject body withMapping: aDictionary! ! !RBOptimizedNode methodsFor: 'comparing'! hash ^self body hash! ! !RBOptimizedNode methodsFor: 'testing'! isImmediate ^true! ! !RBOptimizedNode methodsFor: 'initialize-release'! left: leftInteger body: aSequenceNode right: rightInteger left := leftInteger. self body: aSequenceNode. right := rightInteger! ! !RBOptimizedNode methodsFor: 'visitor'! acceptVisitor: aProgramNodeVisitor ^aProgramNodeVisitor acceptOptimizedNode: self! ! !RBOptimizedNode methodsFor: 'replacing'! replaceNode: aNode withNode: anotherNode body == aNode ifTrue: [self body: anotherNode]! ! !RBOptimizedNode class methodsFor: 'instance creation'! body: aSequenceNode ^self new body: aSequenceNode! ! !RBOptimizedNode class methodsFor: 'instance creation'! left: leftInteger body: aSequenceNode right: rightInteger ^self new left: leftInteger body: aSequenceNode right: rightInteger! ! !RBPatternMessageNode methodsFor: 'matching'! copyInContext: aDictionary | selectors | self isList ifTrue: [^aDictionary at: self]. selectors := self isSelectorList ifTrue: [(aDictionary at: selectorParts first value) keywords] ifFalse: [selectorParts collect: [:each | aDictionary at: each value]]. ^(RBMessageNode new) receiver: (receiver copyInContext: aDictionary); selectorParts: (selectors collect: [:each | (each last == $: ifTrue: [RBKeywordToken] ifFalse: [RBIdentifierToken]) value: each start: nil]); arguments: (self copyList: arguments inContext: aDictionary); yourself! ! !RBPatternMessageNode methodsFor: 'matching'! match: aNode inContext: aDictionary aNode class == self matchingClass ifFalse: [^false]. (receiver match: aNode receiver inContext: aDictionary) ifFalse: [^false]. self isSelectorList ifTrue: [^(aDictionary at: selectorParts first value ifAbsentPut: [aNode selector]) == aNode selector and: [(aDictionary at: arguments first ifAbsentPut: [aNode arguments]) = aNode arguments]]. ^self matchArgumentsAgainst: aNode inContext: aDictionary! ! !RBPatternMessageNode methodsFor: 'matching'! matchArgumentsAgainst: aNode inContext: aDictionary self arguments size == aNode arguments size ifFalse: [^false]. (self matchSelectorAgainst: aNode inContext: aDictionary) ifFalse: [^false]. 1 to: arguments size do: [:i | ((arguments at: i) match: (aNode arguments at: i) inContext: aDictionary) ifFalse: [^false]]. ^true! ! !RBPatternMessageNode methodsFor: 'matching'! matchSelectorAgainst: aNode inContext: aDictionary | keyword | 1 to: selectorParts size do: [:i | keyword := selectorParts at: i. (aDictionary at: keyword value ifAbsentPut: [keyword isPatternVariable ifTrue: [(aNode selectorParts at: i) value] ifFalse: [keyword value]]) = (aNode selectorParts at: i) value ifFalse: [^false]]. ^true! ! !RBPatternMessageNode methodsFor: 'testing-matching'! isList ^isCascadeList and: [parent notNil and: [parent isCascade]]! ! !RBPatternMessageNode methodsFor: 'testing-matching'! isPatternNode ^true! ! !RBPatternMessageNode methodsFor: 'testing-matching'! isSelectorList ^isList! ! !RBPatternMessageNode methodsFor: 'initialize-release'! receiver: aValueNode selectorParts: keywordTokens arguments: valueNodes | message | super receiver: aValueNode selectorParts: keywordTokens arguments: valueNodes. isCascadeList := isList := false. message := keywordTokens first value. 2 to: message size do: [:i | | character | character := message at: i. character == self listCharacter ifTrue: [isList := true] ifFalse: [character == self cascadeListCharacter ifTrue: [isCascadeList := true] ifFalse: [^self]]]! ! !RBPatternMessageNode methodsFor: 'private'! matchingClass ^RBMessageNode! ! !RBPatternMessageNode methodsFor: 'accessing'! sentMessages ^(super sentMessages) remove: self selector ifAbsent: []; yourself! ! !RBValueToken methodsFor: 'private'! length ^value size! ! !RBValueToken methodsFor: 'accessing'! value ^value! ! !RBValueToken methodsFor: 'accessing'! value: anObject value := anObject! ! !RBValueToken methodsFor: 'printing'! printOn: aStream super printOn: aStream. aStream nextPut: $(. value printOn: aStream. aStream nextPutAll: ')'! ! !RBValueToken methodsFor: 'initialize-release'! value: aString start: anInteger value := aString. sourcePointer := anInteger! ! !RBBinarySelectorToken methodsFor: 'testing'! isBinary ^true! ! !RBIdentifierToken methodsFor: 'testing'! isIdentifier ^true! ! !RBIdentifierToken methodsFor: 'testing' stamp: 'md 8/26/2004 18:36'! isPatternVariable ^value first == $`. "value first == RBScanner patternVariableCharacter"! ! !RBKeywordToken methodsFor: 'testing'! isKeyword ^true! ! !RBKeywordToken methodsFor: 'testing' stamp: 'md 8/26/2004 18:37'! isPatternVariable ^value first == $`. "value first == RBScanner patternVariableCharacter"! ! !RBLiteralToken methodsFor: 'accessing'! realValue ^value class == Array ifTrue: [value collect: [:each | each realValue]] ifFalse: [value]! ! !RBLiteralToken methodsFor: 'accessing'! stop: anObject stopPosition := anObject! ! !RBLiteralToken methodsFor: 'private'! length ^stopPosition - self start + 1! ! !RBLiteralToken methodsFor: 'initialize-release'! value: aString start: anInteger stop: stopInteger value := aString. sourcePointer := anInteger. stopPosition := stopInteger! ! !RBLiteralToken methodsFor: 'testing'! isLiteral ^true! ! !RBPatternBlockToken methodsFor: 'testing'! isPatternBlock ^true! ! !RBSpecialCharacterToken methodsFor: 'private'! length ^1! ! !RBSpecialCharacterToken methodsFor: 'testing'! isSpecial ^true! ! !RBValueToken class methodsFor: 'instance creation'! value: aString start: anInteger ^self new value: aString start: anInteger! ! !RBLiteralToken class methodsFor: 'instance creation'! value: anObject | literal | literal := anObject class == Array ifTrue: [anObject collect: [:each | self value: each]] ifFalse: [anObject]. ^self value: literal start: nil stop: nil! ! !RBLiteralToken class methodsFor: 'instance creation'! value: aString start: anInteger stop: stopInteger ^self new value: aString start: anInteger stop: stopInteger! ! !RBVariableNode methodsFor: 'comparing'! = anObject self == anObject ifTrue: [^true]. self class = anObject class ifFalse: [^false]. ^self name = anObject name! ! !RBVariableNode methodsFor: 'comparing'! equalTo: anObject withMapping: aDictionary self class = anObject class ifFalse: [^false]. ^(aDictionary at: self name ifAbsentPut: [anObject name]) = anObject name! ! !RBVariableNode methodsFor: 'comparing'! hash ^self name hash! ! !RBVariableNode methodsFor: 'testing'! isImmediate ^true! ! !RBVariableNode methodsFor: 'testing'! isVariable ^true! ! !RBVariableNode methodsFor: 'testing'! references: aVariableName ^self name = aVariableName! ! !RBVariableNode methodsFor: 'matching'! copyInContext: aDictionary ^self class identifierToken: token removePositions! ! !RBVariableNode methodsFor: 'accessing'! name ^token value! ! !RBVariableNode methodsFor: 'accessing'! precedence ^0! ! !RBVariableNode methodsFor: 'accessing'! startWithoutParentheses ^token start! ! !RBVariableNode methodsFor: 'accessing'! stopWithoutParentheses ^token stop! ! !RBVariableNode methodsFor: 'visitor'! acceptVisitor: aProgramNodeVisitor ^aProgramNodeVisitor acceptVariableNode: self! ! !RBVariableNode methodsFor: 'initialize-release'! identifierToken: anIdentifierToken token := anIdentifierToken! ! !RBPatternVariableNode methodsFor: 'testing-matching'! isAnything ^isAnything! ! !RBPatternVariableNode methodsFor: 'testing-matching'! isList ^isList! ! !RBPatternVariableNode methodsFor: 'testing-matching'! isLiteral ^isLiteral! ! !RBPatternVariableNode methodsFor: 'testing-matching'! isPatternNode ^true! ! !RBPatternVariableNode methodsFor: 'testing-matching'! isStatement ^isStatement! ! !RBPatternVariableNode methodsFor: 'testing-matching'! recurseInto ^recurseInto! ! !RBPatternVariableNode methodsFor: 'matching'! copyInContext: aDictionary ^aDictionary at: self! ! !RBPatternVariableNode methodsFor: 'matching'! match: aNode inContext: aDictionary self isAnything ifTrue: [^(aDictionary at: self ifAbsentPut: [aNode]) = aNode]. self isLiteral ifTrue: [^self matchLiteral: aNode inContext: aDictionary]. self isStatement ifTrue: [^self matchStatement: aNode inContext: aDictionary]. aNode class == self matchingClass ifFalse: [^false]. ^(aDictionary at: self ifAbsentPut: [aNode]) = aNode! ! !RBPatternVariableNode methodsFor: 'matching'! matchLiteral: aNode inContext: aDictionary ^aNode class == RBLiteralNode and: [(aDictionary at: self ifAbsentPut: [aNode]) = aNode]! ! !RBPatternVariableNode methodsFor: 'matching'! matchStatement: aNode inContext: aDictionary (aNode parent notNil and: [aNode parent isSequence]) ifFalse: [^false]. ^(aDictionary at: self ifAbsentPut: [aNode]) = aNode! ! !RBPatternVariableNode methodsFor: 'accessing'! parent: aBRProgramNode "Fix the case where '``@node' should match a single node, not a sequence node." super parent: aBRProgramNode. parent isSequence ifTrue: [(self isStatement or: [parent temporaries includes: self]) ifFalse: [isList := false]]! ! !RBPatternVariableNode methodsFor: 'initialize-release'! identifierToken: anIdentifierToken super identifierToken: anIdentifierToken. self initializePatternVariables! ! !RBPatternVariableNode methodsFor: 'initialize-release'! initializePatternVariables | name | name := self name. isAnything := isList := isLiteral := isStatement := recurseInto := false. 2 to: name size do: [:i | | character | character := name at: i. character == self listCharacter ifTrue: [isAnything := isList := true] ifFalse: [character == self literalCharacter ifTrue: [isLiteral := true] ifFalse: [character == self statementCharacter ifTrue: [isStatement := true] ifFalse: [character == self recurseIntoCharacter ifTrue: [recurseInto := true] ifFalse: [^self]]]]]! ! !RBPatternVariableNode methodsFor: 'private'! matchingClass ^RBVariableNode! ! !RBVariableNode class methodsFor: 'instance creation'! identifierToken: anIdentifierToken ^(anIdentifierToken isPatternVariable ifTrue: [RBPatternVariableNode] ifFalse: [RBVariableNode]) new identifierToken: anIdentifierToken! ! !RBVariableNode class methodsFor: 'instance creation'! named: aString ^self identifierToken: (RBIdentifierToken value: aString start: 0)! !